Represent attributes as record updates

README.md

@@ -6,31 +6,45 @@ documentation can be found on [pursuit](https://pursuit.purescript.org/packages/
 define your model like this:
 
 ```purescript
-DiGraph [
-    node "a" [ Shape Diamond, Style Filled,  Node.FillColor red ],
-    node "b" [],
-    "a" ==> "b",
-    "a" =*> "d" $ [ Edge.FillColor red ],
-    Subgraph [
-        node "d" []
+import Data.DotLang.Attr.Global as Global
+import Data.DotLang.Attr.Node
+import Data.DotLang.Attr.Edge
+import Data.DotLang.Attr
+import Data.DotLang.Class (toText)
+import Color.Scheme.MaterialDesign (red)
+
+
+graph = DiGraph
+    [ global [ rankDir FromLeft ]
+    , node "a" [ shape Node.Diamond, style Filled, fillColor red ]
+    , node "b" []
+    , "a" ==> "b"
+    , "a" =*> "d" $ [ fillColor red ]
+    , Subgraph
+        [ node "d" []
+        ]
     ]
-]
 ```
 
 can be rendered using `toText` to:
 
 ```
 digraph {
-    a [shape=diamond, style=filled, fillcolor="#f44336"];
-    b [];
-    a -> b;
-    a -> d [fillcolor="#f44336"];
-    subgraph {
+    rankdir=LR; 
+    a [fillcolor="#f44336", shape=diamond, style=filled]; 
+    b []; 
+    a -> b; 
+    a -> d [fillcolor="#f44336"]; 
+    subgraph { 
         d []; 
     }
 }
 ```
 
+Which looks like this, when rendered with graphviz:
+
+![example.svg](example.svg)
+
 ### Installation
 
 #### Spago
@@ -68,6 +82,18 @@ bower i purescript-dotlang
 Changelog
 =========
 
+v4.0.0
+------
+
+Breaking Changes:
+
+- dotlang now internally represents attributes as a record. To **migrate**:
+    - replace calls to Attribute constructors with their lower-case counter-part:
+        E.g. `FontColor` with calls to `fontColor`
+    - replace calls to `Node`, `Edge` and `Global` with `node`, `edge` and `global`
+- to avoid name collisions, `Edge.Diamond :: ArrowHead` was renamed to `Edge.FDiamond`
+
+
 v3.0.0
 ------
 

spago.dhall

@@ -1,21 +1,17 @@
-{ name =
-    "dotlang"
-, license =
-    "MIT"
-, repository =
-    "https://github.com/csicar/purescript-dotlang.git"
+{ name = "dotlang"
+, license = "MIT"
+, repository = "https://github.com/csicar/purescript-dotlang.git"
 , dependencies =
-    [ "colors"
-    , "console"
-    , "effect"
-    , "generics-rep"
-    , "prelude"
-    , "psci-support"
-    , "strings"
-    , "test-unit"
-    ]
-, packages =
-    ./packages.dhall
-, sources =
-    [ "src/**/*.purs", "test/**/*.purs" ]
+  [ "colors"
+  , "console"
+  , "effect"
+  , "generics-rep"
+  , "heterogeneous"
+  , "prelude"
+  , "psci-support"
+  , "strings"
+  , "test-unit"
+  ]
+, packages = ./packages.dhall
+, sources = [ "src/**/*.purs", "test/**/*.purs" ]
 }

src/Data/DotLang.purs

@@ -1,48 +1,55 @@
 module Data.DotLang where
 
+import Prelude
+
+import Color (Color, toHexString)
+import Data.Array (foldr, null)
+import Data.DotLang.Attr (Attribute, attributesToText)
+import Data.DotLang.Attr.Common (label)
+import Data.DotLang.Attr.Common as Gloabl
 import Data.DotLang.Attr.Edge as Edge
-import Data.DotLang.Attr.Node as Node
 import Data.DotLang.Attr.Global as Global
+import Data.DotLang.Attr.Node as Node
 import Data.DotLang.Class (class DotLang, toText)
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
 import Data.String (joinWith)
-import Data.Array (null)
+import Data.Symbol (SProxy(..))
 import Prelude (class Show, ($), (<$>), (<>))
 
 -- | type alias for a Nodes Name
-type Id = String
+type Id
+  = String
 
 -- | Dot-Node
 -- | example :
 -- | ```purescript
--- | Node "e" [Margin 3, Label "some label"]
+-- | node "e" [margin 3, label "some label"]
 -- | ```
 -- | is turned into: `e [margin=3, label="some label"];`
-data Node = Node Id (Array Node.Attr)
-
+data Node
+  = Node Id { | Node.Attributes }
 
 -- | get a nodes id
 -- | example:
 -- | ```purescript
--- | nodeId (Node "e" [Label "foo"]) == "e"
+-- | nodeId (node "e" [label "foo"]) == "e"
 -- | ```
 nodeId :: Node -> Id
 nodeId (Node id _) = id
 
 -- | change Nodes id to a new one; keeing the old id as the label
--- | example: `mapNodeId (\a -> a+"!") (Node "e" []) == Node "e!" [Label "e"]`
+-- | example: `mapNodeId (\a -> a+"!") (node "e" []) == node "e!" [label "e"]`
 changeNodeId :: (Id -> Id) -> Node -> Node
-changeNodeId f (Node id attr) = Node (f id) $ attr <> [Node.label id]
+changeNodeId f (Node id attr) = Node (f id) $ (label id attr)
 
 derive instance genericNode :: Generic Node _
 
 instance showNode :: Show Node where
   show = genericShow
 
 instance nodeDotLang :: DotLang Node where
-  toText (Node id attrs) = id <> " [" <> joinWith ", " (toText <$> attrs) <> "]"
-
+  toText (Node id attrs) = id <> " [" <> joinWith ", " (attributesToText attrs) <> "]"
 
 data EdgeType
   = Forward
@@ -51,17 +58,19 @@ data EdgeType
 
 derive instance genericEdgeType :: Generic EdgeType _
 
-instance showEdgeType :: Show EdgeType where show = genericShow
+instance showEdgeType :: Show EdgeType where
+  show = genericShow
 
 instance dotLangEdgeType :: DotLang EdgeType where
   toText Forward = "->"
   toText Backward = "<-"
   toText NoDir = "--"
 
 -- | egde from id to id
--- | `toText $ Edge Forward "a" "b" []` == `a -> b []`
+-- | `toText $ edge Forward "a" "b" []` == `a -> b []`
 -- | EdgeType determines the direction of the arrow
-data Edge = Edge EdgeType Id Id (Array Edge.Attr)
+data Edge
+  = Edge EdgeType Id Id { | Edge.Attributes }
 
 derive instance genericEdge :: Generic Edge _
 
@@ -71,53 +80,60 @@ instance showEdge :: Show Edge where
 instance dotLangEdge :: DotLang Edge where
   toText (Edge e id id2 attrs) = id <> " " <> (toText e) <> " " <> id2 <> attrText
     where
-      attrText = if null attrs then "" else " [" <> joinWith ", " (toText <$> attrs) <> "]"
+    attrText = case attributesToText attrs of
+      [] -> ""
+      textAttributes -> " [" <> joinWith ", " textAttributes <> "]"
 
 -- | definition in a graph
 data Definition
-  = Global (Array Global.Attr)
+  = Global { | Global.Attributes }
   | NodeDef Node
   | EdgeDef Edge
   | Subgraph (Array Definition)
 
+derive instance genericDefinition :: Generic Definition _
+
+instance showDefinition :: Show Definition where
+  show a = genericShow a
+
 -- |
 -- | ```purescript
--- | global [ Global.RankDir  Global.FromLeft ] -- ∷ Definition
+-- | global [ Global.rankDir  Global.FromLeft ] -- ∷ Definition
 -- | ```
 -- | global as a part of a definition
-global :: Array Global.Attr -> Definition
-global = Global
+global :: Array (Attribute { | Global.Attributes }) -> Definition
+global = (foldr ($) Global.defaultAttributes) >>> Global
 
 -- |
 -- | ```purescript
 -- | node "a" [] -- ∷ Definition
 -- | ```
 -- | node as a part of a definition
-node :: Id → Array Node.Attr → Definition
-node id attrs = NodeDef $ Node id attrs
+node :: Id → Array (Attribute { | Node.Attributes }) → Definition
+node id attrs = NodeDef $ Node id (foldr ($) Node.defaultAttributes $ attrs)
 
 -- |
 -- | ```purescript
 -- | edge Forward "a" "b" [] -- ∷ Definition
 -- | ```
 -- | edge as a part of a definition. 
 -- | `==>` and `=*>` can also be used for that purpose.
-edge :: EdgeType → Id → Id → Array Edge.Attr → Definition
-edge t id id2 attrs = EdgeDef $ Edge t id id2 attrs
+edge :: EdgeType → Id → Id → Array (Attribute { | Edge.Attributes }) → Definition
+edge t id id2 attrs = EdgeDef $ Edge t id id2 (foldr ($) Edge.defaultAttributes $ attrs)
 
-forwardEdgeWithAttrs ∷ Id → Id → Array Edge.Attr → Definition
+forwardEdgeWithAttrs ∷ Id → Id → Array (Attribute { | Edge.Attributes }) → Definition
 forwardEdgeWithAttrs = edge Forward
 
 forwardEdge :: Id → Id → Definition
 forwardEdge l r = forwardEdgeWithAttrs l r []
 
-backwardEdgeWithAttrs ∷ Id → Id → Array Edge.Attr → Definition
+backwardEdgeWithAttrs ∷ Id → Id → Array (Attribute { | Edge.Attributes }) → Definition
 backwardEdgeWithAttrs = edge Backward
 
 backwardEdge ∷ Id → Id → Definition
 backwardEdge l r = backwardEdgeWithAttrs l r []
 
-normalEdgeWithAttrs ∷ Id → Id → Array Edge.Attr → Definition
+normalEdgeWithAttrs ∷ Id → Id → Array (Attribute { | Edge.Attributes }) → Definition
 normalEdgeWithAttrs = edge NoDir
 
 normalEdge ∷ Id → Id → Definition
@@ -129,40 +145,45 @@ normalEdge l r = normalEdgeWithAttrs l r []
 -- | ```
 -- | Forward edge as as a definition
 infix 5 forwardEdge as ==>
+
 -- |
 -- | ```purescript
--- | "a" =*> "b" $ [ Edge.FillColor red ]
+-- | "a" =*> "b" $ [ fillColor red ]
 -- | -- toText will be: a -> b [fillcolor="#f44336"];
 -- | ```
 -- | Forward edge with attributes as a definition
 infix 5 forwardEdgeWithAttrs as =*>
+
 -- |
 -- | ```purescript
 -- | "a" <== "b" -- :: Definition
 -- | ```
 -- | Backward edge as a definition
 infix 5 backwardEdge as <==
+
 -- |
 -- | ```purescript
--- | "a" <*= "b" $ [ Edge.FillColor red ]
+-- | "a" <*= "b" $ [ fillColor red ]
 -- | ```
 -- | Backward edge with attributes as a definition
 infix 5 backwardEdgeWithAttrs as <*=
+
 -- |
 -- | ```purescript
 -- | "a" -==- "b"
 -- | ```
 -- | Normal edge as definition
 infix 5 normalEdge as -==-
+
 -- |
 -- | ```purescript
--- | "a" =*= "b" $ [ Edge.FillColor red ]
+-- | "a" =*= "b" $ [ fillColor red ]
 -- | ```
 -- | Normal edge with attibutes
 infix 5 normalEdgeWithAttrs as =*=
 
 instance definitionDotlang :: DotLang Definition where
-  toText (Global attrs) = joinWith "; " (toText <$> attrs) <> "; "
+  toText (Global attrs) = joinWith "; " (attributesToText attrs) <> "; "
   toText (NodeDef n) = toText n <> "; "
   toText (EdgeDef e) = toText e <> "; "
   toText (Subgraph defs) = "subgraph { " <> (joinWith "" $ toText <$> defs) <> "}"
@@ -172,6 +193,10 @@ data Graph
   = Graph (Array Definition)
   | DiGraph (Array Definition)
 
+derive instance genericGraph :: Generic Graph _
+
+instance showGraph :: Show Graph where
+  show = genericShow
 
 instance graphDotLang :: DotLang Graph where
   toText (Graph defs) = "graph {" <> (joinWith "" $ toText <$> defs) <> "}"
@@ -185,5 +210,3 @@ graphFromElements n e = DiGraph $ (NodeDef <$> n) <> (EdgeDef <$> e)
 -- | `a` is a type that can be represented by a Dot-Graph
 class GraphRepr a where
   toGraph :: a -> Graph
-
-