{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.Export -- Copyright : (c) Andrey Mokhov 2016-2022 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental -- -- Testsuite for "Algebra.Graph.Export" and "Algebra.Graph.Export.Dot". ----------------------------------------------------------------------------- module Algebra.Graph.Test.Export ( -- * Testsuite testExport ) where import Algebra.Graph (Graph, circuit) import Algebra.Graph.Export hiding (unlines) import Algebra.Graph.Export.Dot (Attribute (..)) import Algebra.Graph.Test import qualified Algebra.Graph.Export as E import qualified Algebra.Graph.Export.Dot as ED testExport :: IO () testExport = do putStrLn "\n============ Export.Eq ============" test "mempty /= literal \"\"" $ mempty /= (literal "" :: Doc String) putStrLn "\n============ Export.Ord ============" test "mempty < literal \"\"" $ mempty < (literal "" :: Doc String) putStrLn "\n============ Export.isEmpty ============" test "isEmpty mempty == True" $ isEmpty mempty == True test "isEmpty (literal \"\") == False" $ isEmpty (literal "" :: Doc String) == False test "isEmpty x == (x == mempty)" $ \(x :: Doc String) -> isEmpty x == (x == mempty) putStrLn "\n============ Export.literal ============" test "literal \"Hello, \" <> literal \"World!\" == literal \"Hello, World!\"" $ literal "Hello, " <> literal "World!" == literal ("Hello, World!" :: String) test "literal \"I am just a string literal\" == \"I am just a string literal\"" $ literal "I am just a string literal" == ("I am just a string literal" :: Doc String) test "render . literal == id" $ \(x :: String) -> (render . literal) x == x putStrLn "\n============ Export.render ============" test "render (literal \"al\" <> literal \"ga\") == \"alga\"" $ render (literal "al" <> literal "ga") == ("alga" :: String) test "render mempty == mempty" $ render mempty == (mempty :: Doc String) putStrLn "\n============ Export.<+> ============" test "x <+> mempty == x" $ \(x :: Doc String) -> x <+> mempty == x test "mempty <+> x == x" $ \(x :: Doc String) -> mempty <+> x == x test "x <+> (y <+> z) == (x <+> y) <+> z" $ \(x :: Doc String) y z -> x <+> (y <+> z) == (x <+> y) <+> z test "\"name\" <+> \"surname\" == \"name surname\"" $ "name" <+> "surname" == ("name surname" :: Doc String) putStrLn "\n============ Export.brackets ============" test "brackets \"i\" == \"[i]\"" $ brackets "i" == ("[i]" :: Doc String) test "brackets mempty == \"[]\"" $ brackets mempty == ("[]" :: Doc String) putStrLn "\n============ Export.doubleQuotes ============" test "doubleQuotes \"/path/with spaces\" == \"\\\"/path/with spaces\\\"\"" $ doubleQuotes "/path/with spaces" == ("\"/path/with spaces\"" :: Doc String) test "doubleQuotes (doubleQuotes mempty) == \"\\\"\\\"\\\"\\\"\"" $ doubleQuotes (doubleQuotes mempty) == ("\"\"\"\"" :: Doc String) putStrLn "\n============ Export.indent ============" test "indent 0 == id" $ \(x :: String) -> indent 0 (literal x) == literal x test "indent 1 mempty == \" \"" $ indent 1 mempty == (" " :: Doc String) putStrLn "\n============ Export.unlines ============" test "unlines [] == mempty" $ E.unlines [] == (mempty :: Doc String) test "unlines [mempty] == \"\\n\"" $ E.unlines [mempty] == ("\n" :: Doc String) test "unlines [\"title\", \"subtitle\"] == \"title\\nsubtitle\\n\"" $ E.unlines ["title", "subtitle" ] == ("title\nsubtitle\n" :: Doc String) putStrLn "\n============ Export.export ============" let vDoc x = literal (show x) <> "\n" eDoc x y = literal (show x) <> " -> " <> literal (show y) <> "\n" test "render $ export vDoc eDoc (1 + 2 * (3 + 4) :: Graph Int)" $ (render (export vDoc eDoc (1 + 2 * (3 + 4) :: Graph Int)) :: String) == unlines [ "1" , "2" , "3" , "4" , "2 -> 3" , "2 -> 4" ] putStrLn "\n============ Export.Dot.export ============" let style = ED.Style { ED.graphName = "Example" , ED.preamble = [" // This is an example", ""] , ED.graphAttributes = ["label" := "Example", "labelloc" := "top"] , ED.defaultVertexAttributes = ["shape" := "circle"] , ED.defaultEdgeAttributes = mempty , ED.vertexName = \x -> "v" ++ show x , ED.vertexAttributes = \x -> ["color" := "blue" | odd x ] , ED.edgeAttributes = \x y -> ["style" := "dashed" | odd (x * y)] , ED.attributeQuoting = ED.DoubleQuotes } test "export style (1 * 2 + 3 * 4 * 5 :: Graph Int)" $ (ED.export style (1 * 2 + 3 * 4 * 5 :: Graph Int) :: String) == unlines [ "digraph Example" , "{" , " // This is an example" , "" , " graph [label=\"Example\" labelloc=\"top\"]" , " node [shape=\"circle\"]" , " \"v1\" [color=\"blue\"]" , " \"v2\"" , " \"v3\" [color=\"blue\"]" , " \"v4\"" , " \"v5\" [color=\"blue\"]" , " \"v1\" -> \"v2\"" , " \"v3\" -> \"v4\"" , " \"v3\" -> \"v5\" [style=\"dashed\"]" , " \"v4\" -> \"v5\"" , "}" ] putStrLn "\n=========== Export.Dot.attributeQuoting ============" let style' = style { ED.attributeQuoting = ED.NoQuotes } test "export style' (1 * 2 + 3 * 4 * 5 :: Graph Int)" $ (ED.export style' (1 * 2 + 3 * 4 * 5 :: Graph Int) :: String) == unlines [ "digraph Example" , "{" , " // This is an example" , "" , " graph [label=Example labelloc=top]" , " node [shape=circle]" , " \"v1\" [color=blue]" , " \"v2\"" , " \"v3\" [color=blue]" , " \"v4\"" , " \"v5\" [color=blue]" , " \"v1\" -> \"v2\"" , " \"v3\" -> \"v4\"" , " \"v3\" -> \"v5\" [style=dashed]" , " \"v4\" -> \"v5\"" , "}" ] putStrLn "\n============ Export.Dot.exportAsIs ============" test "exportAsIs (circuit [\"a\", \"b\", \"c\"] :: Graph String)" $ (ED.exportAsIs (circuit ["a", "b", "c"] :: Graph String) :: String) == unlines [ "digraph " , "{" , " \"a\"" , " \"b\"" , " \"c\"" , " \"a\" -> \"b\"" , " \"b\" -> \"c\"" , " \"c\" -> \"a\"" , "}" ] putStrLn "\n============ Export.Dot.exportViaShow ============" test "exportViaShow (1 + 2 * (3 + 4) :: Graph Int)" $ (ED.exportViaShow (1 + 2 * (3 + 4) :: Graph Int) :: String) == unlines [ "digraph " , "{" , " \"1\"" , " \"2\"" , " \"3\"" , " \"4\"" , " \"2\" -> \"3\"" , " \"2\" -> \"4\"" , "}" ]