Update for new version of generics-rep

closes #2

Author: csicar

bower.json

@@ -14,7 +14,7 @@
   "dependencies": {
     "purescript-prelude": "^3.1.1",
     "purescript-console": "^3.0.0",
-    "purescript-generics-rep": "^5.0.0",
+    "purescript-generics-rep": "^6.1.1",
     "viz.js": "^1.8.0",
     "purescript-dotlang": "^1.1.0",
     "purescript-graphviz": "^1.0.0"

src/Data/GenericGraph.purs

@@ -2,14 +2,21 @@ module Data.GenericGraph where
 
 import Control.Semigroupoid ((>>>))
 import Data.Array (concat, foldr, (!!), (:))
-import Data.DotLang (Attr(..), Edge(..), EdgeType(..), FillStyle(..), Graph, Node(..), graphFromElements, changeNodeId, nodeId)
-import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), Field(..), NoArguments, NoConstructors, Product(..), Rec(..), Sum(..), from)
+import Data.DotLang (Edge(..), EdgeType(..), Graph, Node(..), graphFromElements, changeNodeId, nodeId)
+import Data.DotLang.Attr (FillStyle(..))
+import Data.DotLang.Attr.Edge as E
+import Data.DotLang.Attr.Node as N
+import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments, NoConstructors, Product(..), Sum(..), from)
 import Data.Maybe (Maybe(..), fromMaybe)
 import Data.String (joinWith)
 import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
 import Data.Tuple (Tuple(..), fst)
-import Prelude (class Show, id, show, ($), (+), (<$>), (<>))
-
+import Prelude (class Show, identity, show, ($), (+), (<$>), (<>))
+import Prim.Row (class Cons, class Lacks)
+import Prim.RowList (class RowToList, Nil, Cons)
+import Record as Record
+import Type.Data.RowList (RLProxy(..))
+import Type.RowList (class ListToRow)
 
 -- Tree type
 data Tree a = Root a (Array (Tree a))
@@ -67,14 +74,22 @@ instance arrayEdges :: Edges a => Edges (Array a) where
 instance genericReprArgument :: Edges a => GenericEdges (Argument a) where
   genericEdges' (Argument a) = edges a
 
+class (RowToList r rl) <= GenericEdgesRowList r rl | rl -> r where
+  rlEdges :: RLProxy rl -> Record r -> Array (Tree (Maybe Node))
 
-instance genericEdgesRec :: GenericEdges a => GenericEdges (Rec a) where
-  genericEdges' (Rec a) = genericEdges' a
+instance emptyRowToEdge :: (RowToList r Nil) => GenericEdgesRowList r Nil where
+  rlEdges _ _ = []
 
-instance genericEdgesField :: (Edges a, IsSymbol name) => GenericEdges (Field name a) where
-  genericEdges' (Field a) = Root (Just $ Node fieldName []) [ edges a ]
+instance consRowToEdge :: (Edges ty, Lacks name tailRow, GenericEdgesRowList tailRow tail, Cons name ty tailRow r, IsSymbol name, RowToList r (Cons name ty tail)) => GenericEdgesRowList r (Cons name ty tail) where
+  rlEdges _ r = Root (Just $ Node fieldName []) [edges fieldValue] : rlEdges (RLProxy :: RLProxy tail) (Record.delete fieldSymbol r)
     where
-      fieldName = reflectSymbol (SProxy :: SProxy name)
+      fieldSymbol = SProxy :: SProxy name
+      fieldName = reflectSymbol fieldSymbol
+      fieldValue :: ty
+      fieldValue = Record.get fieldSymbol r
+
+instance genericEdgesRec :: (RowToList r rl, GenericEdgesRowList r rl) => Edges (Record r) where
+  edges r = Root (Just $ Node "root" []) (rlEdges (RLProxy :: RLProxy rl) r)
 
 -- | A `Generic` implementation of the `eq` member from the `Eq` type class.
 genericEdges :: forall a rep. Generic a rep => GenericEdges rep => a -> Tree (Maybe Node)
