TestAST.hs

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