├── .gitignore ├── LICENSE ├── README.md ├── bower.json ├── package-lock.json ├── package.json ├── packages.dhall ├── screenshot.png ├── spago.dhall ├── src ├── Data │ └── GenericGraph.purs └── Graphics │ ├── ConsoleImage.js │ └── ConsoleImage.purs └── test ├── Example.purs └── Main.purs /.gitignore: -------------------------------------------------------------------------------- 1 | /bower_components/ 2 | /node_modules/ 3 | /.pulp-cache/ 4 | /output/ 5 | /generated-docs/ 6 | /.psc-package/ 7 | /.psc* 8 | /.purs* 9 | /.psa* 10 | /.spago/ -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2017 Carsten Csiky 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Generic Graphviz 2 | ==== 3 | 4 | documentation can be found on [pursuit](https://pursuit.purescript.org/packages/purescript-generic-graphviz/) 5 | 6 | consists of 3 parts (which probably *now are* seperate modules..): 7 | 8 | 1. Dot-Lang typed representation and Dot-Lang code-generator. [here](https://github.com/csicar/purescript-dotlang) 9 | 2. Generic Graph generator (takes an arbituary ADT and generates a graph for it) (this repository) 10 | 3. Bindings for Graphviz [here](https://github.com/csicar/purescript-graphviz) 11 | 12 | Example 13 | --- 14 | 15 | ```purescript 16 | -- your data type 17 | data Tree' a = Leaf' | Node' (Tree' a) a (Tree' a) 18 | 19 | -- derive generic 20 | derive instance treeGeneric :: Generic (Tree' a) _ 21 | 22 | -- create instances for the needed type classes 23 | instance treeEdges :: Edges a => Edges (Tree' a) where 24 | edges x = genericEdges x 25 | instance treeDotRepr :: Edges a => GraphRepr (Tree' a) where 26 | toGraph = genericToGraph 27 | 28 | example :: String 29 | example = renderToSvg Dot $ toGraph $ 30 | Node' Leaf' 3 (Node' (Node' Leaf' 5 Leaf') 4 Leaf') 31 | -- example = "............" 32 | ``` 33 | `example` will be: 34 | 35 | 36 | ![screenshot](screenshot.png) 37 | 38 | see [full example](./test/Example.purs) for imports 39 | 40 | see [todo mvc example](https://github.com/csicar/generic-graphviz-todomvc) for a larger example 41 | 42 | Features 43 | -------- 44 | 45 | - generic graph generation 46 | - after `npm install`: usable from nodejs backend 47 | - graphviz-images can be rendered to Chrome's WebDev Console (using console.log) 48 | 49 | TODOs 50 | ----- 51 | 52 | - Refactor into multiple libraries 53 | - support entire DOT language in data model 54 | - allow custom edges in GenericGraph 55 | - add effects to console.image 56 | - move viz.js call into a WebWorker 57 | 58 | Testing 59 | ------- 60 | 61 | run tests: 62 | ```bash 63 | $ pulp test 64 | ``` 65 | 66 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-generic-graphviz", 3 | "ignore": [ 4 | "**/.*", 5 | "node_modules", 6 | "bower_components", 7 | "output" 8 | ], 9 | "license": "MIT", 10 | "repository": { 11 | "type": "git", 12 | "url": "git@github.com:csicar/purescript-generic-graphviz.git" 13 | }, 14 | "dependencies": { 15 | "purescript-prelude": "^3.1.1", 16 | "purescript-console": "^3.0.0", 17 | "purescript-generics-rep": "^6.1.1", 18 | "viz.js": "^1.8.0", 19 | "purescript-dotlang": "^1.1.0", 20 | "purescript-graphviz": "^1.0.0" 21 | }, 22 | "devDependencies": { 23 | "purescript-psci-support": "^3.0.0", 24 | "purescript-test-unit": "^13.0.0" 25 | } 26 | } 27 | -------------------------------------------------------------------------------- /package-lock.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-generic-graphviz", 3 | "version": "1.0.0", 4 | "lockfileVersion": 1, 5 | "requires": true, 6 | "dependencies": { 7 | "viz.js": { 8 | "version": "1.8.0", 9 | "resolved": "https://registry.npmjs.org/viz.js/-/viz.js-1.8.0.tgz", 10 | "integrity": "sha1-4Mta0kE2jjWxpulgaR66RUwklR8=" 11 | } 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-generic-graphviz", 3 | "version": "1.0.0", 4 | "description": "Generic Graphviz", 5 | "main": "app.js", 6 | "directories": { 7 | "test": "test" 8 | }, 9 | "scripts": { 10 | "test": "pulp test", 11 | "build": "pulp build" 12 | }, 13 | "repository": { 14 | "type": "git", 15 | "url": "git+https://github.com/csicar/purescript-generic-graphviz.git" 16 | }, 17 | "author": "csicar", 18 | "license": "MIT", 19 | "bugs": { 20 | "url": "https://github.com/csicar/purescript-generic-graphviz/issues" 21 | }, 22 | "homepage": "https://github.com/csicar/purescript-generic-graphviz#readme", 23 | "dependencies": { 24 | "viz.js": "^1.8.0" 25 | } 26 | } 27 | -------------------------------------------------------------------------------- /packages.dhall: -------------------------------------------------------------------------------- 1 | {- 2 | Welcome to your new Dhall package-set! 3 | 4 | Below are instructions for how to edit this file for most use 5 | cases, so that you don't need to know Dhall to use it. 6 | 7 | ## Warning: Don't Move This Top-Level Comment! 8 | 9 | Due to how `dhall format` currently works, this comment's 10 | instructions cannot appear near corresponding sections below 11 | because `dhall format` will delete the comment. However, 12 | it will not delete a top-level comment like this one. 13 | 14 | ## Use Cases 15 | 16 | Most will want to do one or both of these options: 17 | 1. Override/Patch a package's dependency 18 | 2. Add a package not already in the default package set 19 | 20 | This file will continue to work whether you use one or both options. 21 | Instructions for each option are explained below. 22 | 23 | ### Overriding/Patching a package 24 | 25 | Purpose: 26 | - Change a package's dependency to a newer/older release than the 27 | default package set's release 28 | - Use your own modified version of some dependency that may 29 | include new API, changed API, removed API by 30 | using your custom git repo of the library rather than 31 | the package set's repo 32 | 33 | Syntax: 34 | Replace the overrides' "{=}" (an empty record) with the following idea 35 | The "//" or "⫽" means "merge these two records and 36 | when they have the same value, use the one on the right:" 37 | ------------------------------- 38 | let override = 39 | { packageName = 40 | upstream.packageName // { updateEntity1 = "new value", updateEntity2 = "new value" } 41 | , packageName = 42 | upstream.packageName // { version = "v4.0.0" } 43 | , packageName = 44 | upstream.packageName // { repo = "https://www.example.com/path/to/new/repo.git" } 45 | } 46 | ------------------------------- 47 | 48 | Example: 49 | ------------------------------- 50 | let overrides = 51 | { halogen = 52 | upstream.halogen // { version = "master" } 53 | , halogen-vdom = 54 | upstream.halogen-vdom // { version = "v4.0.0" } 55 | } 56 | ------------------------------- 57 | 58 | ### Additions 59 | 60 | Purpose: 61 | - Add packages that aren't already included in the default package set 62 | 63 | Syntax: 64 | Replace the additions' "{=}" (an empty record) with the following idea: 65 | ------------------------------- 66 | let additions = 67 | { "package-name" = 68 | { dependencies = 69 | [ "dependency1" 70 | , "dependency2" 71 | ] 72 | , repo = 73 | "https://example.com/path/to/git/repo.git" 74 | , version = 75 | "tag ('v4.0.0') or branch ('master')" 76 | } 77 | , "package-name" = 78 | { dependencies = 79 | [ "dependency1" 80 | , "dependency2" 81 | ] 82 | , repo = 83 | "https://example.com/path/to/git/repo.git" 84 | , version = 85 | "tag ('v4.0.0') or branch ('master')" 86 | } 87 | , etc. 88 | } 89 | ------------------------------- 90 | 91 | Example: 92 | ------------------------------- 93 | let additions = 94 | { benchotron = 95 | { dependencies = 96 | [ "arrays" 97 | , "exists" 98 | , "profunctor" 99 | , "strings" 100 | , "quickcheck" 101 | , "lcg" 102 | , "transformers" 103 | , "foldable-traversable" 104 | , "exceptions" 105 | , "node-fs" 106 | , "node-buffer" 107 | , "node-readline" 108 | , "datetime" 109 | , "now" 110 | ], 111 | , repo = 112 | "https://github.com/hdgarrood/purescript-benchotron.git" 113 | , version = 114 | "v7.0.0" 115 | } 116 | } 117 | ------------------------------- 118 | -} 119 | let upstream = 120 | https://github.com/purescript/package-sets/releases/download/psc-0.14.0-20210324/packages.dhall sha256:b4564d575da6aed1c042ca7936da97c8b7a29473b63f4515f09bb95fae8dddab 121 | 122 | let overrides = {=} 123 | 124 | let additions = 125 | { graphviz = 126 | { dependencies = 127 | [ "aff" 128 | , "console" 129 | , "dotlang" 130 | , "effect" 131 | , "functions" 132 | , "node-fs" 133 | , "node-fs-aff" 134 | , "prelude" 135 | , "psci-support" 136 | , "test-unit" 137 | ] 138 | , repo = "https://github.com/csicar/purescript-graphviz" 139 | , version = "v1.3.0" 140 | }, 141 | dotlang = 142 | { dependencies = 143 | [ "colors" 144 | , "console" 145 | , "effect" 146 | , "prelude" 147 | , "psci-support" 148 | , "strings" 149 | , "test-unit" 150 | ] 151 | , repo = "https://github.com/csicar/purescript-dotlang.git" 152 | , version = "master" 153 | } 154 | } 155 | 156 | in upstream // overrides // additions 157 | -------------------------------------------------------------------------------- /screenshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/csicar/purescript-generic-graphviz/065d5d965af3ce0a30b1093ff3ccc0e08e59f6f5/screenshot.png -------------------------------------------------------------------------------- /spago.dhall: -------------------------------------------------------------------------------- 1 | {- 2 | Welcome to a Spago project! 3 | You can edit this file as you like. 4 | -} 5 | { name = "generic-graphviz" 6 | , dependencies = 7 | [ "console" 8 | , "dotlang" 9 | , "effect" 10 | , "graphviz" 11 | , "prelude" 12 | , "psci-support" 13 | , "test-unit" 14 | , "typelevel-prelude" 15 | ] 16 | , packages = ./packages.dhall 17 | , sources = [ "src/**/*.purs", "test/**/*.purs" ] 18 | } 19 | -------------------------------------------------------------------------------- /src/Data/GenericGraph.purs: -------------------------------------------------------------------------------- 1 | module Data.GenericGraph where 2 | 3 | import Control.Semigroupoid ((>>>)) 4 | import Data.List(List(..)) 5 | import Data.Array (concat, foldr, (!!), (:)) 6 | import Data.DotLang (Edge(..), EdgeType(..), Graph, Node(..), graphFromElements, changeNodeId, nodeId) 7 | import Data.DotLang.Attr (FillStyle(..)) 8 | import Data.DotLang.Attr.Edge as E 9 | import Data.DotLang.Attr.Node as N 10 | import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments, NoConstructors, Product(..), Sum(..), from) 11 | import Data.Maybe (Maybe(..), fromMaybe) 12 | import Data.String (joinWith) 13 | import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol) 14 | import Data.Tuple (Tuple(..), fst) 15 | import Prelude (class Show, identity, show, ($), (+), (<$>), (<>)) 16 | import Prim.Row (class Cons, class Lacks) 17 | import Prim.RowList (class RowToList, Nil, Cons) 18 | import Record as Record 19 | import Type.Data.RowList (RLProxy(..)) 20 | import Type.RowList (class ListToRow) 21 | 22 | -- Tree type 23 | data Tree a = Root a (Array (Tree a)) 24 | 25 | derive instance genericTree :: Generic (Tree a) _ 26 | 27 | instance showTree :: Show a => Show (Tree a) where 28 | show (Root a l) = (show a) <> "( " <> (joinWith "\n" $ show <$> l) <> ")" 29 | 30 | class Edges a where 31 | edges :: a -> Tree (Maybe Node) 32 | 33 | 34 | class GenericEdges a where 35 | genericEdges' :: a -> Tree (Maybe Node) 36 | 37 | instance genericEdgesNoConstructors :: GenericEdges NoConstructors where 38 | genericEdges' _ = Root Nothing [] 39 | 40 | instance genericEdgesNoArguments :: GenericEdges NoArguments where 41 | genericEdges' _ = Root Nothing [] 42 | 43 | instance genericEdgesSum :: (GenericEdges a, GenericEdges b) => GenericEdges (Sum a b) where 44 | genericEdges' (Inl a) = genericEdges' a 45 | genericEdges' (Inr b) = genericEdges' b 46 | 47 | instance genericEdgesProduct :: (GenericEdges a, GenericEdges b) => GenericEdges (Product a b) where 48 | genericEdges' (Product a b) = Root Nothing [genericEdges' a, genericEdges' b] 49 | 50 | instance genericEdgesConstructor :: (GenericEdges a, IsSymbol name) => GenericEdges (Constructor name a) where 51 | genericEdges' (Constructor a) = Root (Just $ Node constructorName []) [ genericEdges' a ] 52 | where 53 | constructorName = reflectSymbol (SProxy :: SProxy name) 54 | 55 | 56 | instance stringEdge :: Edges String where 57 | edges a = Root (Just $ Node (show a) []) [] 58 | 59 | instance intEdge :: Edges Int where 60 | edges i = Root (Just $ Node (show i) []) [] 61 | 62 | instance numberEdge :: Edges Number where 63 | edges n = Root (Just $ Node (show n) []) [] 64 | 65 | instance charEdge :: Edges Char where 66 | edges c = Root (Just $ Node (show c) []) [] 67 | 68 | instance boolEdge :: Edges Boolean where 69 | edges b = Root (Just $ Node (show b) []) [] 70 | 71 | instance arrayEdges :: Edges a => Edges (Array a) where 72 | edges [] = Root (Just $ Node "[]" []) [] 73 | edges a = Root (Just $ Node ("array") []) (edges <$> a) 74 | 75 | instance listEdges :: Edges a => Edges (List a) where 76 | edges Nil = Root (Just $ Node ("Nil") []) [] 77 | edges (Cons a as) = case edges a of 78 | (Root n _) -> Root n [edges as] 79 | 80 | instance genericReprArgument :: Edges a => GenericEdges (Argument a) where 81 | genericEdges' (Argument a) = edges a 82 | 83 | class (RowToList r rl) <= GenericEdgesRowList r rl | rl -> r where 84 | rlEdges :: RLProxy rl -> Record r -> Array (Tree (Maybe Node)) 85 | 86 | instance emptyRowToEdge :: (RowToList r Nil) => GenericEdgesRowList r Nil where 87 | rlEdges _ _ = [] 88 | 89 | 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 90 | rlEdges _ r = Root (Just $ Node fieldName []) [edges fieldValue] : rlEdges (RLProxy :: RLProxy tail) (Record.delete fieldSymbol r) 91 | where 92 | fieldSymbol = SProxy :: SProxy name 93 | fieldName = reflectSymbol fieldSymbol 94 | fieldValue :: ty 95 | fieldValue = Record.get fieldSymbol r 96 | 97 | instance genericEdgesRec :: (RowToList r rl, GenericEdgesRowList r rl) => Edges (Record r) where 98 | edges r = Root (Just $ Node "root" []) (rlEdges (RLProxy :: RLProxy rl) r) 99 | 100 | -- | A `Generic` implementation of the `eq` member from the `Eq` type class. 101 | genericEdges :: forall a rep. Generic a rep => GenericEdges rep => a -> Tree (Maybe Node) 102 | genericEdges a = genericEdges' (from a) 103 | 104 | eliminateNothings :: ∀a. Tree (Maybe a) -> Array (Tree a) 105 | eliminateNothings (Root Nothing list) = concat $ eliminateNothings <$> list 106 | eliminateNothings (Root (Just a) list) = [Root a $ concat $ eliminateNothings <$> list] 107 | 108 | uniqueNode :: Tree Node -> Tuple Int (Array (Tree Node)) -> Tuple Int (Array (Tree Node)) 109 | uniqueNode child (Tuple accId accChildren) = let 110 | Tuple newChild newId = uniqueNodes' accId child 111 | in 112 | Tuple newId (newChild : accChildren) 113 | 114 | uniqueNodes' :: Int -> Tree Node -> Tuple (Tree Node) Int 115 | uniqueNodes' id' (Root node children) = let 116 | newNode = changeNodeId (\name -> show id') node 117 | id = id' + 1 118 | Tuple finalId newChildren = foldr uniqueNode (Tuple id []) children 119 | in Tuple (Root newNode newChildren) finalId 120 | 121 | uniqueNodes :: Tree Node -> Tree Node 122 | uniqueNodes = (uniqueNodes' 0) >>> fst 123 | 124 | extractEdges :: Node -> Tree Node -> Array Edge 125 | extractEdges parent (Root node children) = [Edge Forward (nodeId parent) (nodeId node) []] <> 126 | (concat $ 127 | (extractEdges node) <$> children) 128 | 129 | extractNodes :: Tree Node -> Array Node 130 | extractNodes (Root node children) = node : (concat $ extractNodes <$> children) 131 | 132 | -- | genenric version of toGraph not renaming nodes. 133 | genericToGraphUnique ∷ ∀a. Edges a => a -> Graph 134 | genericToGraphUnique e 135 | = identity 136 | $ (\f -> graphFromElements ((Node "root" [N.Style Invis]) : extractNodes f) (extractEdges (Node "root" []) f)) 137 | $ fromMaybe (Root (Node "" []) []) 138 | $ (\a -> a !! 0) 139 | $ eliminateNothings 140 | $ edges e 141 | 142 | -- | generic version of toGraph. Renaming Nodes to make them unique 143 | genericToGraph :: ∀a. Edges a => a -> Graph 144 | genericToGraph e 145 | = identity 146 | $ (\f -> graphFromElements ((Node "root" [N.Style Invis]) : extractNodes f) (extractEdges (Node "root" []) f)) 147 | $ uniqueNodes 148 | $ fromMaybe (Root (Node "" []) []) 149 | $ (\a -> a !! 0) 150 | $ eliminateNothings 151 | $ edges e 152 | -------------------------------------------------------------------------------- /src/Graphics/ConsoleImage.js: -------------------------------------------------------------------------------- 1 | "use strict"; 2 | 3 | 4 | // based on https://github.com/adriancooney/console.image 5 | exports.consoleImage = function(scale) { 6 | return function(url) { 7 | function getBox(width, height) { 8 | return { 9 | string: "+", 10 | style: "font-size: 1px; padding: " + Math.floor(height/2) + "px " + Math.floor(width/2) + "px; line-height: " + height + "px;" 11 | } 12 | } 13 | scale = scale || 1; 14 | var img = new Image(); 15 | 16 | img.onload = function() { 17 | var dim = getBox(this.width * scale, this.height * scale); 18 | console.log("%c" + dim.string, dim.style + "background: url(" + url + "); background-size: " + (this.width * scale) + "px " + (this.height * scale) + "px; color: transparent;"); 19 | }; 20 | 21 | img.src = url; 22 | } 23 | }; 24 | 25 | exports.consoleSvgToPngImage = function(scale) { 26 | return function(svg) { 27 | var v = undefined; 28 | if (typeof window === "undefined") { 29 | v = require('viz.js'); 30 | } else { 31 | v = Viz; 32 | } 33 | return v.svgXmlToPngBase64(svg, scale, function(err, data) { 34 | if (err) {console.error(err)} 35 | var url = "data:image/png;base64,"+data 36 | exports.consoleImage(scale)(url); 37 | }) 38 | } 39 | } 40 | -------------------------------------------------------------------------------- /src/Graphics/ConsoleImage.purs: -------------------------------------------------------------------------------- 1 | module Graphics.ConsoleImage where 2 | 3 | import Data.Unit (Unit) 4 | 5 | foreign import consoleImage :: Number -> String -> Unit 6 | 7 | foreign import consoleSvgToPngImage :: Number -> String -> Unit 8 | -------------------------------------------------------------------------------- /test/Example.purs: -------------------------------------------------------------------------------- 1 | module Test.Example where 2 | 3 | import Data.DotLang (class GraphRepr, toGraph) 4 | import Data.Function (($)) 5 | import Data.Generic.Rep (class Generic) 6 | import Data.GenericGraph (class Edges, genericEdges, genericToGraph) 7 | import Graphics.Graphviz (Engine(..), renderToSvg) 8 | 9 | 10 | data Tree' a = Leaf' | Node' (Tree' a) a (Tree' a) 11 | 12 | derive instance treeGeneric :: Generic (Tree' a) _ 13 | 14 | instance treeEdges :: Edges a => Edges (Tree' a) where edges x = genericEdges x 15 | instance treeDotRepr :: Edges a => GraphRepr (Tree' a) where toGraph = genericToGraph 16 | 17 | example :: String 18 | example = renderToSvg Dot $ toGraph $ 19 | Node' Leaf' 3 (Node' (Node' Leaf' 5 Leaf') 4 Leaf') 20 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | 5 | import Data.DotLang (class GraphRepr, toGraph) 6 | import Data.DotLang.Class (toText) 7 | import Data.Foldable (foldr) 8 | import Data.Generic.Rep (class Generic) 9 | import Data.GenericGraph (class Edges, genericEdges, genericToGraph) 10 | import Data.List (List(..)) as L 11 | import Data.Show.Generic (genericShow) 12 | import Effect (Effect) 13 | import Test.Unit (suite, test) 14 | import Test.Unit.Assert (equal) 15 | import Test.Unit.Main (runTest) 16 | 17 | --Simple 18 | data Simple = A | B 19 | 20 | derive instance genericSimple :: Generic Simple _ 21 | instance simpleToDot :: GraphRepr Simple where 22 | toGraph = genericToGraph 23 | instance simpleEdges :: Edges Simple where 24 | edges = genericEdges 25 | 26 | --Rec 27 | data Rec = Leaf | Node Rec 28 | 29 | derive instance recGeneric :: Generic Rec _ 30 | 31 | instance recGraphRepr :: GraphRepr Rec where toGraph = genericToGraph 32 | instance recEdges :: Edges Rec where edges x = genericEdges x 33 | 34 | 35 | --List 36 | data List' a = Nil | Cons' a (List' a) 37 | 38 | derive instance listGeneric :: Generic (List' a) _ 39 | 40 | instance listEdges :: Edges a => Edges (List' a) where edges x = genericEdges x 41 | instance listGraphRepr ∷ Edges a => GraphRepr (List' a) where toGraph = genericToGraph 42 | 43 | fromArray :: ∀a. Array a -> List' a 44 | fromArray = foldr Cons' Nil 45 | 46 | --Tree 47 | data Tree' a = Leaf' | Node' (Tree' a) a (Tree' a) 48 | 49 | derive instance treeGeneric :: Generic (Tree' a) _ 50 | 51 | instance treeEdges :: Edges a => Edges (Tree' a) where edges x = genericEdges x 52 | instance treeDotRepr :: Edges a => GraphRepr (Tree' a) where toGraph = genericToGraph 53 | 54 | -- Todo 55 | newtype Todo = Todo 56 | { id :: Int 57 | , text :: String 58 | , newText :: String 59 | , completed :: Boolean 60 | , editing :: Boolean 61 | } 62 | 63 | derive instance genericTodo :: Generic Todo _ 64 | instance showTodo :: Show Todo where show = genericShow 65 | 66 | instance graphReprTodo :: GraphRepr Todo where toGraph = genericToGraph 67 | instance egdesTodo :: Edges Todo where edges x = genericEdges x 68 | 69 | -- main = do 70 | -- log $ toText $ genericToGraph $ fromArray [1, 2, 3, 4, 7] 71 | -- log $ toText $ toGraph $ (Node' Leaf' 3 (Node' (Node' Leaf' 5 Leaf') 4 Leaf')) 72 | -- val <- example 73 | -- main' 74 | 75 | 76 | main :: Effect Unit 77 | main = runTest do 78 | suite "GenericGraph" do 79 | test "simple" do 80 | equal "digraph {root [style=invis]; 0 [label=\"A\"]; root -> 0 []; }" (toText $ toGraph A) 81 | test "recursive" do 82 | equal 83 | "digraph {root [style=invis]; 0 [label=\"Node\"]; 1 [label=\"Node\"]; 2 [label=\"Leaf\"]; root -> 0 []; 0 -> 1 []; 1 -> 2 []; }" 84 | (toText $ toGraph $ Node (Node Leaf)) 85 | test "list" do 86 | equal 87 | "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 []; }" 88 | (toText $ toGraph $ Cons' 1 (Cons' 2 Nil)) 89 | test "prelude.list Cons" do 90 | equal 91 | "digraph {root [style=invis]; 0 [label=\"1\"]; 1 [label=\"2\"]; 2 [label=\"6\"]; 3 [label=\"Nil\"]; root -> 0 []; 0 -> 1 []; 1 -> 2 []; 2 -> 3 []; }" 92 | (toText $ genericToGraph $ L.Cons 1 (L.Cons 2 (L.Cons 6 L.Nil))) 93 | test "prelude.list Nil" do 94 | equal 95 | "digraph {root [style=invis]; 0 [label=\"Nil\"]; root -> 0 []; }" 96 | (toText $ genericToGraph $ (L.Nil :: L.List Int)) 97 | test "tree" do 98 | equal 99 | "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 []; }" 100 | (toText $ toGraph $ Node' Leaf' 3 (Node' (Node' Leaf' 5 Leaf') 4 Leaf')) 101 | test "record" do 102 | let example = toText $ toGraph $ Todo {id: 1, text: "asd", newText: "asd", completed: true, editing: true } 103 | equal 104 | "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 []; }" 105 | example 106 | --------------------------------------------------------------------------------