@@ -101,7 +116,7 @@ uniqueNodes :: Tree Node -> Tree Node
 uniqueNodes = (uniqueNodes' 0) >>> fst
 
 extractEdges :: Node -> Tree Node -> Array Edge
-extractEdges parent (Root node children) = [Edge Forward (nodeId parent) (nodeId node)] <>
+extractEdges parent (Root node children) = [Edge Forward (nodeId parent) (nodeId node) []] <>
   (concat $
     (extractEdges node) <$> children)
 
@@ -111,8 +126,8 @@ extractNodes (Root node children) = node : (concat $ extractNodes <$> children)
 -- | genenric version of toGraph not renaming nodes.
 genericToGraphUnique ∷ ∀a. Edges a => a -> Graph
 genericToGraphUnique e
-  = id
-  $ (\f -> graphFromElements ((Node "root" [Style Invis]) : extractNodes f) (extractEdges (Node "root" []) f))
+  = identity
+  $ (\f -> graphFromElements ((Node "root" [N.Style Invis]) : extractNodes f) (extractEdges (Node "root" []) f))
   $ fromMaybe (Root (Node "" []) [])
   $ (\a -> a !! 0)
   $ eliminateNothings
@@ -121,8 +136,8 @@ genericToGraphUnique e
 -- | generic version of toGraph. Renaming Nodes to make them unique
 genericToGraph :: ∀a. Edges a => a -> Graph
 genericToGraph e
-  = id
-  $ (\f -> graphFromElements ((Node "root" [Style Invis]) : extractNodes f) (extractEdges (Node "root" []) f))
+  = identity
+  $ (\f -> graphFromElements ((Node "root" [N.Style Invis]) : extractNodes f) (extractEdges (Node "root" []) f))
   $ uniqueNodes
   $ fromMaybe (Root (Node "" []) [])
   $ (\a -> a !! 0)

test/Example.purs

@@ -1,10 +1,11 @@
 module Test.Example where
 
 import Data.DotLang (class GraphRepr, toGraph)
+import Data.DotLang.Class (toText)
 import Data.Function (($))
 import Data.Generic.Rep (class Generic)
 import Data.GenericGraph (class Edges, genericEdges, genericToGraph)
-import Graphics.Graphviz (Engine(..), renderToSvg)
+import Graphics.Graphviz (renderToText, Engine(..), Format(..))
 
 data Tree' a = Leaf' | Node' (Tree' a) a (Tree' a)
 
@@ -13,5 +14,5 @@ derive instance treeGeneric :: Generic (Tree' a) _
 instance treeEdges :: Edges a => Edges (Tree' a) where edges x = genericEdges x
 instance treeDotRepr ::  Edges a => GraphRepr (Tree' a) where toGraph = genericToGraph
 
-example = renderToSvg Dot $ toGraph $
+example = renderToText Dot Svg $ toText $ toGraph $
   Node' Leaf' 3 (Node' (Node' Leaf' 5 Leaf') 4 Leaf')

test/Main.purs

@@ -2,19 +2,22 @@ module Test.Main where
 
 import Prelude
 
-import Control.Monad.Eff (Eff)
-import Control.Monad.Eff.AVar (AVAR)
-import Control.Monad.Eff.Console (CONSOLE, log)
-import Data.DotLang (class GraphRepr, toGraph, toText)
+import Data.DotLang (class GraphRepr, toGraph)
+import Data.DotLang.Class (toText)
 import Data.Foldable (foldr)
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
 import Data.GenericGraph (class Edges, genericEdges, genericToGraph)
+import Effect (Effect)
+import Effect.Aff (Aff)
+import Effect.Aff.Class (liftAff)
+import Effect.Class (liftEffect)
+import Effect.Class.Console (logShow)
+import Test.Example (example)
 import Test.Unit (suite, test)
 import Test.Unit.Assert (equal)
-import Test.Unit.Console (TESTOUTPUT)
+import Test.Unit.Console (log)
 import Test.Unit.Main (runTest)
-import Test.Example (example)
 
 --Simple
 data Simple = A | B
@@ -64,42 +67,36 @@ newtype Todo = Todo
 
 derive instance genericTodo :: Generic Todo _
 instance showTodo :: Show Todo where show = genericShow
+
 instance graphReprTodo :: GraphRepr Todo where toGraph = genericToGraph
 instance egdesTodo :: Edges Todo where edges x = genericEdges x
 
-main :: Eff
-  ( console :: CONSOLE
-  , avar :: AVAR
-  , testOutput :: TESTOUTPUT
-  )
-  Unit
-main = do
-  -- log $ toText $ genericToGraph $ fromArray [1, 2, 3, 4, 7]
-  -- log $ toText $ toGraph $ (Node' Leaf' 3 (Node' (Node' Leaf' 5 Leaf') 4 Leaf'))
-  log $ example
-  main'
-
-
-main' ::
-  Eff
-    ( console :: CONSOLE
-    , testOutput :: TESTOUTPUT
-    , avar :: AVAR
-    )
-    Unit
-main' = runTest do
+-- main = do
+--   log $ toText $ genericToGraph $ fromArray [1, 2, 3, 4, 7]
+--   log $ toText $ toGraph $ (Node' Leaf' 3 (Node' (Node' Leaf' 5 Leaf') 4 Leaf'))
+--   val <- example
+--   main'
+
+
+main :: Effect Unit
+main = runTest do
   suite "GenericGraph" do
     test "simple" do
-      equal "digraph {root [style=invis]; 0 [label=\"A\"]; root -> 0; }" (toText $ toGraph A)
+      equal "digraph {root [style=invis]; 0 [label=\"A\"]; root -> 0 []; }" (toText $ toGraph A)
     test "recursive" do
       equal
-        "digraph {root [style=invis]; 0 [label=\"Node\"]; 1 [label=\"Node\"]; 2 [label=\"Leaf\"]; root -> 0; 0 -> 1; 1 -> 2; }"
+        "digraph {root [style=invis]; 0 [label=\"Node\"]; 1 [label=\"Node\"]; 2 [label=\"Leaf\"]; root -> 0 []; 0 -> 1 []; 1 -> 2 []; }"
         (toText $ toGraph $ Node (Node Leaf))
     test "list" do
       equal
-        "digraph {root [style=invis]; 0 [label=\"Cons'\"]; 4 [label=\"1\"]; 1 [label=\"Cons'\"]; 3 [label=\"2\"]; 2 [label=\"Nil\"]; root -> 0; 0 -> 4; 0 -> 1; 1 -> 3; 1 -> 2; }"
+        "digraph {root [style=invis]; 0 [label=\"Cons'\"]; 4 [label=\"1\"]; 1 [label=\"Cons'\"]; 3 [label=\"2\"]; 2 [label=\"Nil\"]; root -> 0 []; 0 -> 4 []; 0 -> 1 []; 1 -> 3 []; 1 -> 2 []; }"
         (toText $ toGraph $ Cons' 1 (Cons' 2 Nil))
     test "tree" do
       equal
-        "digraph {root [style=invis]; 0 [label=\"Node'\"]; 9 [label=\"Leaf'\"]; 8 [label=\"3\"]; 1 [label=\"Node'\"]; 4 [label=\"Node'\"]; 7 [label=\"Leaf'\"]; 6 [label=\"5\"]; 5 [label=\"Leaf'\"]; 3 [label=\"4\"]; 2 [label=\"Leaf'\"]; root -> 0; 0 -> 9; 0 -> 8; 0 -> 1; 1 -> 4; 4 -> 7; 4 -> 6; 4 -> 5; 1 -> 3; 1 -> 2; }"
+        "digraph {root [style=invis]; 0 [label=\"Node'\"]; 9 [label=\"Leaf'\"]; 8 [label=\"3\"]; 1 [label=\"Node'\"]; 4 [label=\"Node'\"]; 7 [label=\"Leaf'\"]; 6 [label=\"5\"]; 5 [label=\"Leaf'\"]; 3 [label=\"4\"]; 2 [label=\"Leaf'\"]; root -> 0 []; 0 -> 9 []; 0 -> 8 []; 0 -> 1 []; 1 -> 4 []; 4 -> 7 []; 4 -> 6 []; 4 -> 5 []; 1 -> 3 []; 1 -> 2 []; }"
         (toText $ toGraph $ Node' Leaf' 3 (Node' (Node' Leaf' 5 Leaf') 4 Leaf'))
+    test "record" do
+      let example = toText $ toGraph $ Todo {id: 1, text: "asd", newText: "asd", completed: true, editing: true }
+      equal
+        "digraph {root [style=invis]; 0 [label=\"Todo\"]; 1 [label=\"root\"]; 10 [label=\"completed\"]; 11 [label=\"true\"]; 8 [label=\"editing\"]; 9 [label=\"true\"]; 6 [label=\"id\"]; 7 [label=\"1\"]; 4 [label=\"newText\"]; 5 [label=\"\\\"asd\\\"\"]; 2 [label=\"text\"]; 3 [label=\"\\\"asd\\\"\"]; root -> 0 []; 0 -> 1 []; 1 -> 10 []; 10 -> 11 []; 1 -> 8 []; 8 -> 9 []; 1 -> 6 []; 6 -> 7 []; 1 -> 4 []; 4 -> 5 []; 1 -> 2 []; 2 -> 3 []; }"
+        example