module Main where import Data.List import Data.Either import Language.Dot.Parser import Test.HUnit hiding (Node) import System.Exit (exitFailure, exitSuccess) g1Str = "graph g1 { }" g2Str = "strict graph g2 { }" d1Str = "digraph d1 { }" d2Str = "strict digraph d2 { }" g3Str = "graph g3 { v1; v2; \"v\" + \"3\"; }" g4Str = "graph g4 { v1 -- v2; }" g5Str = "graph g5 { v1 : port : n; v2 : other_port [attr1 = x,attr2=y] ; v3 : e} " g6Str = "graph g6 { v1 -- v2 -- { rank=same v3 ; v4 } -- v5 [attr1=5.5]; }" g7Str = "graph g7 {\n\ \ v1;\ \ v2 ->;\ \}" g8Str = "graph g8 {\n\ \#define QWE\n\ \ \"long\\\n\ \ string for name\"}" g9Str = "graph g9 {\n\ \ \"wrong\n\ \ string\";}" tests = TestList [ TestLabel "Undirected Graph 1" $ TestCase ( do let ast = parse g1Str assertEqual "" (Right (False, Graph, Just $ StringID "g1", [])) ast ) , TestLabel "Undirected Graph 2" $ TestCase ( do let ast = parse g2Str assertEqual "" (Right (True, Graph, Just $ StringID "g2", [])) ast ) , TestLabel "Directed Graph 1" $ TestCase ( do let ast = parse d1Str assertEqual "" (Right (False, Digraph, Just $ StringID "d1", [])) ast ) , TestLabel "Directed Graph 2" $ TestCase ( do let ast = parse d2Str assertEqual "" (Right (True, Digraph, Just $ StringID "d2", [])) ast ) , TestLabel "Node 1" $ TestCase ( do let ast = parse g3Str Right (_,_,_, nodes) = ast assertBool "" $ isRight ast assertEqual "" [ NodeStatement (StringID "v1") Nothing [] , NodeStatement (StringID "v2") Nothing [] , NodeStatement (StringID "v3") Nothing []] nodes ) , TestLabel "Undirected Graph 4" $ TestCase ( do let ast = parse g4Str Right (_,_,_, stmts) = ast assertBool "" $ isRight ast assertEqual "" [ EdgeStatement [ NodeRef (StringID "v1") Nothing , NodeRef (StringID "v2") Nothing] [] ] stmts ) , TestLabel "Node 2" $ TestCase ( do let ast = parse g5Str Right (_,_,_, stmts) = ast assertBool "Parse error" $ isRight ast assertEqual "" [ NodeStatement (StringID "v1") (Just $ Port (Just $ StringID "port") (Just North) ) [] , NodeStatement (StringID "v2") (Just $ Port (Just $ StringID "other_port") Nothing ) [(StringID "attr1", StringID "x"), (StringID "attr2", StringID "y")] , NodeStatement (StringID "v3") (Just $ Port (Nothing) (Just East) ) [] ] stmts ) , TestLabel "Subgraph 1" $ TestCase ( do let ast = parse g6Str Right (_,_,_, stmts) = ast assertBool "" $ isRight ast assertEqual "" [ EdgeStatement [ NodeRef (StringID "v1") Nothing , NodeRef (StringID "v2") Nothing , Subgraph Nothing [ AttributeStatement (StringID "rank", StringID "same") , NodeStatement (StringID "v3") Nothing [] , NodeStatement (StringID "v4") Nothing []] , NodeRef (StringID "v5") Nothing] [(StringID "attr1", StringID "5.5")] ] stmts ) , TestLabel "String 1" $ TestCase ( do let ast = parse g8Str Right (_,_,_, stmts) = ast Left msg = ast assertBool ("Unexpected parse error: " ++ msg) $ isRight ast assertEqual "" [ NodeStatement (StringID "long string for name") Nothing []] stmts ) , TestLabel "Error 1" $ TestCase ( do let ast = parse g7Str Left msg = ast assertBool "" (isLeft ast) assertEqual "" "Error on line 2: Unfinished edge statement." msg ) , TestLabel "Error 2" $ TestCase ( do let ast = parse g9Str Left msg = ast assertBool "" (isLeft ast) assertEqual "" "Error on line 3: String was open when newline was found. Either close the string with a \" or add a \\ to the end of the line to continue the string on the next line." msg ) ] main = do counts <- runTestTT tests if errors counts + failures counts > 0 then exitFailure else exitSuccess