├── .dockerignore ├── .gitignore ├── BUILD.md ├── Dockerfile ├── LICENSE ├── README.md ├── Setup.hs ├── build-image.sh ├── cli └── Main.hs ├── dataflow.cabal ├── examples ├── Makefile ├── legend.dfd.png ├── legend.flow ├── legend.html ├── legend.json ├── legend.seq.png ├── template.ha ├── webapp.dfd.png ├── webapp.flow ├── webapp.html ├── webapp.json └── webapp.seq.png ├── run-tests.sh ├── src └── DataFlow │ ├── Attributes.hs │ ├── Core.hs │ ├── DFD.hs │ ├── Graphviz.hs │ ├── Graphviz │ ├── EdgeNormalization.hs │ └── Renderer.hs │ ├── JSONGraphFormat.hs │ ├── JSONGraphFormat │ └── Renderer.hs │ ├── Mustache │ └── Renderer.hs │ ├── PlantUML.hs │ ├── PlantUML │ └── Renderer.hs │ ├── PrettyRenderer.hs │ ├── Reader.hs │ ├── SequenceDiagram.hs │ └── Validation.hs ├── test ├── DataFlow │ ├── Assertions.hs │ ├── Graphviz │ │ └── RendererSpec.hs │ ├── JSONGraphFormat │ │ └── RendererSpec.hs │ ├── ReaderSpec.hs │ └── ValidationSpec.hs └── Spec.hs └── watch-tests.sh /.dockerignore: -------------------------------------------------------------------------------- 1 | dist 2 | .cabal-sandbox 3 | cabal.sandbox.config 4 | tags 5 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | .cabal-sandbox 3 | cabal.sandbox.config 4 | tags 5 | -------------------------------------------------------------------------------- /BUILD.md: -------------------------------------------------------------------------------- 1 | # Build Instructions 2 | 3 | ## Setup 4 | 5 | ```bash 6 | cabal sandbox init # optional 7 | cabal install --only-dependencies --enable-tests 8 | cabal configure --enable-tests 9 | ``` 10 | 11 | ## Build 12 | 13 | ```bash 14 | cabal build 15 | ``` 16 | 17 | ## Install 18 | 19 | If you initialized a sandbox the executable will end up in the sandbox, i.e. 20 | `.cabal-sandbox/bin/dataflow`. If you have no sandbox it will end up in 21 | `~/.cabal/bin/dataflow`. If you get any stange errors during install try a `cabal clean` 22 | 23 | ```bash 24 | cabal install 25 | ``` 26 | 27 | ## Tests 28 | 29 | ```bash 30 | ./run-tests.sh 31 | # or... 32 | ./watch-tests.sh 33 | ``` 34 | 35 | ## Building the Examples 36 | 37 | ```bash 38 | make -C examples 39 | ``` 40 | -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | FROM ubuntu:15.10 2 | MAINTAINER Oskar Wickström 3 | 4 | # HASKELL 5 | 6 | RUN apt-get update && \ 7 | apt-get install -y haskell-platform 8 | 9 | ## DATAFLOW 10 | 11 | ENV LANG C.UTF-8 12 | 13 | ADD . /usr/local/dataflow 14 | WORKDIR /usr/local/dataflow 15 | 16 | RUN ghc-pkg unregister HTTP 17 | RUN ghc-pkg unregister vector 18 | RUN ghc-pkg unregister QuickCheck 19 | RUN ghc-pkg unregister tf-random 20 | 21 | RUN cabal update && \ 22 | cabal sandbox init && \ 23 | cabal install --only-dependencies && \ 24 | cabal configure && \ 25 | cabal install 26 | 27 | RUN ln -s /usr/local/dataflow/.cabal-sandbox/bin/dataflow /usr/bin/dataflow 28 | 29 | WORKDIR /root 30 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015, Sony Mobile AB 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | * Redistributions of source code must retain the above copyright 7 | notice, this list of conditions and the following disclaimer. 8 | * Redistributions in binary form must reproduce the above copyright 9 | notice, this list of conditions and the following disclaimer in the 10 | documentation and/or other materials provided with the distribution. 11 | * Neither the name of the nor the 12 | names of its contributors may be used to endorse or promote products 13 | derived from this software without specific prior written permission. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL BE LIABLE FOR ANY 19 | DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 22 | ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # DataFlow 2 | 3 | Render graphs using a declarative markup. Currently supports DFD 4 | (http://en.wikipedia.org/wiki/Data_flow_diagram) and sequence diagrams 5 | (http://plantuml.sourceforge.net/sequence.html). 6 | 7 | ![DFD Output](examples/webapp.dfd.png) 8 | 9 | ## Installation 10 | 11 | * To install using cabal run: 12 | 13 | ```bash 14 | $ cabal install dataflow 15 | ``` 16 | * There are some binaries available in 17 | [Releases](https://github.com/sonyxperiadev/dataflow/releases). 18 | 19 | * If you want to use Docker there are images available [on Docker Hub]( 20 | https://hub.docker.com/r/owickstrom/dataflow/). 21 | 22 | * For build instructions see [BUILD.md](BUILD.md). 23 | 24 | ## Usage 25 | 26 | The following forms are supported by DataFlow. 27 | 28 | #### IDs 29 | 30 | An ID can contain letters, numbers and underscores. It must start with a 31 | letter. 32 | 33 | 34 | ```dot 35 | my_id_contain_4_words 36 | ``` 37 | 38 | #### Strings 39 | 40 | String literals are written using double quotes. 41 | 42 | ```dot 43 | "this is a string and it can contain everything but double quotes and newlines" 44 | ``` 45 | 46 | **NOTE!** Escaping characters inside strings is not supported at the moment. 47 | 48 | #### Text Blocks 49 | 50 | Text blocks are special strings, enclosed in backticks, that are can span 51 | multiple lines in the source document. The space characters before the first 52 | non-space characters on each line are trimmed, regardless of the indentation. 53 | 54 | ```dot 55 | `this is 56 | a 57 | textblock` 58 | ``` 59 | 60 | ... is converted to: 61 | 62 | ``` 63 | this is 64 | a 65 | textblock 66 | ``` 67 | 68 | #### Arrays 69 | 70 | Arrays can contain other values (arrays, strings, text blocks). 71 | 72 | ```dot 73 | ["hello", "world", ["I", "am", `nested 74 | here`]] 75 | ``` 76 | 77 | #### Attributes 78 | 79 | Attributes are key-value pairs for diagrams and nodes that are used by 80 | output renderers. Attributes are enclosed by curly brackets. For nodes that 81 | can contain other nodes, attributes must appear before nodes. 82 | 83 | Keys have the same rules as IDs. Values can be strings or text blocks. 84 | 85 | ```dot 86 | { 87 | key1 = "attr value" 88 | key2 = `attr 89 | value` 90 | key3 = ["value1", "value2"] 91 | } 92 | ``` 93 | 94 | #### `diagram` 95 | 96 | `diagram` is the top-level form and must appear exactly once in a DataFlow 97 | document. It can contain attributes and nodes. 98 | 99 | ```dot 100 | diagram { 101 | title = "My diagram" 102 | } 103 | ``` 104 | 105 | #### `boundary` 106 | 107 | The `boundary` form declares a TrustBoundary node that can contain 108 | attributes and other nodes. Boundaries are only allowed in the top-level 109 | diagram and they must have unique IDs. 110 | 111 | ```dot 112 | diagram { 113 | boundary my_boundary { 114 | title = "My System" 115 | } 116 | } 117 | ``` 118 | 119 | #### nodes: `io`, `function`, `database` 120 | 121 | The `io`, `function` and `database` forms declare `InputOutput`, `Function` and 122 | `Database` nodes, respectively. The nodes have IDs and they can contain 123 | attributes. Empty attribute brackets can be omitted. 124 | 125 | ```dot 126 | diagram { 127 | io thing1 128 | 129 | io thing2 { 130 | title = "Thing 2" 131 | } 132 | } 133 | 134 | ``` 135 | 136 | #### `->` 137 | 138 | The `->` form declares a `Flow` between the nodes referenced by their 139 | IDs. It can contain attributes. Empty attribute brackets can be omitted. 140 | Flows must be declared after all nodes. 141 | 142 | Note that the arrow can be reversed as well (`<-`). 143 | 144 | ```dot 145 | diagram { 146 | thing1 -> thing2 147 | 148 | thing1 <- thing2 { 149 | operation = "Greet" 150 | data = "A nice greeting" 151 | } 152 | } 153 | ``` 154 | 155 | #### Comment 156 | 157 | Comments are written using `/*` and `*/` and are ignored by the Reader. They're 158 | only used for human consumption. 159 | 160 | ```dot 161 | diagram { 162 | /* I can write 163 | * whatever I 164 | * want in here! */ 165 | } 166 | ``` 167 | 168 | ## Example 169 | 170 | The image from the top of this README is rendered from the following DataFlow 171 | document. 172 | 173 | ```dot 174 | diagram { 175 | title = "Webapp" 176 | 177 | /* Some comment about this... */ 178 | threats = ` 179 | No particular threats at this point. 180 | 181 | It's **extremely** safe.` 182 | 183 | boundary browser { 184 | title = "Browser" 185 | 186 | function client { 187 | title = "Client" 188 | } 189 | } 190 | 191 | boundary aws { 192 | title = "Amazon AWS" 193 | 194 | function server { 195 | title = "Web Server" 196 | } 197 | database logs { 198 | title = "Logs" 199 | } 200 | } 201 | io analytics { 202 | title = "Google Analytics" 203 | } 204 | 205 | client -> server { 206 | operation = "Request /" 207 | description = `User navigates with a browser to see some content.` 208 | } 209 | server -> logs { 210 | operation = "Log" 211 | data = `The user 212 | IP address.` 213 | description = `Logged to a ELK stack.` 214 | } 215 | server -> client { 216 | operation = "Response" 217 | data = "User Profile" 218 | description = `The server responds with some HTML.` 219 | } 220 | analytics <- client { 221 | operation = "Log" 222 | data = "Page Navigation" 223 | description = `The Google Analytics plugin sends navigation 224 | data to Google.` 225 | } 226 | } 227 | ``` 228 | 229 | ## Run DataFlow 230 | 231 | The `dataflow` executable takes an output format and a DataFlow source document 232 | and writes the output to `stdout`. 233 | 234 | ```bash 235 | dataflow (dfd|seq) FILE 236 | ``` 237 | 238 | ## DFD 239 | 240 | ![DFD Legend](examples/legend.dfd.png) 241 | 242 | To use the *DFD* output you need [Graphviz](http://www.graphviz.org/) installed. 243 | 244 | ```bash 245 | dataflow dfd webapp.flow | dot -Tpng > webapp.png 246 | ``` 247 | ### Output 248 | 249 | ![DFD Output](examples/webapp.dfd.png) 250 | 251 | ## Sequence Diagram 252 | 253 | ![Sequence Diagram Legend](examples/legend.seq.png) 254 | 255 | You can use [PlantUML](http://plantuml.sourceforge.net/) to generate a sequence 256 | diagram. 257 | 258 | ```bash 259 | dataflow seq webapp.flow | java -Djava.awt.headless=true -jar plantuml.jar -tpng -pipe > webapp.png 260 | ``` 261 | 262 | ### Output 263 | 264 | ![Sequence Diagram Output](examples/webapp.seq.png) 265 | 266 | ## Templating 267 | 268 | You can use [Mustache](https://mustache.github.io/) to output arbitrary text. 269 | 270 | ```bash 271 | dataflow template template.ha webapp.flow > webapp.html 272 | ``` 273 | 274 | ### Built-in Functions and Values 275 | 276 | * `markdown` - Convert the attribute at the given key from Markdown to HTML. 277 | 278 | ```mustache 279 | {{#markdown}}my_markdown_attr{{/markdown}} 280 | ``` 281 | 282 | * `html_linebreaks` - Replace `\n` with `
` elements in the attribute at 283 | the given key, to retain linebreaks in HTML output. 284 | 285 | ```mustache 286 | {{#html_linebreaks}}my_formatted_attr{{/html_linebreaks}} 287 | ``` 288 | 289 | * `filename_without_extension` - The input `.flow` file name with no path and 290 | no extension. Useful when generating graphics and text/HTML with matching 291 | filenames (e.g. `my-flow.html` includes `my-flow.png`). 292 | 293 | ```mustache 294 | 295 | ``` 296 | 297 | * `flows` - a list of all the Flow nodes in the diagram. Attributes of the 298 | flow is accessible inside the iteration scope, including a `number`. 299 | 300 | ```mustache 301 |
    302 | {{#flows}} 303 |
  1. {{number}} - {{description}}
    2. 304 | {{/flows}} 305 |
306 | ``` 307 | 308 | For an example see [template.ha](examples/template.ha) and the output HTML in 309 | [webapp.html](examples/webapp.html). 310 | 311 | ### Output 312 | 313 | ![Sequence Diagram Output](examples/webapp.seq.png) 314 | 315 | ## Makefile Example 316 | 317 | The following Makefile finds `.flow` sources in `src` and generates DFDs, in 318 | SVG format, in `dist`. 319 | 320 | ```make 321 | SOURCES=$(shell find src/*.flow) 322 | TARGETS=$(SOURCES:src/%.flow=dist/%.dfd.svg) 323 | 324 | K := $(if $(shell which dataflow),,$(error "No dataflow executable in PATH. See https://github.com/SonyMobile/dataflow for install instructions)))")) 325 | 326 | dist/%.dfd.svg: src/%.flow 327 | @dataflow dfd $< | dot -Tsvg > $@ 328 | 329 | dfd: $(TARGETS) 330 | 331 | clean: 332 | rm -f $(TARGETS) 333 | ``` 334 | 335 | ## License 336 | 337 | BSD-3, see [LICENSE](LICENSE). 338 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /build-image.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | VERSION=`grep '^version:' dataflow.cabal | sed -Ee 's/^version\:(.+)$/\1/' | xargs` 4 | echo "Building version $VERSION" 5 | docker build -t owickstrom/dataflow:$VERSION . 6 | -------------------------------------------------------------------------------- /cli/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | module Main where 3 | 4 | import Development.GitRev 5 | import qualified Data.ByteString.Lazy.Char8 as BC 6 | import qualified Data.Text.IO as T 7 | import qualified Data.Text.Lazy.IO as TL 8 | import System.IO 9 | import System.Environment 10 | import System.Exit 11 | 12 | import DataFlow.Reader 13 | import DataFlow.Core 14 | import qualified DataFlow.Validation as V 15 | import qualified DataFlow.DFD as DFD 16 | import qualified DataFlow.SequenceDiagram as SEQ 17 | import qualified DataFlow.Graphviz.Renderer as GVR 18 | import qualified DataFlow.PlantUML.Renderer as PUR 19 | import qualified DataFlow.Mustache.Renderer as MR 20 | import qualified DataFlow.JSONGraphFormat.Renderer as JG 21 | 22 | usage :: IO () 23 | usage = hPutStrLn stderr $ unlines [ 24 | "Usage: dataflow command args*", 25 | "", 26 | "Commands", 27 | "--------", 28 | "dfd SRC - outputs a DFD in the Graphviz DOT format", 29 | "seq SRC - outputs a sequence diagram in PlantUML format", 30 | "template TEMPLATE SRC - renders the TEMPLATE using data from SRC", 31 | "json SRC - outputs a sequence diagram in JSON Graph Format", 32 | " (http://jsongraphformat.info/)", 33 | "validate SRC - validates the input", 34 | "", 35 | "--version - display VCS information", 36 | "--help - display this help message", 37 | "", 38 | "All commands print to stdout" 39 | ] 40 | 41 | showErrors :: Show s => Either [s] v -> Either String v 42 | showErrors = either (Left . unlines . map show) Right 43 | 44 | readAndValidate :: FilePath -> IO (Either String Diagram) 45 | readAndValidate path = do 46 | res <- readDiagramFile path 47 | case res of 48 | (Left err) -> return $ Left $ show err 49 | (Right d) -> return (showErrors $ V.validate d) 50 | 51 | dfd :: FilePath -> IO () 52 | dfd path = do 53 | res <- readAndValidate path 54 | case res of 55 | (Left err) -> putStrLn err 56 | (Right d) -> putStr $ GVR.renderGraphviz $ DFD.asDFD d 57 | 58 | seq' :: FilePath -> IO () 59 | seq' path = do 60 | res <- readAndValidate path 61 | case res of 62 | (Left err) -> putStrLn err 63 | (Right d) -> putStr $ PUR.renderPlantUML $ SEQ.asSequenceDiagram d 64 | 65 | template :: FilePath -> FilePath -> IO () 66 | template tmplPath path = do 67 | res <- readAndValidate path 68 | tmplStr <- readFile tmplPath 69 | case res of 70 | (Left err) -> putStrLn err 71 | (Right d) -> either print T.putStr $ MR.renderTemplate tmplStr path d 72 | 73 | json :: FilePath -> IO () 74 | json path = do 75 | res <- readAndValidate path 76 | case res of 77 | (Left err) -> putStrLn err 78 | (Right d) -> BC.putStrLn $ JG.renderJSONGraph d 79 | 80 | validate :: FilePath -> IO () 81 | validate path = do 82 | res <- readAndValidate path 83 | case res of 84 | (Left err) -> putStrLn err 85 | (Right _) -> return () 86 | 87 | version :: IO () 88 | version = do 89 | putStrLn $ "Branch: " ++ $(gitBranch) 90 | putStrLn $ "Hash: " ++ $(gitHash) 91 | 92 | main :: IO () 93 | main = do 94 | args <- getArgs 95 | case args of 96 | ["dfd", path] -> dfd path 97 | ["seq", path] -> seq' path 98 | ["template", tmplPath, path] -> template tmplPath path 99 | ["json", path] -> json path 100 | ["validate", path] -> validate path 101 | ["--version"] -> version 102 | ["--help"] -> usage 103 | _ -> do hPutStrLn stderr "Invalid command!\n\nRun with --help to see usage." 104 | exitWith $ ExitFailure 1 105 | -------------------------------------------------------------------------------- /dataflow.cabal: -------------------------------------------------------------------------------- 1 | name: dataflow 2 | version: 0.7.3.0 3 | synopsis: Generate Graphviz documents from a Haskell representation. 4 | description: Render graphs using a declarative markup. Currently 5 | supports DFD (http://en.wikipedia.org/wiki/Data_flow_diagram) 6 | and sequence diagrams (http://plantuml.sourceforge.net/sequence.html). 7 | homepage: https://github.com/sonyxperiadev/dataflow 8 | license: BSD3 9 | license-file: LICENSE 10 | author: Oskar Wickström (Sony Mobile Communications) 11 | maintainer: oskar.wickstrom@gmail.com 12 | copyright: Sony Mobile Communications 13 | category: Code Generation, Compiler, Graphs 14 | 15 | build-type: Simple 16 | extra-source-files: README.md, 17 | LICENSE, 18 | examples/webapp.flow, 19 | examples/webapp.seq.png, 20 | examples/webapp.dfd.png, 21 | examples/webapp.html, 22 | examples/legend.flow, 23 | examples/legend.seq.png, 24 | examples/legend.dfd.png, 25 | examples/legend.html, 26 | examples/template.ha, 27 | examples/Makefile 28 | cabal-version: >=1.10 29 | 30 | source-repository head 31 | type: git 32 | location: git@github.com:sonyxperiadev/dataflow.git 33 | 34 | library 35 | exposed-modules: 36 | DataFlow.Core, 37 | DataFlow.Attributes, 38 | DataFlow.Validation, 39 | DataFlow.Reader, 40 | DataFlow.PrettyRenderer, 41 | DataFlow.Graphviz, 42 | DataFlow.Graphviz.EdgeNormalization, 43 | DataFlow.Graphviz.Renderer, 44 | DataFlow.PlantUML, 45 | DataFlow.PlantUML.Renderer, 46 | DataFlow.SequenceDiagram, 47 | DataFlow.DFD, 48 | DataFlow.Mustache.Renderer, 49 | DataFlow.JSONGraphFormat, 50 | DataFlow.JSONGraphFormat.Renderer 51 | build-depends: 52 | base >=4 && < 5, 53 | mtl >=2.2, 54 | containers >= 0.4, 55 | MissingH, 56 | parsec >= 3.1.9, 57 | filepath >= 1.3.0, 58 | text >= 1.0, 59 | blaze-html >= 0.8.0.2, 60 | markdown >= 0.1.13.2, 61 | mustache >= 2.3.0, 62 | bytestring >= 0.10, 63 | vector >= 0.11, 64 | aeson >= 0.9.0.1 65 | hs-source-dirs: src 66 | default-language: Haskell2010 67 | 68 | executable dataflow 69 | main-is: Main.hs 70 | build-depends: 71 | base >=4 && < 5, 72 | text >= 1.0, 73 | bytestring >= 0.10, 74 | gitrev >= 1.1.0, 75 | dataflow 76 | hs-source-dirs: cli 77 | default-language: Haskell2010 78 | 79 | test-suite spec 80 | type: exitcode-stdio-1.0 81 | main-is: Spec.hs 82 | default-language: Haskell98 83 | hs-source-dirs: test 84 | build-depends: 85 | base >=4 && < 5, 86 | containers >= 0.4, 87 | parsec >= 3.1.9, 88 | HUnit, 89 | hspec == 2.*, 90 | vector >= 0.11, 91 | aeson >= 0.9.0.1, 92 | bytestring >= 0.10, 93 | dataflow 94 | ghc-options: -Wall 95 | -------------------------------------------------------------------------------- /examples/Makefile: -------------------------------------------------------------------------------- 1 | SOURCES=$(shell find *.flow) 2 | DFD_TARGETS=$(SOURCES:%.flow=%.dfd.png) 3 | SEQ_TARGETS=$(SOURCES:%.flow=%.seq.png) 4 | HTML_TARGETS=$(SOURCES:%.flow=%.html) 5 | HTML_TEMPLATE=template.ha 6 | JSON_TARGETS=$(SOURCES:%.flow=%.json) 7 | DATAFLOW=../dist/build/DataFlow/dataflow 8 | PLANTUML=/tmp/dataflow-build/plantuml.jar 9 | 10 | $(DATAFLOW): 11 | cd .. && cabal build 12 | 13 | $(PLANTUML): 14 | @mkdir -p /tmp/dataflow-build 15 | @wget -qO $(PLANTUML) "http://downloads.sourceforge.net/project/plantuml/plantuml.jar?r=http%3A%2F%2Fsourceforge.net%2Fprojects%2Fplantuml%2F%3Fsource%3Dtyp_redirect&ts=1428479663&use_mirror=freefr" 16 | 17 | %.dfd.png: %.flow $(DATAFLOW) 18 | @echo "$< -> $@" 19 | @$(DATAFLOW) dfd $< | dot -Tpng > $@ 20 | 21 | %.seq.png: %.flow $(DATAFLOW) $(PLANTUML) 22 | @echo "$< -> $@" 23 | @$(DATAFLOW) seq $< | java -Djava.awt.headless=true -jar $(PLANTUML) -tpng -pipe > $@ 24 | 25 | %.html: %.flow $(DATAFLOW) $(HTML_TEMPLATE) 26 | @echo "$< -> $@" 27 | @$(DATAFLOW) template $(HTML_TEMPLATE) $< > $@ 28 | 29 | %.json: %.flow $(DATAFLOW) 30 | @echo "$< -> $@" 31 | @$(DATAFLOW) json $< > $@ 32 | 33 | png: $(DFD_TARGETS) $(SEQ_TARGETS) 34 | 35 | html: $(HTML_TARGETS) 36 | 37 | json: $(JSON_TARGETS) 38 | 39 | clean: 40 | rm -f $(DFD_TARGETS) $(SEQ_TARGETS) 41 | 42 | all: png html json 43 | -------------------------------------------------------------------------------- /examples/legend.dfd.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sonyxperiadev/dataflow/8bef5bd6bf96a918197e66ad9d675ff8cd2a4e33/examples/legend.dfd.png -------------------------------------------------------------------------------- /examples/legend.flow: -------------------------------------------------------------------------------- 1 | /* 2 | * legend.flow 3 | * 4 | * This is nice. 5 | */ 6 | diagram { 7 | title = "Legend" 8 | 9 | boundary my_boundary { 10 | title = "A boundary" 11 | 12 | function f { 13 | title = "function" 14 | } 15 | database d { 16 | title = "database" 17 | } 18 | io i { 19 | title = "io" 20 | } 21 | } 22 | 23 | f -> d { 24 | operation = "Operation 1" 25 | data = ["Data"] 26 | } 27 | i -> f { 28 | operation = "Operation 2" 29 | data = ["Data"] 30 | } 31 | f -> i { 32 | operation = "Operation 3" 33 | data = [ 34 | "Some data", 35 | "Other data" 36 | ] 37 | } 38 | } 39 | -------------------------------------------------------------------------------- /examples/legend.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Legend 6 | 7 | 15 | 16 | 17 |

Legend

18 | 19 | 20 | 21 | Sequence Diagram 22 | 23 |
    24 |
  1. 25 |

    Operation 1

    26 | 27 |
      28 |
    • Data
      • 29 |
    30 | 31 |
    2. 32 |
  2. 33 |

    Operation 2

    34 | 35 |
      36 |
    • Data
      • 37 |
    38 | 39 |
    3. 40 |
  3. 41 |

    Operation 3

    42 | 43 |
      44 |
    • Some data
      • 45 |
    • Other data
      • 46 |
    47 | 48 |
    4. 49 |
50 | 51 |

Threats

52 | 53 |
    54 |
55 | 56 | 57 | 58 | -------------------------------------------------------------------------------- /examples/legend.json: -------------------------------------------------------------------------------- 1 | {"graph":{"metadata":{},"edges":[{"metadata":{"operation":"Operation 1","data":["Data"]},"source":"f","target":"d"},{"metadata":{"operation":"Operation 2","data":["Data"]},"source":"i","target":"f"},{"metadata":{"operation":"Operation 3","data":["Some data","Other data"]},"source":"f","target":"i"}],"nodes":[{"metadata":{"trust-boundary":"my_boundary","type":"function"},"id":"f","label":"function"},{"metadata":{"trust-boundary":"my_boundary","type":"database"},"id":"d","label":"database"},{"metadata":{"trust-boundary":"my_boundary","type":"io"},"id":"i","label":"io"}],"label":"Legend"}} 2 | -------------------------------------------------------------------------------- /examples/legend.seq.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sonyxperiadev/dataflow/8bef5bd6bf96a918197e66ad9d675ff8cd2a4e33/examples/legend.seq.png -------------------------------------------------------------------------------- /examples/template.ha: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | {{title}} 6 | 7 | 15 | 16 | 17 |

{{title}}

18 | 19 | {{#description}} 20 | {{#markdown}}description{{/markdown}} 21 | {{/description}} 22 | 23 | 24 | Sequence Diagram 25 | 26 |
    27 | {{#flows}} 28 |
  1. 29 | {{#operation}} 30 |

    {{{operation}}}

    31 | {{/operation}} 32 | 33 |
      34 | {{#data}} 35 |
    • {{&value}}
      • 36 | {{/data}} 37 |
    38 | 39 | {{#description}} 40 |

    {{#html_linebreaks}}description{{/html_linebreaks}}

    41 | {{/description}} 42 |
    2. 43 | {{/flows}} 44 |
45 | 46 |

Threats

47 | 48 |
    49 | {{#threats}} 50 |
  • {{value}}
    • 51 | {{/threats}} 52 |
53 | 54 | 55 | 56 | -------------------------------------------------------------------------------- /examples/webapp.dfd.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sonyxperiadev/dataflow/8bef5bd6bf96a918197e66ad9d675ff8cd2a4e33/examples/webapp.dfd.png -------------------------------------------------------------------------------- /examples/webapp.flow: -------------------------------------------------------------------------------- 1 | diagram { 2 | title = "Webapp" 3 | 4 | /* Some comment about this... */ 5 | description = ` 6 | No *particular* threats to consider at this point. 7 | 8 | It's **extremely** safe.` 9 | 10 | threats = [ 11 | "csrf", 12 | "mitm" 13 | ] 14 | 15 | boundary browser { 16 | title = "Browser" 17 | 18 | function client { 19 | title = "Client" 20 | } 21 | } 22 | 23 | boundary aws { 24 | title = "Amazon AWS" 25 | 26 | function server { 27 | title = "Web Server" 28 | } 29 | database logs { 30 | title = "Logs" 31 | } 32 | } 33 | io analytics { 34 | title = "Google Analytics" 35 | } 36 | 37 | client -> server { 38 | operation = "Request /" 39 | description = `User navigates with a browser to see some content.` 40 | } 41 | server -> logs { 42 | operation = "Log" 43 | data = [ 44 | "IP Addressuser", 45 | "Timestamprequest", 46 | "Geolocation" 47 | ] 48 | description = `Logged to a ELK stack.` 49 | } 50 | server -> client { 51 | operation = "Response" 52 | data = ["User Profile"] 53 | description = `The server responds with some HTML.` 54 | } 55 | analytics <- client { 56 | operation = "Log" 57 | data = ["Page Navigation"] 58 | description = `The Google Analytics plugin sends navigation 59 | data to Google.` 60 | } 61 | } 62 | -------------------------------------------------------------------------------- /examples/webapp.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Webapp 6 | 7 | 15 | 16 | 17 |

Webapp

18 | 19 |

No particular threats to consider at this point.

It's extremely safe.

20 | 21 | 22 | Sequence Diagram 23 | 24 |
    25 |
  1. 26 |

    Request /

    27 | 28 |
      29 |
    30 | 31 |

    User navigates with a browser to see some content.

    32 |
    2. 33 |
  2. 34 |

    Log

    35 | 36 |
      37 |
    • IP Address<sub>user</sub>
      • 38 |
    • Timestamp<sub>request</sub>
      • 39 |
    • Geolocation
      • 40 |
    41 | 42 |

    Logged to a ELK stack.

    43 |
    3. 44 |
  3. 45 |

    Response

    46 | 47 |
      48 |
    • User Profile
      • 49 |
    50 | 51 |

    The server responds with some HTML.

    52 |
    4. 53 |
  4. 54 |

    Log

    55 | 56 |
      57 |
    • Page Navigation
      • 58 |
    59 | 60 |

    The Google Analytics plugin sends navigation
    data to Google.

    61 |
    5. 62 |
63 | 64 |

Threats

65 | 66 |
    67 |
  • csrf
    • 68 |
  • mitm
    • 69 |
70 | 71 | 72 | 73 | -------------------------------------------------------------------------------- /examples/webapp.json: -------------------------------------------------------------------------------- 1 | {"graph":{"metadata":{"threats":["csrf","mitm"],"description":"\nNo *particular* threats to consider at this point.\n\nIt's **extremely** safe."},"edges":[{"metadata":{"operation":"Request /","description":"User navigates with a browser to see some content."},"source":"client","target":"server"},{"metadata":{"operation":"Log","data":["IP Addressuser","Timestamprequest","Geolocation"],"description":"Logged to a ELK stack."},"source":"server","target":"logs"},{"metadata":{"operation":"Response","data":["User Profile"],"description":"The server responds with some HTML."},"source":"server","target":"client"},{"metadata":{"operation":"Log","data":["Page Navigation"],"description":"The Google Analytics plugin sends navigation\ndata to Google."},"source":"client","target":"analytics"}],"nodes":[{"metadata":{"trust-boundary":"browser","type":"function"},"id":"client","label":"Client"},{"metadata":{"trust-boundary":"aws","type":"function"},"id":"server","label":"Web Server"},{"metadata":{"trust-boundary":"aws","type":"database"},"id":"logs","label":"Logs"},{"metadata":{"type":"io"},"id":"analytics","label":"Google Analytics"}],"label":"Webapp"}} 2 | -------------------------------------------------------------------------------- /examples/webapp.seq.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sonyxperiadev/dataflow/8bef5bd6bf96a918197e66ad9d675ff8cd2a4e33/examples/webapp.seq.png -------------------------------------------------------------------------------- /run-tests.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | cabal exec runhaskell -- -isrc -itest test/Spec.hs 4 | -------------------------------------------------------------------------------- /src/DataFlow/Attributes.hs: -------------------------------------------------------------------------------- 1 | module DataFlow.Attributes where 2 | 3 | import qualified Data.Map as M 4 | import Data.Functor ((<$>)) 5 | 6 | import DataFlow.Core 7 | 8 | -- | Tries to find the title attribute, defaulting to a blank string. 9 | getTitleOrBlank :: Attributes -> String 10 | getTitleOrBlank = show . M.findWithDefault (String "") "title" 11 | 12 | -- | Tries to find the title attribute. 13 | getTitle :: Attributes -> Maybe String 14 | getTitle a = show <$> M.lookup "title" a 15 | -------------------------------------------------------------------------------- /src/DataFlow/Core.hs: -------------------------------------------------------------------------------- 1 | module DataFlow.Core ( 2 | ID, 3 | Value(..), 4 | Attributes, 5 | Diagram(..), 6 | RootNode(..), 7 | Flow(..), 8 | Node(..) 9 | ) where 10 | 11 | import Data.Map as M 12 | 13 | -- | An identifier corresponding to those in Graphviz. 14 | type ID = String 15 | 16 | data Value = String String 17 | | Array [Value] 18 | deriving (Eq) 19 | 20 | instance Show Value where 21 | show (String s) = s 22 | show (Array vs) = show vs 23 | 24 | -- | Attribute key-value pairs can be declared in diagrams, nodes, boundaries 25 | -- | and flows. 26 | type Attributes = M.Map String Value 27 | 28 | -- | The top level diagram. 29 | data Diagram = Diagram Attributes [RootNode] [Flow] 30 | deriving (Eq, Show) 31 | 32 | -- | An root node in a diagram. 33 | data RootNode = 34 | -- | A top level Node. 35 | Node Node 36 | -- | Surrounds other non-root nodes, denoting a boundary. 37 | | TrustBoundary ID Attributes [Node] 38 | deriving (Eq, Show) 39 | 40 | data Node = 41 | -- | An /Input/ or /Output/ in DFD. 42 | InputOutput ID Attributes 43 | -- | A /Function/ in DFD. 44 | | Function ID Attributes 45 | -- | A /Database/ in DFD. 46 | | Database ID Attributes 47 | deriving (Show, Eq) 48 | 49 | -- | Describes the flow of data between two nodes. 50 | data Flow = Flow ID ID Attributes 51 | deriving (Show, Eq) 52 | -------------------------------------------------------------------------------- /src/DataFlow/DFD.hs: -------------------------------------------------------------------------------- 1 | -- | Convert a DataFlow 'C.Diagram' to a Graphviz 'Graph'. 2 | module DataFlow.DFD ( 3 | asDFD 4 | ) where 5 | 6 | import Text.Printf 7 | import Control.Monad 8 | import Control.Monad.State 9 | import qualified Data.Map as M 10 | 11 | import qualified DataFlow.Core as C 12 | import DataFlow.Attributes 13 | import DataFlow.Graphviz 14 | import DataFlow.Graphviz.EdgeNormalization 15 | 16 | type DFDState = Int 17 | type DFD v = State DFDState v 18 | 19 | incrStep :: DFD () 20 | incrStep = modify (+ 1) 21 | 22 | -- | Get the next \"step\" number (the sequence number of flow arrows in the 23 | -- | diagram). 24 | nextStep :: DFD Int 25 | nextStep = do 26 | incrStep 27 | get 28 | 29 | inQuotes :: String -> String 30 | inQuotes s = "\"" ++ s ++ "\"" 31 | 32 | inAngleBrackets :: String -> String 33 | inAngleBrackets s = "<" ++ s ++ ">" 34 | 35 | label :: String -> Attr 36 | label "" = Attr "label" "" 37 | label s = Attr "label" $ inAngleBrackets s 38 | 39 | bold :: String -> String 40 | bold "" = "" 41 | bold s = "" ++ s ++ "" 42 | 43 | italic :: String -> String 44 | italic "" = "" 45 | italic s = "" ++ s ++ "" 46 | 47 | small :: String -> String 48 | small "" = "" 49 | small s = printf "%s" s 50 | 51 | -- | Display the text with the given color (Graphviz color format, e.g. @grey35@). 52 | color :: String -> String -> String 53 | color _ "" = "" 54 | color c s = printf "%s" c s 55 | 56 | convertNode :: C.Node -> DFD StmtList 57 | 58 | convertNode (C.InputOutput id' attrs) = return [ 59 | NodeStmt id' [ 60 | Attr "shape" "square", 61 | Attr "style" "bold", 62 | label $ 63 | printf "
%s
" 64 | (bold $ getTitleOrBlank attrs) 65 | ] 66 | ] 67 | 68 | convertNode (C.Function id' attrs) = return [ 69 | NodeStmt id' [ 70 | Attr "shape" "circle", 71 | label $ bold $ getTitleOrBlank attrs 72 | ] 73 | ] 74 | 75 | convertNode (C.Database id' attrs) = return [ 76 | NodeStmt id' [ 77 | Attr "shape" "none", 78 | label $ printf "
%s
" 79 | (bold $ getTitleOrBlank attrs) 80 | ] 81 | ] 82 | 83 | convertNodes :: [C.Node] -> DFD StmtList 84 | convertNodes = liftM concat . mapM convertNode 85 | 86 | convertFlow :: C.Flow -> DFD StmtList 87 | convertFlow (C.Flow i1 i2 attrs) = do 88 | s <- nextStep 89 | let stepStr = color "#3184e4" $ bold $ printf "(%d) " s 90 | 91 | asRows :: C.Value -> [String] 92 | asRows (C.String s) = lines s 93 | asRows (C.Array vs) = concatMap asRows vs 94 | 95 | rowsToTable :: [String] -> String 96 | rowsToTable rows = 97 | printf "%s
" r 98 | where r = concatMap (printf "%s") rows :: String 99 | 100 | rows = case (M.lookup "operation" attrs, M.lookup "data" attrs) of 101 | (Just op, Just d) -> (stepStr ++ bold (show op)) : map small (asRows d) 102 | (Just op, Nothing) -> [stepStr ++ bold (show op)] 103 | (Nothing, Just d) -> stepStr : map small (asRows d) 104 | _ -> [] 105 | return [ 106 | EdgeStmt (EdgeExpr (IDOperand (NodeID i1 Nothing)) 107 | Arrow 108 | (IDOperand (NodeID i2 Nothing))) [ 109 | label $ rowsToTable rows 110 | ] 111 | ] 112 | 113 | convertFlows :: [C.Flow] -> DFD StmtList 114 | convertFlows = liftM concat . mapM convertFlow 115 | 116 | convertRootNode :: C.RootNode -> DFD StmtList 117 | convertRootNode (C.TrustBoundary id' attrs nodes) = do 118 | nodeStmts <- convertNodes nodes 119 | let sgId = "cluster_" ++ id' 120 | defaultSgAttrs = [ 121 | Attr "fontsize" "10", 122 | Attr "fontcolor" "grey35", 123 | Attr "style" "dashed", 124 | Attr "color" "grey35"] 125 | sgAttrs = case getTitle attrs of 126 | Just title -> defaultSgAttrs ++ [label $ italic title] 127 | Nothing -> defaultSgAttrs 128 | sgAttrStmt = AttrStmt Graph sgAttrs 129 | stmts = sgAttrStmt : nodeStmts 130 | return [SubgraphStmt $ Subgraph sgId stmts] 131 | 132 | convertRootNode (C.Node n) = convertNode n 133 | 134 | convertRootNodes :: [C.RootNode] -> DFD StmtList 135 | convertRootNodes = liftM concat . mapM convertRootNode 136 | 137 | defaultGraphStmts :: StmtList 138 | defaultGraphStmts = [ 139 | AttrStmt Graph [ 140 | Attr "fontname" "Arial", 141 | Attr "fontsize" "14" 142 | ], 143 | AttrStmt Node [ 144 | Attr "fontname" "Arial", 145 | Attr "fontsize" "14" 146 | ], 147 | AttrStmt Edge [ 148 | Attr "shape" "none", 149 | Attr "fontname" "Arial", 150 | Attr "fontsize" "12" 151 | ], 152 | EqualsStmt "labelloc" (inQuotes "t"), 153 | EqualsStmt "fontsize" "20", 154 | EqualsStmt "nodesep" "1", 155 | EqualsStmt "rankdir" "t" 156 | ] 157 | 158 | convertDiagram :: C.Diagram -> DFD Graph 159 | convertDiagram (C.Diagram attrs rootNodes flows) = do 160 | n <- convertRootNodes rootNodes 161 | f <- convertFlows flows 162 | return $ case M.lookup "title" attrs of 163 | Just title -> 164 | let lbl = EqualsStmt "label" (inAngleBrackets $ show title) 165 | stmts = lbl : defaultGraphStmts ++ n ++ f 166 | in normalize $ Digraph (inQuotes $ show title) stmts 167 | Nothing -> 168 | normalize $ Digraph "Untitled" $ defaultGraphStmts ++ n ++ f 169 | 170 | -- | Converts a 'C.Diagram' to a 'Graph', with predefined styling, that can be 171 | -- rendered as a Graphviz document. 172 | asDFD :: C.Diagram -> Graph 173 | asDFD d = evalState (convertDiagram d) 0 174 | 175 | -------------------------------------------------------------------------------- /src/DataFlow/Graphviz.hs: -------------------------------------------------------------------------------- 1 | -- | "DataFlow.Graphviz" provides a model corresponding to the Graphviz language 2 | -- described at http://www.graphviz.org/content/dot-language. 3 | -- 4 | -- __All features in the grammar are not supported__. If you are looking for 5 | -- a complete set of bindings to Graphviz you should have a look at 6 | -- http://projects.haskell.org/graphviz/index.html. 7 | module DataFlow.Graphviz where 8 | 9 | type ID = String 10 | 11 | data Attr = Attr ID ID deriving (Show, Eq) 12 | 13 | type AttrList = [Attr] 14 | 15 | data Compass = N | NE | E | SE | S | SW | W | NW | C deriving (Show, Eq, Ord) 16 | 17 | data Port = Port (Maybe ID) Compass deriving (Show, Eq, Ord) 18 | 19 | data NodeID = NodeID ID (Maybe Port) deriving (Show, Eq, Ord) 20 | 21 | data Subgraph = Subgraph ID StmtList deriving (Show, Eq) 22 | 23 | data EdgeOperator = Arrow | Line deriving (Show, Eq) 24 | 25 | data EdgeOperand = IDOperand NodeID 26 | | SubgraphOperand Subgraph deriving (Show, Eq) 27 | 28 | data EdgeExpr = EdgeExpr EdgeOperand EdgeOperator EdgeOperand deriving (Show, Eq) 29 | 30 | data AttrStmtType = Graph | Node | Edge deriving (Show, Eq) 31 | 32 | data Stmt = NodeStmt ID AttrList 33 | | EdgeStmt EdgeExpr AttrList 34 | | AttrStmt AttrStmtType AttrList 35 | | EqualsStmt ID ID 36 | | SubgraphStmt Subgraph deriving (Show, Eq) 37 | 38 | type StmtList = [Stmt] 39 | 40 | data Graph = Digraph ID StmtList deriving (Show, Eq) 41 | -------------------------------------------------------------------------------- /src/DataFlow/Graphviz/EdgeNormalization.hs: -------------------------------------------------------------------------------- 1 | -- TODO: Should write some tests for this module. 2 | module DataFlow.Graphviz.EdgeNormalization (normalize) where 3 | 4 | import DataFlow.Graphviz 5 | 6 | import Control.Monad.State 7 | import Data.Set (Set) 8 | import qualified Data.Set as Set 9 | 10 | type Normalizer v = State (Set (NodeID, NodeID)) v 11 | 12 | exists :: (NodeID, NodeID) -> Normalizer Bool 13 | exists k = do 14 | s <- get 15 | return $ Set.member k s 16 | 17 | register :: (NodeID, NodeID) -> Normalizer () 18 | register p = modify $ \s -> Set.insert p s 19 | 20 | shouldInvert :: (NodeID, NodeID) -> Normalizer Bool 21 | shouldInvert k@(i1, i2) = do 22 | e <- exists k 23 | if e 24 | then return False 25 | else do 26 | ie <- exists (i2, i1) 27 | if ie 28 | then return True 29 | else do 30 | register k 31 | return False 32 | 33 | normalizeStmt :: Stmt -> Normalizer Stmt 34 | normalizeStmt e@(EdgeStmt (EdgeExpr (IDOperand i1) op (IDOperand i2)) attrs) = do 35 | i <- shouldInvert (i1, i2) 36 | return $ if i then EdgeStmt (EdgeExpr (IDOperand i2) op (IDOperand i1)) 37 | (Attr "dir" "back" : attrs) 38 | else e 39 | 40 | normalizeStmt (SubgraphStmt (Subgraph id' stmts)) = do 41 | s <- mapM normalizeStmt stmts 42 | return $ SubgraphStmt $ Subgraph id' s 43 | normalizeStmt s = return s 44 | 45 | normalize' :: Graph -> Normalizer Graph 46 | normalize' (Digraph id' stmts) = do 47 | s <- mapM normalizeStmt stmts 48 | return $ Digraph id' s 49 | 50 | -- | Normalizes all edges between nodes to have the same declaration order and 51 | -- to use the @dir@ attribute for occurrences of opposite edge direction 52 | -- between nodes. This is done to avoid the problem in Graphviz described 53 | -- here at http://stackoverflow.com/questions/1510784/right-to-left-edges-in-dot-graphviz. 54 | -- 55 | -- __Example:__ 56 | -- 57 | -- @ 58 | -- a -> b; 59 | -- b -> a; 60 | -- 61 | -- c -> d; 62 | -- c <- d; 63 | -- 64 | -- e <- f; 65 | -- @ 66 | -- 67 | -- gets converted to: 68 | -- 69 | -- @ 70 | -- a -> b; 71 | -- a -> b [dir="back"]; 72 | -- 73 | -- c -> d; 74 | -- c -> d [dir="back"]; 75 | -- 76 | -- f -> e; 77 | -- @ 78 | normalize :: Graph -> Graph 79 | normalize g = evalState (normalize' g) Set.empty 80 | -------------------------------------------------------------------------------- /src/DataFlow/Graphviz/Renderer.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE TypeSynonymInstances #-} 3 | 4 | module DataFlow.Graphviz.Renderer ( 5 | renderGraphviz 6 | ) where 7 | 8 | import Data.Char 9 | import Data.List.Utils 10 | import Text.Printf 11 | 12 | import DataFlow.PrettyRenderer 13 | import DataFlow.Graphviz 14 | 15 | convertNewline :: String -> String 16 | convertNewline = replace "\n" "
" 17 | 18 | class Renderable t where 19 | render :: t -> Renderer () 20 | 21 | instance Renderable Attr where 22 | render (Attr i1 i2) = writeln $ printf "%s = %s;" i1 (convertNewline i2) 23 | 24 | instance Renderable AttrList where 25 | render = mapM_ render 26 | 27 | instance Renderable Port where 28 | render (Port (Just id') c) = 29 | write $ printf "%s:%s" (show id') (map toLower $ show c) 30 | render (Port Nothing c) = 31 | write $ map toLower $ show c 32 | 33 | instance Renderable NodeID where 34 | render (NodeID id' (Just port)) = do 35 | write id' 36 | write ":" 37 | render port 38 | render (NodeID id' Nothing) = write id' 39 | 40 | instance Renderable Subgraph where 41 | render (Subgraph id' []) = 42 | writeln $ printf "subgraph %s {}" id' 43 | render (Subgraph id' stmts) = do 44 | writeln $ printf "subgraph %s {" id' 45 | withIndent $ render stmts 46 | writeln "}" 47 | 48 | instance Renderable EdgeOperator where 49 | render Arrow = write " -> " 50 | render Line = write " -- " 51 | 52 | instance Renderable EdgeOperand where 53 | render (IDOperand nodeId) = render nodeId 54 | render (SubgraphOperand sg) = render sg 55 | 56 | instance Renderable EdgeExpr where 57 | render (EdgeExpr o1 operator o2) = do 58 | render o1 59 | render operator 60 | render o2 61 | 62 | instance Renderable AttrStmtType where 63 | render = write . map toLower . show 64 | 65 | inBrackets :: Renderer () -> Renderer () 66 | inBrackets r = do 67 | writeln " [" 68 | withIndent r 69 | writeln "]" 70 | 71 | instance Renderable Stmt where 72 | render (NodeStmt id' []) = do 73 | write id' 74 | writeln "" 75 | render (NodeStmt id' attrs) = do 76 | write id' 77 | inBrackets $ render attrs 78 | render (EdgeStmt expr []) = do 79 | render expr 80 | writeln ";" 81 | render (EdgeStmt expr attrs) = do 82 | render expr 83 | inBrackets $ render attrs 84 | render (AttrStmt t []) = do 85 | render t 86 | writeln " []" 87 | render (AttrStmt t attrs) = do 88 | render t 89 | inBrackets $ render attrs 90 | render (EqualsStmt i1 i2) = do 91 | write i1 92 | write " = " 93 | write i2 94 | writeln ";" 95 | render (SubgraphStmt sg) = render sg 96 | 97 | instance Renderable StmtList where 98 | render = mapM_ render 99 | 100 | instance Renderable Graph where 101 | render (Digraph id' stmts) = do 102 | writeln $ printf "digraph %s {" id' 103 | withIndent $ render stmts 104 | writeln "}" 105 | 106 | renderGraphviz :: Graph -> String 107 | renderGraphviz = renderWithIndent . render 108 | -------------------------------------------------------------------------------- /src/DataFlow/JSONGraphFormat.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module DataFlow.JSONGraphFormat ( 3 | Val(..), 4 | Metadata(), 5 | Document(..), 6 | Graph(..), 7 | Node(..), 8 | Edge(..) 9 | ) where 10 | 11 | import Data.Aeson 12 | import Data.Aeson.Types (Pair) 13 | import qualified Data.Map as M 14 | import Data.Vector (fromList) 15 | 16 | data Val = Str String 17 | | Arr [Val] 18 | 19 | instance ToJSON Val where 20 | toJSON (Str s) = toJSON s 21 | toJSON (Arr vs) = toJSON vs 22 | 23 | type Metadata = M.Map String Val 24 | 25 | data Document = SingleGraph { graph :: Graph } 26 | | MultiGraph { graphs :: [Graph] } 27 | 28 | instance ToJSON Document where 29 | toJSON (SingleGraph g) = object [ 30 | "graph" .= toJSON g 31 | ] 32 | toJSON (MultiGraph gs) = object [ 33 | "graphs" .= toJSON gs 34 | ] 35 | 36 | data Graph = Graph { nodes :: [Node] 37 | , edges :: [Edge] 38 | , graphLabel :: Maybe String 39 | , graphMetadata :: Metadata 40 | } 41 | 42 | instance ToJSON Graph where 43 | toJSON (Graph nodes edges lbl metadata) = object $ 44 | labelField lbl ++ [ 45 | "nodes" .= toJSON nodes, 46 | "edges" .= toJSON edges, 47 | "metadata" .= toJSON metadata 48 | ] 49 | 50 | data Node = Node { id :: String 51 | , nodeLabel :: Maybe String 52 | , nodeMetadata :: Metadata } 53 | 54 | instance ToJSON Node where 55 | toJSON (Node id' lbl metadata) = object $ 56 | labelField lbl ++ [ 57 | "id" .= toJSON id', 58 | "metadata" .= toJSON metadata 59 | ] 60 | 61 | data Edge = Edge { source :: String 62 | , target :: String 63 | , edgeLabel :: Maybe String 64 | , edgeMetadata :: Metadata } 65 | 66 | instance ToJSON Edge where 67 | toJSON (Edge source target lbl metadata) = object $ 68 | labelField lbl ++ [ 69 | "source" .= toJSON source, 70 | "target" .= toJSON target, 71 | "metadata" .= toJSON metadata 72 | ] 73 | 74 | labelField :: Maybe String -> [Pair] 75 | labelField (Just s) = [("label", toJSON s)] 76 | labelField _ = [] 77 | -------------------------------------------------------------------------------- /src/DataFlow/JSONGraphFormat/Renderer.hs: -------------------------------------------------------------------------------- 1 | -- Renders 'Diagram' as JSON. 2 | module DataFlow.JSONGraphFormat.Renderer (convertDiagram, renderJSONGraph) where 3 | 4 | import qualified Data.Aeson as A 5 | import Data.ByteString.Lazy (ByteString) 6 | import Data.Text (pack, unpack) 7 | import qualified Data.Map as M 8 | import qualified Data.Vector as V 9 | 10 | import DataFlow.Core 11 | import qualified DataFlow.JSONGraphFormat as JG 12 | 13 | getTitle :: JG.Metadata -> Maybe String 14 | getTitle m = do 15 | v <- M.lookup "title" m 16 | case v of 17 | (JG.Str s) -> Just s 18 | _ -> Nothing 19 | 20 | convertValue :: Value -> JG.Val 21 | convertValue (String s) = JG.Str s 22 | convertValue (Array vs) = JG.Arr (map convertValue vs) 23 | 24 | convertAttrs :: Attributes -> M.Map String JG.Val 25 | convertAttrs = M.map convertValue 26 | 27 | withLabelAndMetadataFrom :: (Maybe String -> JG.Metadata -> v) -> JG.Metadata -> v 28 | f `withLabelAndMetadataFrom` metadata = f (getTitle metadata) (M.delete "title" metadata) 29 | 30 | addType :: String -> JG.Metadata -> JG.Metadata 31 | addType s = M.insert "type" (JG.Str s) 32 | 33 | addBoundary :: Maybe String -> JG.Metadata -> JG.Metadata 34 | addBoundary (Just b) m = M.insert "trust-boundary" (JG.Str b) m 35 | addBoundary Nothing m = m 36 | 37 | convertNode :: Maybe String -> Node -> JG.Node 38 | convertNode b (InputOutput id attrs) = 39 | JG.Node id `withLabelAndMetadataFrom` addBoundary b (addType "io" $ convertAttrs attrs) 40 | convertNode b (Function id attrs) = 41 | JG.Node id `withLabelAndMetadataFrom` addBoundary b (addType "function" $ convertAttrs attrs) 42 | convertNode b (Database id attrs) = 43 | JG.Node id `withLabelAndMetadataFrom` addBoundary b (addType "database" $ convertAttrs attrs) 44 | 45 | convertRootNode :: RootNode -> [JG.Node] 46 | convertRootNode (Node node) = [convertNode Nothing node] 47 | -- TODO: replace title attribute with mandatory ID for boundaries 48 | convertRootNode (TrustBoundary id' attrs nodes) = 49 | map (convertNode (Just id')) nodes 50 | 51 | convertFlow :: Flow -> JG.Edge 52 | convertFlow (Flow source target attrs) = 53 | JG.Edge source target `withLabelAndMetadataFrom` convertAttrs attrs 54 | 55 | convertDiagram :: Diagram -> JG.Document 56 | convertDiagram (Diagram attrs rootNodes flows) = 57 | let nodes = concatMap convertRootNode rootNodes 58 | edges = map convertFlow flows 59 | graph = JG.Graph nodes edges `withLabelAndMetadataFrom` convertAttrs attrs 60 | in JG.SingleGraph graph 61 | 62 | -- Render the 'Diagram' as a JSON 'ByteString'. 63 | renderJSONGraph :: Diagram -> ByteString 64 | renderJSONGraph = A.encode . convertDiagram 65 | -------------------------------------------------------------------------------- /src/DataFlow/Mustache/Renderer.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | -- | Renders diagrams using Mustache templates. 3 | module DataFlow.Mustache.Renderer (renderTemplate) where 4 | 5 | import Data.List.Utils 6 | import qualified Data.Map as M 7 | import qualified Data.Text as T 8 | import qualified Data.Text.Lazy as TL 9 | import System.FilePath (dropExtension, takeFileName) 10 | import Text.Blaze.Html.Renderer.Text (renderHtml) 11 | import Text.Mustache 12 | import qualified Text.Mustache.Types as MU 13 | import Text.Parsec.Error (ParseError) 14 | import Text.Markdown (markdown, def) 15 | 16 | import DataFlow.Core 17 | 18 | mkContextWithDefaults :: Attributes -> [MU.Pair] -> MU.Value 19 | mkContextWithDefaults attrs overrides = 20 | object $ defaults ++ overrides 21 | where 22 | defaults = 23 | [ "markdown" ~> overText markdownAttr 24 | , "html_linebreaks" ~> overText htmlLinebreaksAttr 25 | ] ++ map (\(k, v) -> T.pack k ~> mkValue v) (M.toList attrs) 26 | 27 | mkValue :: Value -> MU.Value 28 | mkValue (String s) = toMustache s 29 | mkValue (Array vs) = 30 | toMustache (map (\v -> object [ "value" ~> mkValue v ]) vs) 31 | 32 | markdownAttr :: T.Text -> T.Text 33 | markdownAttr t = 34 | let key = T.unpack t 35 | value = M.lookup key attrs 36 | in case value of 37 | (Just (String s)) -> TL.toStrict $ renderHtml $ markdown def $ TL.pack s 38 | _ -> "" 39 | 40 | htmlLinebreaksAttr :: T.Text -> T.Text 41 | htmlLinebreaksAttr t = 42 | let key = T.unpack t 43 | value = M.lookup key attrs 44 | in case value of 45 | (Just (String s)) -> T.pack (replace "\n" "
" s) 46 | _ -> "" 47 | 48 | mkFlowContext :: Flow -> Int -> MU.Value 49 | mkFlowContext (Flow _ _ attrs) n = 50 | mkContextWithDefaults attrs 51 | [ "number" ~> show n 52 | ] 53 | 54 | mkDiagramContext :: FilePath -> Diagram -> MU.Value 55 | mkDiagramContext fp (Diagram attrs _ flows) = 56 | mkContextWithDefaults attrs 57 | [ "filename_without_extension" ~> (dropExtension $ takeFileName fp) 58 | , "flows" ~> zipWith mkFlowContext flows [1..] 59 | ] 60 | 61 | -- | Render the given template string and 'Diagram' file path. 62 | renderTemplate :: String -> FilePath -> Diagram -> Either ParseError T.Text 63 | renderTemplate tmpl fp d = do 64 | t <- compileTemplate fp (T.pack tmpl) 65 | pure (substitute t (mkDiagramContext fp d)) 66 | -------------------------------------------------------------------------------- /src/DataFlow/PlantUML.hs: -------------------------------------------------------------------------------- 1 | module DataFlow.PlantUML where 2 | 3 | type ID = String 4 | type Name = String 5 | 6 | data Stmt = SkinParam String String 7 | | Box Name StmtList 8 | | Participant ID Name 9 | | Database ID Name 10 | | Entity ID Name 11 | | Edge ID ID String deriving (Show, Eq) 12 | 13 | type StmtList = [Stmt] 14 | 15 | data Diagram = SequenceDiagram StmtList deriving (Show, Eq) 16 | -------------------------------------------------------------------------------- /src/DataFlow/PlantUML/Renderer.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE TypeSynonymInstances #-} 3 | 4 | module DataFlow.PlantUML.Renderer ( 5 | renderPlantUML 6 | ) where 7 | 8 | import Text.Printf 9 | import DataFlow.PrettyRenderer 10 | import DataFlow.PlantUML 11 | 12 | class Renderable t where 13 | render :: t -> Renderer () 14 | 15 | instance Renderable Stmt where 16 | render (SkinParam name value) = do 17 | write "skinparam " 18 | write name 19 | write " " 20 | writeln value 21 | render (Box name stmts) = do 22 | writeln $ printf "box \"%s\"" name 23 | withIndent $ render stmts 24 | writeln "end box" 25 | render (Participant id' name) = 26 | writeln $ printf "participant \"%s\" as %s" name id' 27 | render (Database id' name) = 28 | writeln $ printf "database \"%s\" as %s" name id' 29 | render (Entity id' name) = 30 | writeln $ printf "entity \"%s\" as %s" name id' 31 | render (Edge i1 i2 description) = 32 | writeln $ printf "%s -> %s : %s" i1 i2 description 33 | 34 | 35 | instance Renderable StmtList where 36 | render = mapM_ render 37 | 38 | instance Renderable Diagram where 39 | render (SequenceDiagram stmts) = do 40 | writeln "@startuml" 41 | render stmts 42 | writeln "@enduml" 43 | 44 | renderPlantUML :: Diagram -> String 45 | renderPlantUML = renderWithIndent . render 46 | -------------------------------------------------------------------------------- /src/DataFlow/PrettyRenderer.hs: -------------------------------------------------------------------------------- 1 | -- | Common functionality for rendering pretty output. 2 | module DataFlow.PrettyRenderer where 3 | 4 | import Control.Monad.State 5 | import Control.Monad.Writer 6 | 7 | type Indent = Int 8 | type IndentNext = Bool 9 | data RendererState = RendererState Indent IndentNext 10 | 11 | -- | The Renderer represents some output generator that runs on a 'Diagram'. 12 | type Renderer t = WriterT [String] (State RendererState) t 13 | 14 | -- | Write a string to the output (no linefeed). 15 | write :: String -> Renderer () 16 | write s = do 17 | (RendererState n indentNext) <- lift get 18 | if indentNext 19 | then tell [replicate n ' ' ++ s] 20 | else tell [s] 21 | put $ RendererState n False 22 | 23 | -- | Write a string to the output (with linefeed). 24 | writeln :: String -> Renderer () 25 | writeln s = do 26 | write s 27 | write "\n" 28 | modify $ \(RendererState n _) -> RendererState n True 29 | 30 | -- | Increase indent with 2 spaces. 31 | indent :: Renderer () 32 | indent = modify $ \(RendererState n indentNext) -> RendererState (n + 2) indentNext 33 | 34 | -- | Decrease indent with 2 spaces. 35 | dedent :: Renderer () 36 | dedent = modify $ \(RendererState n indentNext) -> RendererState (n - 2) indentNext 37 | 38 | -- | Indent the output of gen with 2 spaces. 39 | withIndent :: Renderer () -> Renderer () 40 | withIndent gen = do 41 | indent 42 | gen 43 | dedent 44 | 45 | renderWithIndent :: Renderer () -> String 46 | renderWithIndent r = 47 | concat $ evalState (execWriterT r) (RendererState 0 False) 48 | -------------------------------------------------------------------------------- /src/DataFlow/Reader.hs: -------------------------------------------------------------------------------- 1 | -- | Reads .flow syntax. 2 | module DataFlow.Reader ( 3 | document, 4 | readDiagram, 5 | readDiagramFile 6 | ) where 7 | 8 | import Control.Applicative ((*>), (<*), (<*>)) 9 | import Control.Monad 10 | import Data.Char 11 | import Data.Functor ((<$>)) 12 | import Data.List 13 | import qualified Data.Map as M 14 | import Text.ParserCombinators.Parsec 15 | 16 | import DataFlow.Core 17 | 18 | commentsAndSpace :: Parser () 19 | commentsAndSpace = do 20 | spaces 21 | skipMany comment 22 | spaces 23 | where 24 | comment = do 25 | _ <- string "/*" 26 | _ <- manyTill anyChar (try $ string "*/") 27 | return () 28 | 29 | identifier :: Parser ID 30 | identifier = do 31 | first <- letter 32 | rest <- many (letter <|> digit <|> char '_') 33 | return $ first : rest 34 | 35 | str :: Parser Value 36 | str = do 37 | -- TODO: Handle escaped characters. 38 | _ <- char '"' 39 | s <- many (noneOf "\"\r\n") 40 | _ <- char '"' 41 | return $ String s 42 | 43 | textBlock :: Parser Value 44 | textBlock = do 45 | _ <- char '`' 46 | s <- anyToken `manyTill` try (char '`') 47 | return $ String $ intercalate "\n" $ map (dropWhile isSpace) $ lines s 48 | 49 | inside :: Parser x -> Parser y -> Parser t -> Parser t 50 | inside before after p = do 51 | commentsAndSpace 52 | _ <- before 53 | commentsAndSpace 54 | c <- p 55 | commentsAndSpace 56 | _ <- after 57 | commentsAndSpace 58 | return c 59 | 60 | inBraces :: Parser t -> Parser t 61 | inBraces = inside (char '{') (char '}') 62 | 63 | inSquareBrackets :: Parser t -> Parser t 64 | inSquareBrackets = inside (char '[') (char ']') 65 | 66 | array :: Parser Value 67 | array = 68 | let sep = do _ <- char ',' 69 | commentsAndSpace 70 | in Array <$> 71 | inSquareBrackets (value `sepBy` sep) <* commentsAndSpace 72 | 73 | value :: Parser Value 74 | value = try textBlock <|> try str <|> array 75 | 76 | attr :: Parser (String, Value) 77 | attr = do 78 | key <- identifier 79 | skipMany1 $ char ' ' 80 | _ <- char '=' 81 | skipMany1 $ char ' ' 82 | v <- value 83 | commentsAndSpace 84 | return (key, v) 85 | 86 | attrs :: Parser Attributes 87 | attrs = liftM M.fromList $ many (try attr) 88 | 89 | -- | Construct a parser for an node with an ID: 90 | -- 91 | -- @ 92 | -- \ \ { 93 | -- ... 94 | -- } 95 | -- @ 96 | idAndAttrsNode :: String -> (ID -> Attributes -> t) -> Parser t 97 | idAndAttrsNode keyword f = do 98 | _ <- string keyword 99 | skipMany1 space 100 | id' <- identifier 101 | f id' <$> option M.empty (try (inBraces attrs)) 102 | 103 | function :: Parser Node 104 | function = idAndAttrsNode "function" Function 105 | 106 | database :: Parser Node 107 | database = idAndAttrsNode "database" Database 108 | 109 | io :: Parser Node 110 | io = idAndAttrsNode "io" InputOutput 111 | 112 | data FlowType = Back | Forward 113 | 114 | arrow :: Parser FlowType 115 | arrow = do 116 | s <- string "->" <|> string "--" <|> string "<-" 117 | case s of 118 | "->" -> return Forward 119 | "<-" -> return Back 120 | _ -> fail "Invalid flow statement" 121 | 122 | flow :: Parser Flow 123 | flow = do 124 | i1 <- identifier 125 | skipMany1 space 126 | arr <- arrow 127 | skipMany1 space 128 | i2 <- identifier 129 | a <- option M.empty $ try (inBraces attrs) 130 | case arr of 131 | Back -> return $ Flow i2 i1 a 132 | Forward -> return $ Flow i1 i2 a 133 | 134 | node :: Parser Node 135 | node = do 136 | n <- try function 137 | <|> try database 138 | <|> io 139 | commentsAndSpace 140 | return n 141 | 142 | boundary :: Parser RootNode 143 | boundary = do 144 | _ <- string "boundary" 145 | skipMany1 space 146 | id' <- identifier 147 | inBraces (TrustBoundary id' <$> attrs <*> many node) 148 | 149 | rootNode :: Parser RootNode 150 | rootNode = try (Node <$> node) 151 | <|> boundary 152 | 153 | diagram :: Parser Diagram 154 | diagram = 155 | string "diagram" *> inBraces (Diagram <$> attrs <*> many (try rootNode) <*> many flow) 156 | 157 | document :: Parser Diagram 158 | document = commentsAndSpace *> diagram <* commentsAndSpace 159 | 160 | -- Read the string, as named by the second argument, as a 'Diagram'. 161 | readDiagram :: String -> String -> Either ParseError Diagram 162 | readDiagram = parse document 163 | 164 | -- Read the file at the given file path as a 'Diagram'. 165 | readDiagramFile :: FilePath -> IO (Either ParseError Diagram) 166 | readDiagramFile = parseFromFile document 167 | -------------------------------------------------------------------------------- /src/DataFlow/SequenceDiagram.hs: -------------------------------------------------------------------------------- 1 | module DataFlow.SequenceDiagram (asSequenceDiagram) where 2 | 3 | import qualified Data.Map as M 4 | import Data.List.Utils 5 | import Text.Printf 6 | 7 | import qualified DataFlow.Core as C 8 | import DataFlow.Attributes 9 | import DataFlow.PlantUML 10 | 11 | convertNewline :: String -> String 12 | convertNewline = replace "\n" "\\n" 13 | 14 | bold :: String -> String 15 | bold "" = "" 16 | bold s = printf "%s" s 17 | 18 | italic :: String -> String 19 | italic "" = "" 20 | italic s = 21 | -- each line (separated by \n) needs to be wrapped in its own 22 | join "\\n" $ map italic' $ split "\\n" s 23 | where italic' = printf "%s" 24 | 25 | showValue :: C.Value -> String 26 | showValue (C.String s) = convertNewline s 27 | showValue (C.Array vs) = join "\\n" $ map showValue vs 28 | 29 | blank :: C.Value 30 | blank = C.String "" 31 | 32 | convertNode :: C.Node -> Stmt 33 | convertNode (C.InputOutput id' attrs) = 34 | Entity id' $ convertNewline $ getTitleOrBlank attrs 35 | convertNode (C.Function id' attrs) = 36 | Participant id' $ convertNewline $ getTitleOrBlank attrs 37 | convertNode (C.Database id' attrs) = 38 | Database id' $ convertNewline $ getTitleOrBlank attrs 39 | 40 | convertFlow :: C.Flow -> Stmt 41 | convertFlow (C.Flow i1 i2 attrs) = 42 | let p = (bold $ showValue $ M.findWithDefault blank "operation" attrs, 43 | italic $ showValue $ M.findWithDefault blank "data" attrs) 44 | s = case p of 45 | ("", "") -> "" 46 | ("", d) -> d 47 | (o, "") -> o 48 | (o, d) -> o ++ "\\n" ++ d 49 | in Edge i1 i2 s 50 | 51 | convertRootNode :: C.RootNode -> Stmt 52 | convertRootNode (C.TrustBoundary id' attrs nodes) = 53 | let title = showValue $ M.findWithDefault (C.String id') "title" attrs 54 | in Box title (map convertNode nodes) 55 | convertRootNode (C.Node n) = convertNode n 56 | 57 | defaultSkinParams :: [Stmt] 58 | defaultSkinParams = [ 59 | SkinParam "BackgroundColor" "#white", 60 | SkinParam "Shadowing" "false", 61 | SkinParam "SequenceMessageAlign" "center", 62 | SkinParam "DefaultFontName" "Arial", 63 | SkinParam "DefaultFontStyle" "bold", 64 | SkinParam "DefaultFontColor" "#333333", 65 | 66 | SkinParam "NoteBackgroundColor" "#fbfb77", 67 | SkinParam "NoteBorderColor" "#cbcb47", 68 | 69 | SkinParam "NoteBackgroundColor" "#ffffcd", 70 | SkinParam "NoteBorderColor" "#a9a980", 71 | SkinParam "NoteFontColor" "#676735", 72 | SkinParam "NoteFontStyle" "italic", 73 | 74 | SkinParam "SequenceArrowColor" "#555555", 75 | SkinParam "SequenceArrowFontColor" "#555555", 76 | SkinParam "SequenceArrowFontStyle" "none", 77 | 78 | SkinParam "SequenceBoxBackgroundColor" "#fafafa", 79 | SkinParam "SequenceBoxBorderColor" "#eeeeee", 80 | SkinParam "SequenceBoxFontColor" "#666666", 81 | SkinParam "SequenceBoxFontSize" "12", 82 | SkinParam "SequenceBoxFontStyle" "italic", 83 | 84 | SkinParam "ParticipantBackgroundColor" "#dde5ff", 85 | SkinParam "ParticipantBorderColor" "#cccccc", 86 | SkinParam "ParticipantFontColor" "#333333", 87 | SkinParam "ParticipantFontStyle" "bold", 88 | 89 | SkinParam "DatabaseBackgroundColor" "#df4646", 90 | SkinParam "DatabaseFontColor" "#red", 91 | SkinParam "DatabaseFontStyle" "bold", 92 | 93 | SkinParam "EntityBackgroundColor" "#999999", 94 | 95 | SkinParam "SequenceLifeLineBorderColor" "#bbbbbb" 96 | ] 97 | 98 | asSequenceDiagram :: C.Diagram -> Diagram 99 | asSequenceDiagram (C.Diagram _ rootNodes flows) = 100 | SequenceDiagram $ defaultSkinParams 101 | ++ map convertRootNode rootNodes 102 | ++ map convertFlow flows 103 | -------------------------------------------------------------------------------- /src/DataFlow/Validation.hs: -------------------------------------------------------------------------------- 1 | module DataFlow.Validation ( 2 | ValidationError(..), 3 | validate 4 | ) where 5 | 6 | import Data.Set (Set, member, insert, empty) 7 | import Text.Printf 8 | 9 | import DataFlow.Core 10 | 11 | data ValidationError = UnknownID ID 12 | | DuplicateDeclaration ID 13 | deriving (Eq) 14 | 15 | instance Show ValidationError where 16 | show (UnknownID i) = printf "Unknown ID: %s" i 17 | show (DuplicateDeclaration i) = printf "Duplicate declaration of ID: %s" i 18 | 19 | getNodeIDs :: Diagram -> [ID] 20 | getNodeIDs (Diagram _ nodes _) = concatMap getRootNodeId nodes 21 | where getId (InputOutput i _) = [i] 22 | getId (Function i _) = [i] 23 | getId (Database i _) = [i] 24 | getRootNodeId (Node node) = getId node 25 | getRootNodeId (TrustBoundary _ _ nodes) = concatMap getId nodes 26 | 27 | getBoundaryIDs :: Diagram -> [ID] 28 | getBoundaryIDs (Diagram _ nodes _) = concatMap getRootNodeId nodes 29 | where getRootNodeId (TrustBoundary id _ _) = [id] 30 | getRootNodeId _ = [] 31 | 32 | validateDuplicateIDs :: [ID] -> Either [ValidationError] (Set ID) 33 | validateDuplicateIDs ids = 34 | case foldl iter (empty, []) ids of 35 | (seen, []) -> Right seen 36 | (_, errors) -> Left errors 37 | where iter (seen, errors) i = if i `member` seen 38 | then (seen, errors ++ [DuplicateDeclaration i]) 39 | else (insert i seen, errors) 40 | 41 | validateFlowIDs :: Diagram -> Set ID -> Either [ValidationError] () 42 | validateFlowIDs (Diagram _ _ flows) ids = 43 | case foldl iter [] flows of 44 | [] -> Right () 45 | errors -> Left errors 46 | where idError i = if i `member` ids then [] else [UnknownID i] 47 | iter errors (Flow source target _) = 48 | errors ++ idError source ++ idError target 49 | 50 | validate :: Diagram -> Either [ValidationError] Diagram 51 | validate diagram = do 52 | nodeIDs <- validateDuplicateIDs (getNodeIDs diagram) 53 | validateDuplicateIDs (getBoundaryIDs diagram) 54 | validateFlowIDs diagram nodeIDs 55 | return diagram 56 | -------------------------------------------------------------------------------- /test/DataFlow/Assertions.hs: -------------------------------------------------------------------------------- 1 | module DataFlow.Assertions where 2 | 3 | import Control.Monad (when) 4 | import Test.Hspec 5 | import Text.ParserCombinators.Parsec 6 | import Text.Printf 7 | 8 | import DataFlow.Core 9 | import DataFlow.Reader (document) 10 | 11 | parseFailure :: (Show a, Show e) => String -> a -> e -> Expectation 12 | parseFailure input expected err = 13 | expectationFailure $ 14 | printf "input:\n%s\nexpected: %s\n but parsing failed with error: %s" 15 | input 16 | (show expected) 17 | (show err) 18 | 19 | checkEquality :: (Eq a, Show a) => a -> a -> Expectation 20 | checkEquality e a = 21 | when (a /= e) $ 22 | expectationFailure $ 23 | printf " expected: %s\n but got: %s " (show e) (show a) 24 | 25 | shouldReadAs :: (Eq a, Show a) => Parser a -> String -> a -> Expectation 26 | shouldReadAs p s expected = 27 | either (parseFailure s expected) (checkEquality expected) (parse p "test input" s) 28 | 29 | shouldReadAsDiagram :: String -> Diagram -> Expectation 30 | s `shouldReadAsDiagram` expected = shouldReadAs document s expected 31 | 32 | shouldFailReadAs :: (Eq a, Show a) => Parser a -> String -> Expectation 33 | shouldFailReadAs p s = 34 | either onFailure onSuccess (parse p "test input" s) 35 | where onFailure _ = return () 36 | onSuccess d = 37 | expectationFailure $ 38 | printf "Expected read to fail, but got: %s" (show d) 39 | 40 | shouldFailReadAsDiagram :: String -> Expectation 41 | shouldFailReadAsDiagram = shouldFailReadAs document 42 | 43 | -------------------------------------------------------------------------------- /test/DataFlow/Graphviz/RendererSpec.hs: -------------------------------------------------------------------------------- 1 | module DataFlow.Graphviz.RendererSpec where 2 | 3 | import Test.Hspec 4 | 5 | import DataFlow.Graphviz 6 | import DataFlow.Graphviz.Renderer 7 | 8 | spec :: Spec 9 | spec = 10 | describe "renderGraphviz" $ do 11 | 12 | it "renders digraph id" $ 13 | renderGraphviz (Digraph "g" []) `shouldBe` "digraph g {\n}\n" 14 | 15 | it "renders digraph with a node stmt" $ 16 | renderGraphviz (Digraph "g" [ 17 | NodeStmt "n" [] 18 | ]) `shouldBe` "digraph g {\n n\n}\n" 19 | 20 | it "renders digraph with an edge stmt" $ 21 | renderGraphviz (Digraph "g" [ 22 | EdgeStmt (EdgeExpr 23 | (IDOperand $ NodeID "n1" Nothing) 24 | Arrow 25 | (IDOperand $ NodeID "n2" Nothing)) 26 | [] 27 | ]) `shouldBe` "digraph g {\n n1 -> n2;\n}\n" 28 | 29 | it "renders digraph with an attr stmt" $ 30 | renderGraphviz (Digraph "g" [ 31 | AttrStmt Graph [] 32 | ]) `shouldBe` "digraph g {\n graph []\n}\n" 33 | 34 | it "renders digraph with an equals stmt" $ 35 | renderGraphviz (Digraph "g" [ 36 | EqualsStmt "i1" "i2" 37 | ]) `shouldBe` "digraph g {\n i1 = i2;\n}\n" 38 | 39 | it "renders digraph with a subgraph stmt" $ 40 | renderGraphviz (Digraph "g" [ 41 | SubgraphStmt $ Subgraph "sg" [] 42 | ]) `shouldBe` "digraph g {\n subgraph sg {}\n}\n" 43 | 44 | it "converts newlines to
" $ 45 | renderGraphviz (Digraph "g" [ 46 | AttrStmt Graph [ 47 | Attr "hello" "foo\nbar" 48 | ] 49 | ]) `shouldBe` "digraph g {\n graph [\n hello = foo
bar;\n ]\n}\n" 50 | -------------------------------------------------------------------------------- /test/DataFlow/JSONGraphFormat/RendererSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module DataFlow.JSONGraphFormat.RendererSpec where 3 | 4 | import Control.Monad (when) 5 | 6 | import Data.Aeson ((.=), object, toJSON, ToJSON, encode) 7 | import qualified Data.Aeson as A 8 | 9 | import Data.Vector (fromList) 10 | import qualified Data.Map as M 11 | import Test.Hspec (Spec, describe, it, expectationFailure, Expectation) 12 | import Data.ByteString.Lazy.Char8 (unpack) 13 | import Text.Printf (printf) 14 | 15 | import DataFlow.Core 16 | import DataFlow.JSONGraphFormat.Renderer (convertDiagram) 17 | 18 | shouldEncodeAsJSON :: (ToJSON a) => a -> A.Value -> Expectation 19 | v `shouldEncodeAsJSON` e = do 20 | let j = toJSON v 21 | when (j /= e) $ 22 | expectationFailure $ 23 | printf "expected:\n%s\nbut got:\n%s\n" (unpack $ encode e) (unpack $ encode j) 24 | 25 | spec :: Spec 26 | spec = 27 | describe "renderJSONGraph" $ do 28 | 29 | it "converts an empty diagram" $ 30 | convertDiagram (Diagram M.empty [] []) `shouldEncodeAsJSON` object [ 31 | "graph" .= object [ 32 | "metadata" .= object [], 33 | "nodes" .= A.Array (fromList []), 34 | "edges" .= A.Array (fromList []) 35 | ] 36 | ] 37 | it "uses diagram title attribute as graph label" $ 38 | convertDiagram (Diagram (M.singleton "title" (String "Foo")) [] []) `shouldEncodeAsJSON` object [ 39 | "graph" .= object [ 40 | "label" .= A.String "Foo", 41 | "metadata" .= object [], 42 | "nodes" .= A.Array (fromList []), 43 | "edges" .= A.Array (fromList []) 44 | ] 45 | ] 46 | it "converts nodes" $ 47 | convertDiagram (Diagram M.empty [ 48 | Node $ InputOutput "foo" $ M.fromList [ 49 | ("title", String "Foo"), 50 | ("a", String "b") 51 | ], 52 | Node $ Function "bar" $ M.fromList [ 53 | ("title", String "Bar"), 54 | ("c", String "d") 55 | ] 56 | ] []) `shouldEncodeAsJSON` object [ 57 | "graph" .= object [ 58 | "nodes" .= A.Array (fromList [ 59 | object [ 60 | "id" .= A.String "foo", 61 | "label" .= A.String "Foo", 62 | "metadata" .= object [ 63 | "type" .= A.String "io", 64 | "a" .= A.String "b" 65 | ] 66 | ], 67 | object [ 68 | "id" .= A.String "bar", 69 | "label" .= A.String "Bar", 70 | "metadata" .= object [ 71 | "type" .= A.String "function", 72 | "c" .= A.String "d" 73 | ] 74 | ] 75 | ]), 76 | "edges" .= A.Array (fromList []), 77 | "metadata" .= object [] 78 | ] 79 | ] 80 | it "converts edges" $ 81 | convertDiagram (Diagram M.empty [] [ 82 | Flow "a" "b" $ M.fromList [ 83 | ("title", String "Foo"), 84 | ("a", String "b") 85 | ], 86 | Flow "b" "c" $ M.fromList [ 87 | ("title", String "Bar"), 88 | ("b", String "c") 89 | ] 90 | ]) `shouldEncodeAsJSON` object [ 91 | "graph" .= object [ 92 | "nodes" .= A.Array (fromList []), 93 | "edges" .= A.Array (fromList [ 94 | object [ 95 | "source" .= A.String "a", 96 | "target" .= A.String "b", 97 | "label" .= A.String "Foo", 98 | "metadata" .= object [ 99 | "a" .= A.String "b" 100 | ] 101 | ], 102 | object [ 103 | "source" .= A.String "b", 104 | "target" .= A.String "c", 105 | "label" .= A.String "Bar", 106 | "metadata" .= object [ 107 | "b" .= A.String "c" 108 | ] 109 | ] 110 | ]), 111 | "metadata" .= object [] 112 | ] 113 | ] 114 | it "adds boundary id as node metadata if available" $ 115 | convertDiagram (Diagram M.empty [ 116 | TrustBoundary "foo" M.empty [ 117 | InputOutput "bar" M.empty 118 | ] 119 | ] []) `shouldEncodeAsJSON` object [ 120 | "graph" .= object [ 121 | "nodes" .= A.Array (fromList [ 122 | object [ 123 | "id" .= A.String "bar", 124 | "metadata" .= object [ 125 | "type" .= A.String "io", 126 | "trust-boundary" .= A.String "foo" 127 | ] 128 | ] 129 | ]), 130 | "edges" .= A.Array (fromList []), 131 | "metadata" .= object [] 132 | ] 133 | ] 134 | -------------------------------------------------------------------------------- /test/DataFlow/ReaderSpec.hs: -------------------------------------------------------------------------------- 1 | module DataFlow.ReaderSpec where 2 | 3 | import Data.Map as M 4 | 5 | import Test.Hspec 6 | 7 | import DataFlow.Assertions 8 | import DataFlow.Core 9 | 10 | spec :: Spec 11 | spec = 12 | describe "readDiagram" $ do 13 | 14 | it "reads empty diagram" $ 15 | "diagram {}" `shouldReadAsDiagram` Diagram M.empty [] [] 16 | 17 | it "reads diagram with single attribute" $ 18 | "diagram { name = \"\" }" `shouldReadAsDiagram` Diagram (M.singleton "name" (String "")) [] [] 19 | 20 | it "reads diagram with multiple attributes" $ 21 | let input = unlines [ 22 | "diagram {", 23 | " name = \"foo\"", 24 | " importance = \"high\"", 25 | "}" 26 | ] 27 | in input `shouldReadAsDiagram` Diagram (M.fromList [("name", String "foo"), 28 | ("importance", String "high")]) [] [] 29 | 30 | 31 | it "reads diagram with whitespace inside braces" $ 32 | "diagram {\n \n }" `shouldReadAsDiagram` Diagram M.empty [] [] 33 | 34 | it "reads diagram with trust boundary" $ 35 | let input = unlines [ 36 | "diagram {", 37 | " boundary foo {}", 38 | "}" 39 | ] 40 | in input `shouldReadAsDiagram` Diagram M.empty [ 41 | TrustBoundary "foo" M.empty [] 42 | ] [] 43 | it "reads diagram with trust boundary and nested nodes" $ 44 | let input = unlines [ 45 | "diagram {", 46 | " boundary foo {", 47 | " io dynamo", 48 | " }", 49 | "}" 50 | ] 51 | in input `shouldReadAsDiagram` Diagram M.empty [ 52 | TrustBoundary "foo" M.empty [ 53 | InputOutput "dynamo" M.empty 54 | ] 55 | ] [] 56 | it "reads diagram with function" $ 57 | let input = unlines [ 58 | "diagram {", 59 | " function server", 60 | "}" 61 | ] 62 | in input `shouldReadAsDiagram` Diagram M.empty [ 63 | Node $ Function "server" M.empty 64 | ] [] 65 | it "reads diagram with database" $ 66 | let input = unlines [ 67 | "diagram {", 68 | " database dynamo", 69 | "}" 70 | ] 71 | in input `shouldReadAsDiagram` Diagram M.empty [ 72 | Node $ Database "dynamo" M.empty 73 | ] [] 74 | it "reads diagram with io" $ 75 | let input = unlines [ 76 | "diagram {", 77 | " io analytics", 78 | "}" 79 | ] 80 | in input `shouldReadAsDiagram` Diagram M.empty [ 81 | Node $ InputOutput "analytics" M.empty 82 | ] [] 83 | it "reads diagram with flow" $ 84 | let input = unlines [ 85 | "diagram {", 86 | " a -> b", 87 | "}" 88 | ] 89 | in input `shouldReadAsDiagram` Diagram M.empty [] [ 90 | Flow "a" "b" M.empty 91 | ] 92 | it "does not allow multiline string" $ 93 | let input = unlines [ 94 | "diagram {", 95 | " foo = \"", 96 | " omg", 97 | " yes", 98 | " \"", 99 | "}" 100 | ] 101 | in shouldFailReadAsDiagram input 102 | it "reads attributes" $ 103 | let input = unlines [ 104 | "diagram {", 105 | " io baz {", 106 | " title = \"foo\"", 107 | " description = \"bar\"", 108 | " }", 109 | "}" 110 | ] 111 | in input `shouldReadAsDiagram` Diagram M.empty [ 112 | Node $ InputOutput "baz" (M.fromList [("title", String "foo"), 113 | ("description", String "bar")]) 114 | ] [] 115 | it "reads multiple attributes on a single line" $ 116 | let input = unlines [ 117 | "diagram {", 118 | " io baz {", 119 | " title = \"foo\" description = \"bar\"", 120 | " }", 121 | "}" 122 | ] 123 | in input `shouldReadAsDiagram` Diagram M.empty [ 124 | Node $ InputOutput "baz" (M.fromList [("title", String "foo"), 125 | ("description", String "bar")]) 126 | ] [] 127 | it "reads attributes and nodes" $ 128 | let input = unlines [ 129 | "diagram {", 130 | " name = \"bar\"", 131 | " io baz {", 132 | " title = \"foo\"", 133 | " }", 134 | "}" 135 | ] 136 | in input `shouldReadAsDiagram` Diagram (M.singleton "name" (String "bar")) [ 137 | Node $ InputOutput "baz" (M.singleton "title" (String "foo")) 138 | ] [] 139 | it "reads flow with attributes" $ 140 | let input = unlines [ 141 | "diagram {", 142 | " foo -> bar {", 143 | " title = \"baz\"", 144 | " }", 145 | "}" 146 | ] 147 | in input `shouldReadAsDiagram` Diagram M.empty [] [ 148 | Flow "foo" "bar" (M.singleton "title" (String "baz")) 149 | ] 150 | it "reads text blocks" $ 151 | let input = unlines [ 152 | "diagram {", 153 | " foo -> bar {", 154 | " description = `Hello,", 155 | " \"evil\"", 156 | " world!`", 157 | " }", 158 | "}" 159 | ] 160 | in input `shouldReadAsDiagram` Diagram M.empty [] [ 161 | Flow "foo" "bar" (M.singleton "description" (String "Hello,\n\"evil\"\nworld!")) 162 | ] 163 | it "only allows boundaries in top-level diagram" $ 164 | let input = unlines [ 165 | "diagram {", 166 | " boundary {", 167 | " boundary {}", 168 | " }", 169 | "}" 170 | ] 171 | in shouldFailReadAsDiagram input 172 | it "does not allow flow inside boundary" $ 173 | let input = unlines [ 174 | "diagram {", 175 | " boundary {", 176 | " a -> b", 177 | " }", 178 | "}" 179 | ] 180 | in shouldFailReadAsDiagram input 181 | it "does not allow flow before node" $ 182 | let input = unlines [ 183 | "diagram {", 184 | " a -> b", 185 | " io a", 186 | "}" 187 | ] 188 | in shouldFailReadAsDiagram input 189 | it "can read first flow with id starting with b (conflicting with boundary)" $ 190 | let input = unlines [ 191 | "diagram {", 192 | " boundary foo {}", 193 | " bar -> baz {", 194 | " }", 195 | "}" 196 | ] 197 | in input `shouldReadAsDiagram` Diagram M.empty [ 198 | TrustBoundary "foo" M.empty [] 199 | ] [ 200 | Flow "bar" "baz" M.empty 201 | ] 202 | it "ignores comments" $ 203 | let input = unlines [ 204 | "diagram {", 205 | " /* Yes, comments!", 206 | " * Yes, more comments!", 207 | " * Yes, even more comments! */", 208 | "}" 209 | ] 210 | in input `shouldReadAsDiagram` Diagram M.empty [] [] 211 | it "ignores comments outside diagram" $ 212 | let input = unlines [ 213 | "/* Header */", 214 | "diagram {", 215 | "}", 216 | "/* Footer */" 217 | ] 218 | in input `shouldReadAsDiagram` Diagram M.empty [] [] 219 | it "reads empty array" $ 220 | let input = unlines [ 221 | "diagram {", 222 | " things = []", 223 | "}" 224 | ] 225 | in input `shouldReadAsDiagram` Diagram (M.fromList [ 226 | ("things", Array []) 227 | ]) [] [] 228 | it "reads array with one string" $ 229 | let input = unlines [ 230 | "diagram {", 231 | " things = [\"hello\"]", 232 | "}" 233 | ] 234 | in input `shouldReadAsDiagram` Diagram (M.fromList [ 235 | ("things", Array [String "hello"]) 236 | ]) [] [] 237 | it "reads array of strings" $ 238 | let input = unlines [ 239 | "diagram {", 240 | " things = [\"foo\", \"bar\"]", 241 | "}" 242 | ] 243 | in input `shouldReadAsDiagram` Diagram (M.fromList [ 244 | ("things", Array [String "foo", String "bar"]) 245 | ]) [] [] 246 | it "reads array of arrays of strings" $ 247 | let input = unlines [ 248 | "diagram {", 249 | " things = [", 250 | " [\"foo\", \"bar\"]", 251 | " ]", 252 | "}" 253 | ] 254 | in input `shouldReadAsDiagram` Diagram (M.fromList [ 255 | ("things", Array [Array [String "foo", String "bar"]]) 256 | ]) [] [] 257 | it "reads array with one text block" $ 258 | let input = unlines [ 259 | "diagram {", 260 | " things = [", 261 | " `Hello`", 262 | " ]", 263 | "}" 264 | ] 265 | in input `shouldReadAsDiagram` Diagram (M.fromList [ 266 | ("things", Array [String "Hello"]) 267 | ]) [] [] 268 | it "reads array with text blocks" $ 269 | let input = unlines [ 270 | "diagram {", 271 | " things = [", 272 | " `Hello`,", 273 | " `,", 274 | " world`", 275 | " ]", 276 | "}" 277 | ] 278 | in input `shouldReadAsDiagram` Diagram (M.fromList [ 279 | ("things", Array [String "Hello", String ",\nworld"]) 280 | ]) [] [] 281 | -------------------------------------------------------------------------------- /test/DataFlow/ValidationSpec.hs: -------------------------------------------------------------------------------- 1 | module DataFlow.ValidationSpec where 2 | 3 | import Data.Map as M 4 | 5 | import Test.Hspec 6 | 7 | import DataFlow.Core 8 | import DataFlow.Validation 9 | 10 | shouldAccept :: Diagram -> Expectation 11 | shouldAccept d = either onFailure onSuccess (validate d) 12 | where onSuccess _ = return () 13 | onFailure e = expectationFailure $ 14 | "Expected diagram to validate: " ++ show e 15 | 16 | shouldReject :: Diagram -> Expectation 17 | shouldReject d = either onFailure onSuccess (validate d) 18 | where onSuccess _ = expectationFailure $ 19 | "Expected diagram to be rejected by validate: " ++ show d 20 | onFailure _ = return () 21 | 22 | spec :: Spec 23 | spec = 24 | describe "validate" $ do 25 | it "should accept an empty diagram" $ 26 | shouldAccept $ Diagram M.empty [] [] 27 | it "should reject a diagram with flows between non-existing nodes" $ 28 | shouldReject $ Diagram M.empty [] [ 29 | Flow "foo" "bar" M.empty 30 | ] 31 | it "should accept a diagram with flows between existing nodes" $ 32 | shouldAccept $ Diagram M.empty [ 33 | Node $ Function "foo" M.empty, 34 | Node $ Function "bar" M.empty 35 | ] [ 36 | Flow "foo" "bar" M.empty 37 | ] 38 | it "should accept a diagram with flows between existing nodes inside a boundary" $ 39 | shouldAccept $ Diagram M.empty [ 40 | TrustBoundary "foo" M.empty [ 41 | Function "bar" M.empty, 42 | Function "baz" M.empty 43 | ] 44 | ] [ 45 | Flow "bar" "baz" M.empty 46 | ] 47 | it "should reject a diagram with flows between boundary IDs" $ 48 | shouldReject $ Diagram M.empty [ 49 | TrustBoundary "foo" M.empty [], 50 | TrustBoundary "bar" M.empty [] 51 | ] [ 52 | Flow "foo" "bar" M.empty 53 | ] 54 | it "should reject a boundaries with equal IDs" $ 55 | shouldReject $ Diagram M.empty [ 56 | TrustBoundary "foo" M.empty [], 57 | TrustBoundary "foo" M.empty [] 58 | ] [] 59 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 2 | -------------------------------------------------------------------------------- /watch-tests.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | if [ ! `command -v nodemon` ]; then 4 | printf "\n\033[31;1mYou need to install nodemon globally to run watch-tests.sh!\033[0m\n" 5 | printf "\n npm install -g nodemon\n\n" 6 | exit 1 7 | fi 8 | 9 | nodemon --watch src --watch test -e hs --exec ./run-tests.sh 10 | --------------------------------------------------------------------------------