module Testing.Unit.GraphTests (tests) where import System.Cmd import Test.HUnit import Data.Graph.Inductive as G import Data.Sifflet.Functoid import Data.Sifflet.Geometry import Data.Sifflet.Tree as T import Data.Sifflet.TreeGraph import Data.Sifflet.TreeLayout import Data.Sifflet.WGraph import Language.Sifflet.Expr import Language.Sifflet.ExprTree import Graphics.Rendering.Sifflet.DrawTreeGraph import Text.Sifflet.Repr () import Testing.Unit.TreeTests hiding (tests) import Testing.TestUtil -- (Sym s) is a symbol, similar to (Name s), but its show method -- is just the string s instead of (Sym s). -- This is just here for testing with graphviz. newtype Sym = Sym String deriving (Eq) instance Show Sym where show (Sym s) = s instance Repr Sym where repr (Sym s) = s {- SOME TEST TREES > putTreeS t5 root | +- left | `- right -} t5 :: Tree Sym t5 = fmap Sym (T.Node "root" [leaf "left", leaf "right"]) {- > putTreeS t6 1 | `- 2 | `- 3 | +- 4 | | | +- 7 | | | `- 8 | +- 5 | `- 6 | +- 9 | `- 10 -} t6 :: Tree Int t6 = T.Node 1 [T.Node 2 [T.Node 3 [T.Node 4 [leaf 7, leaf 8], leaf 5, T.Node 6 [leaf 9, leaf 10]]]] {- > putTreeS t7 'A' | +- 'B' | | | +- 'E' | | | `- 'F' | +- 'C' | `- 'D' | `- 'G' -} t7 :: Tree Char t7 = T.Node 'A' [T.Node 'B' [leaf 'E', leaf 'F'], leaf 'C', T.Node 'D' [leaf 'G']] -- UNIT TESTS utestsNextNodes :: Test utestsNextNodes = assertAll [assertEqual "nextNodes 3-5" ([3, 4], 5) (nextNodes "ab" 3), assertEqual "nextNodes 5-8" ([5, 6, 7], 8) (nextNodes "cde" 5), assertEqual "nextNodes 8-8" ([], 8) (nextNodes [] 8)] utestsTreeGraph :: Test utestsTreeGraph = let tn1 = (T.Node 1 [leaf 2, leaf 3]) tn3 = (T.Node 1 [T.Node 2 [leaf 5, leaf 6], leaf 3, T.Node 4 [leaf 7]]) tgStruct :: Tree e -> Tree G.Node -- is this needed at all? tgStruct t = graphToTreeStructure (orderedTreeToGraph t) 1 in assertAll [assertEqual "tree graph nodes t5" tn1 (treeGraphNodesTree t5), assertEqual "tree graph nodes t7" tn3 (treeGraphNodesTree t7), assertEqual "tree graph struct t5" tn1 (tgStruct t5), assertEqual "tree graph struct t7" tn3 (tgStruct t7)] utestsTreeGraphReconstruct :: Test utestsTreeGraphReconstruct = let reconstruct :: Tree e -> Tree e reconstruct = graphToOrderedTree . orderedTreeToGraph in assertAll [assertEqual "tree graph inverse" t5 (reconstruct t5), assertEqual "tree graph inverse" t6 (reconstruct t6), assertEqual "tree graph inverse" t7 (reconstruct t7)] utestsOrderedTreeGraph :: Test utestsOrderedTreeGraph = let t = T.Node "ham" [T.Node "pineapple" [], T.Node "juice" [T.Node "can" [], T.Node "cup" [], T.Node "balls" []]] g = mkGraph [(1, "ham"), (2, "pineapple"), (3, "juice"), (4, "can"), (5, "cup"), (6, "balls")] [(1, 2, WEdge 0), -- from node 1 to node 2 as 0th child (1, 3, WEdge 1), (3, 4, WEdge 0), (3, 5, WEdge 1), (3, 6, WEdge 2)] in assertAll [-- assertEqual "ordered tree to graph" g -- (orderedTreeToGraph t), assert $ equal g (orderedTreeToGraph t), assertEqual "graph to ordered tree" t (graphToOrderedTree g)] utestsInsertRemove :: Test utestsInsertRemove = let g1 :: Gr String Int g1 = mkGraph [(1, "ding"), (2, "aling"), (3, "along")] [(1, 3, 0), (2, 3, 0), (3, 1, 0)] g0 = mkGraph [(2, "aling"), (3, "along")] [(2, 3, 0)] g2 = mkGraph [(1, "ding"), (2, "aling"), (3, "along"), (4, "song")] [(1, 3, 0), (2, 3, 0), (3, 1, 0)] in assertAll [assert $ equal g2 (fst (grInsertNode g1 "song")), assert $ equal g0 (grRemoveNode g1 1) ] testGrAddGraph :: Test testGrAddGraph = TestCase $ let g1 :: Gr () () g1 = mkUGraph [1 .. 3] [(1, 2), (1, 3), (2, 3)] g2 :: Gr () () g2 = mkUGraph [1 .. 3] [(1, 2), (2, 3), (3, 1)] g3 :: Gr () () g3 = mkUGraph [1..6] [(1, 2), (1, 3), (2, 3), (4, 5), (5, 6), (6, 4)] in assert $ equal g3 (grAddGraph g1 g2) testLayoutRoots :: Test testLayoutRoots = let m = eSymbol "m" n = eSymbol "n" t = exprToTree (eIf (eZerop n) (eInt 0) (ePlus m (eMinus m (eSub1 n)))) lt = treeLayout style0 zeroIoletCounter t lf = map (treeLayout style0 zeroIoletCounter) (subForest t) f1 = FLayoutTree lt f2 = FLayoutForest lf (BBox 0 0 0 0) in assertAll [assertEqual "tlo to graph roots, function tree" [1] (flayoutToGraphRoots f1) , assertEqual "tlo to graph roots, function parts forest" [1, 3, 4] (flayoutToGraphRoots f2) ] testGraphOrphans :: Test testGraphOrphans = let g0 :: Gr String () g0 = mkGraph [(0, "A"), (1, "B"), (2, "C"), (3, "D"), (4, "E")] [(0, 1, ()), (0, 2, ()), (0, 3, ()), (3, 2, ()), (4, 1, ()), (4, 2, ())] g1 :: Gr String () g1 = mkGraph [(0, "WFrame"), (1, "f"), (2, "g"), (3, "x"), (4, "y"), (5, "add1"), (6, "y"), (7, "x")] [(1, 2, ()), (1, 3, ()), (1, 4, ()), (2, 5, ()), (2, 6, ()), (5, 7, ())] in assertAll [assertEqual "graphOrphans g0" [0, 4] (graphOrphans g0), assertEqual "graphOrphans g1" [0, 1] (graphOrphans g1)] tests :: Test tests = TestList [utestsInsertRemove, testGrAddGraph, utestsNextNodes, utestsTreeGraph, utestsTreeGraphReconstruct, utestsOrderedTreeGraph, testLayoutRoots, testGraphOrphans ] runU :: IO Counts runU = runTestTT tests testm :: (Show e, Repr e) => [Style] -> Tree e -> IO () testm styles t = mapM_ (\s -> gtkShowTree s zeroIoletCounter t) styles -- test render a graph, simple form testRenderGraph1 :: (Repr e) => Tree e -> IO () testRenderGraph1 t = let style = defaultStyle tlo = treeLayout style zeroIoletCounter t Size surfWidth surfHeight = treeLayoutPaddedSize style tlo g = orderedTreeToGraph tlo file = "tmp.png" in graphWriteImageFile style (Just 1) (Just 2) surfWidth surfHeight g file >> system ("feh " ++ file) >> return () testRenderGraph2a :: IO () testRenderGraph2a = testRenderGraph2Aux t3 (grTranslateNode 2 (-100) (-50)) testRenderGraph2b :: IO () testRenderGraph2b = testRenderGraph2Aux t3 (grTranslateNode 2 100 50) testRenderGraph2c :: IO () testRenderGraph2c = testRenderGraph2Aux t3 (grTranslateNode 3 (-100) 20) testRenderGraph3a :: IO () testRenderGraph3a = testRenderGraph2Aux t3 (grTranslateSubtree 2 100 50) testRenderGraph3b :: IO () testRenderGraph3b = testRenderGraph2Aux t3 (grTranslateSubtree 4 (-50) (-50)) -- test render a graph, with a transformation -- the second argument updates the graph, for example by -- translating a node or a subtree testRenderGraph2Aux :: (Repr n) => Tree n -> (LayoutGraph n WEdge -> LayoutGraph n WEdge) -> IO () testRenderGraph2Aux t transform = let style = defaultStyle tlo = treeLayout style zeroIoletCounter t Size surfWidth surfHeight = treeLayoutPaddedSize style tlo g = transform (orderedTreeToGraph tlo) file = "tmp.png" in graphWriteImageFile style (Just 1) Nothing surfWidth surfHeight g file >> system ("feh " ++ file) >> return ()