diff --git a/test/Compare/JSONSpec.hs b/test/Compare/JSONSpec.hs index 88896f72678f38d6bf25720c036e907b1d4c7890..28d6fef1edbc97010b50c76ffce14a62b8f7782f 100644 --- a/test/Compare/JSONSpec.hs +++ b/test/Compare/JSONSpec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE OverloadedStrings #-} module Compare.JSONSpec (spec) where @@ -26,34 +27,40 @@ spec = do describe "NodeLabelMeta" metaSpec describe "EdgeLabel" edgeLabelSpec -exampleJson :: BS.ByteString -exampleJson = BS.pack $ UTF8.encode $ unlines +exampleJsonGen :: Show a => a -> a -> BS.ByteString +exampleJsonGen n1 n2 = BS.pack $ UTF8.encode $ unlines [ "{" , " \"nodes\": [" , " {" - , " \"id\": \"ABB15\"," + , " \"id\": " ++ show n1 ++ "," , " \"runnable\": \"TaskA\"" , " }," , " {" - , " \"id\": \"ABB42\"," + , " \"id\": " ++ show n2 ++ "," , " \"runnable\": \"TaskB\"" , " }" , " ]," , " \"edges\": [" , " {" - , " \"from\": \"ABB15\"," - , " \"to\": \"ABB42\"," + , " \"from\": " ++ show n1 ++ "," + , " \"to\": " ++ show n2 ++ "," , " \"label\": \"syscall_a\"" , " }" , " ]," - , " \"entry\": \"ABB15\"" + , " \"entry\": " ++ show n1 , "}" ] +exampleJson1 :: BS.ByteString +exampleJson1 = exampleJsonGen @Int 1 2 + +exampleJson2 :: BS.ByteString +exampleJson2 = exampleJsonGen @String "ABB15" "ABB42" + parseFileSpec :: Spec parseFileSpec = it "parses an example" $ - case parseFile exampleJson :: Either String (Graph Text Text) of + case parseFile exampleJson2 :: Either String (Graph Text Text) of Left err -> expectationFailure err Right g -> let @@ -90,7 +97,7 @@ toJSONSpec = do metaSpec :: Spec metaSpec = do it "retains metadata from the original json" $ - case parseFile exampleJson :: Either String (Graph NodeLabelMeta Text) of + case parseFile exampleJson1 :: Either String (Graph NodeLabelMeta Text) of Left err -> expectationFailure err Right g -> let @@ -101,25 +108,25 @@ metaSpec = do ["TaskA", "TaskB"] let - nodes = [ NodeLabelMeta "a" (HM.fromList [("runnable", "TaskA")]) - , NodeLabelMeta "b" (HM.fromList [("runnable", "TaskB")]) + nodes = [ NodeLabelMeta 1 (HM.fromList [("runnable", "TaskA")]) + , NodeLabelMeta 2 (HM.fromList [("runnable", "TaskB")]) ] - edges = [("a", "b", "foo")] :: [(Text, Text, Text)] - g = encode (mkGraph nodes edges "a" :: Graph NodeLabelMeta Text) + edges = [(1, 2, "foo")] :: [(Int, Int, Text)] + g = encode (mkGraph nodes edges 1 :: Graph NodeLabelMeta Text) it "writes metadata back out to json" $ (g ^.. key "nodes" . values . key "runnable" . _String) `shouldMatchList` ["TaskA", "TaskB"] it "also writes its id to json" $ - (g ^.. key "nodes" . values . key "id" . _String) - `shouldMatchList` ["a", "b"] + (g ^.. key "nodes" . values . key "id" . _Integer) + `shouldMatchList` [1, 2] edgeLabelSpec :: Spec edgeLabelSpec = do it "serializes correctly" $ - case parseFile exampleJson :: Either String (Graph Text SSEEdgeLabel) of + case parseFile exampleJson2 :: Either String (Graph Text SSEEdgeLabel) of Left err -> expectationFailure err Right g -> let diff --git a/test/Compare/PreprocessSpec.hs b/test/Compare/PreprocessSpec.hs index 91e9efa13113b43b246fe43a342608931ff6477e..a212440b07b37fbd21e293c0b004f35f66153d34 100644 --- a/test/Compare/PreprocessSpec.hs +++ b/test/Compare/PreprocessSpec.hs @@ -4,6 +4,8 @@ module Compare.PreprocessSpec (spec) where import Test.Hspec import qualified Data.Graph.Inductive.Graph as G +import Data.Text (Text) +import qualified Data.Text as T import Lens.Micro import Compare.Preprocess @@ -20,32 +22,35 @@ spec = do renameStartOSSpec :: Spec renameStartOSSpec = do it "does nothing for a graph without StartOS label" $ - let g = mkGraph ["a", "b"] [("a", "b", "edge/Foo")] "a" - in preprocess (g & edges %~ SSEEdgeLabel) `shouldBe` g + let g = mkGraph [1, 2] [(1, 2, "edge/Foo")] 1 + in preprocess (g & edges %~ SSEEdgeLabel) `shouldBe` (g & nodes %~ showText) it "renames the StartOS label" $ - let g1 = mkGraph ["a", "b"] [("a", "b", "ABB13/StartOS")] "a" - g2 = mkGraph ["a", "b"] [("a", "b", "StartOS")] "a" + let g1 = mkGraph [1, 2] [(1, 2, "ABB13/StartOS")] 1 + g2 = mkGraph ["1", "2"] [("1", "2", "StartOS")] "1" in preprocess (g1 & edges %~ SSEEdgeLabel) `shouldBe` g2 renameIdleSpec :: Spec renameIdleSpec = do it "does nothing for a graph without StartOS label" $ - let g = mkGraph ["a", "b"] [("a", "b", "edge/Foo")] "a" - in preprocess (g & edges %~ SSEEdgeLabel) `shouldBe` g + let g = mkGraph [1, 2] [(1, 2, "edge/Foo")] 1 + in preprocess (g & edges %~ SSEEdgeLabel) `shouldBe` (g & nodes %~ showText) it "renames the idle loop edge label" $ - let g1 = mkGraph ["a", "b"] [("a", "b", "ABB25/Idle")] "a" - g2 = mkGraph ["a", "b"] [("a", "b", "Idle")] "a" + let g1 = mkGraph [1, 2] [(1, 2, "ABB25/Idle")] 1 + g2 = mkGraph ["1", "2"] [("1", "2", "Idle")] "1" in preprocess (g1 & edges %~ SSEEdgeLabel) `shouldBe` g2 renameIdleKickoffSpec :: Spec renameIdleKickoffSpec = it "renames the kickoff label to the idle thread" $ - let g1 = mkGraph ["PreIdle", "Idle"] [ ("PreIdle", "Idle", "ABB42/kickoff") - , ("Idle", "Idle", "ABB5/Idle") -- self loop + let g1 = mkGraph [1, 2] [ (1, 2, "ABB42/kickoff") + , (2, 2, "ABB5/Idle") -- self loop ] - "PreIdle" + 1 g2 = g1 & edges . filtered (=="ABB42/kickoff") .~ "IdleKickoff" & edges . filtered (=="ABB5/Idle") .~ "Idle" - in preprocess (g1 & _graph %~ G.emap SSEEdgeLabel) `shouldBe` g2 + in preprocess (g1 & edges %~ SSEEdgeLabel) `shouldBe` (g2 & nodes %~ showText) + +showText :: Show a => a -> Text +showText = T.pack . show