compare: Add tests for json import

osek-verification.cabal

@@ -67,6 +67,7 @@ test-suite spec
                      , ProtocolSpec
                      , Search.EpsilonEliminationSpec
                      , Compare.MatchingSpec
+                     , Compare.JSONSpec
   build-depends:       base >= 4.8 && <4.10
                      , osek-verification
                      , hspec >= 2.2.3 && <2.3
@@ -81,5 +82,6 @@ test-suite spec
                      , here >= 1.2 && < 1.3
                      , mtl >= 2.2 && <2.3
                      , utf8-string >= 1.0 && <1.1
+                     , fgl >= 5.5 && < 5.6
   default-language:    Haskell2010
   ghc-options:         -Wall -fdefer-typed-holes -fno-warn-name-shadowing

src/Compare/JSON.hs

@@ -4,9 +4,7 @@
 
 {-# OPTIONS_GHC -Wno-orphans #-}
 module Compare.JSON
-  ( Graph
-  , parseFile
-  ) where
+  ( parseFile ) where
 
 import           Data.Aeson
 import           Data.Aeson.Types (typeMismatch)
@@ -44,6 +42,8 @@ instance FromJSON E where
     E <$> ((\a b c -> (a,b,c)) <$> v .: "from" <*> v .: "to" <*> v .: "label")
   parseJSON invalid = typeMismatch "Edge" invalid
 
+-- TODO Make more robust against input errors
+-- E.g unknown notes in edges
 mkGraph :: [NodeLabel] -> [(NodeLabel, NodeLabel, EdgeLabel)] -> NodeLabel -> Graph NodeLabel EdgeLabel
 mkGraph nodes labels entry =
   let

test/Compare/JSONSpec.hs

+{-# LANGUAGE OverloadedStrings #-}
+
+module Compare.JSONSpec (spec) where
+
+import           Test.Hspec
+
+import qualified Codec.Binary.UTF8.String as UTF8
+import qualified Data.ByteString.Lazy as BS
+import qualified Data.Graph.Inductive as G
+import           Data.Text (Text)
+import qualified Data.Set as S
+
+import           Compare.JSON
+import           Compare.Types
+
+exampleJson :: BS.ByteString
+exampleJson = BS.pack $ UTF8.encode $ unlines
+    [ "{"
+    , "  \"nodes\": ["
+    , "    {"
+    , "      \"id\": \"ABB15\","
+    , "      \"runnable\": \"TaskA\""
+    , "    },"
+    , "    {"
+    , "      \"id\": \"ABB42\","
+    , "      \"runnable\": \"TaskB\""
+    , "    }"
+    , "  ],"
+    , "  \"edges\": ["
+    , "    {"
+    , "      \"from\": \"ABB15\","
+    , "      \"to\": \"ABB42\","
+    , "      \"label\": \"syscall_a\""
+    , "    }"
+    , "  ],"
+    , "  \"entry\": \"ABB15\""
+    , "}"
+    ]
+
+spec :: Spec
+spec = describe "parseFile" $
+  it "parses an example" $
+    case parseFile exampleJson :: Either String (Graph Text Text) of
+      Left err -> expectationFailure err
+      Right g ->
+        let
+          nodes = S.fromList $ map snd $ G.labNodes (graph g)
+          edges = map (\(n1, n2, l) -> (G.lab (graph g) n1, G.lab (graph g) n2, l)) $
+            G.labEdges (graph g)
+          entry = G.lab (graph g) (point g)
+        in do
+          nodes `shouldBe` (S.fromList ["ABB15", "ABB42"])
+          edges `shouldBe` [(Just "ABB15", Just "ABB42", "syscall_a")]
+          entry `shouldBe` Just "ABB15"

test/Compare/MatchingSpec.hs

@@ -6,7 +6,7 @@ import Test.QuickCheck
 import qualified Compare.Matching as M
 
 spec :: Spec
-spec = describe "Matching" $ do
+spec = do
   emptySpec
   lookupSpec