dataflow 0.6.1.0 → 0.7.1.0

raw patch · 22 files changed

+960/−210 lines, 22 filesdep +aesondep +blaze-htmldep +bytestringdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, blaze-html, bytestring, filepath, hastache, markdown, text, vector

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• README.md +269/−19
• cli/Main.hs +54/−11
• dataflow.cabal +28/−6
• examples/Makefile +16/−1
• examples/legend.dfd.png binary
• examples/legend.flow +27/−8
• examples/legend.html +37/−0
• examples/legend.seq.png binary
• examples/template.ha +42/−0
• examples/webapp.dfd.png binary
• examples/webapp.flow +48/−11
• examples/webapp.html +50/−0
• examples/webapp.seq.png binary
• src/DataFlow/Attributes.hs +11/−0
• src/DataFlow/Core.hs +27/−20
• src/DataFlow/DFD.hs +76/−41
• src/DataFlow/Graphviz/Renderer.hs +6/−1
• src/DataFlow/Hastache/Renderer.hs +55/−0
• src/DataFlow/JSONGraphFormat.hs +68/−0
• src/DataFlow/JSONGraphFormat/Renderer.hs +46/−0
• src/DataFlow/Reader.hs +74/−77
• src/DataFlow/SequenceDiagram.hs +26/−15

@@ -8,45 +8,295 @@  ## Usage -So you want to you use DataFlow? Then please read [Usage](USAGE.md).+The following forms are supported by DataFlow. -## Setup+#### IDs -```bash-cabal sandbox init # optional-cabal install --only-dependencies --enable-tests-cabal configure --enable-tests+An ID can contain letters, numbers and underscores. It must start with a+letter.++<!--- Not dot code, but use dot code highlighter for .flow code -->+```dot+my_id_contain_4_words ``` -## Build+#### Strings +String literals are written using double quotes.++```dot+"this is a string and it can contain everything but double quotes and newlines"+```++**NOTE!** Escaping characters inside strings is not supported at the moment.++#### Text Blocks++Text blocks are special strings, enclosed in backticks, that are can span+multiple lines in the source document. The space characters before the first+non-space characters on each line are trimmed, regardless of the indentation.++```dot+`this is+      a+  textblock`+```++... would render as:++```+this is+a+textblock+```++#### Attributes++Attributes are key-value pairs for diagrams and nodes that are used by+output renderers. Attributes are enclosed by curly brackets. For nodes that+can contain other nodes, attributes must appear before nodes.++Keys have the same rules as IDs. Values can be strings or text blocks.++```dot+{+  key1 = "attr value"+  key2 = `attr+          value`+}+```++#### `diagram`++`diagram` is the top-level form and must appear exactly once in a DataFlow+document. It can contain attributes and nodes.++```dot+diagram {+  title = "My diagram"+}+```++#### `boundary`++The `boundary` form declares a TrustBoundary node that can contain+attributes and other nodes. Boundaries are only allowed in the top-level+diagram.++```dot+diagram {+  boundary {+    title = "My System"+  }+}+```++#### nodes: `io`, `function`, `database`++The `io`, `function` and `database` forms declare `InputOutput`, `Function` and+`Database` nodes, respectively. The nodes have IDs and they can contain+attributes. Empty attribute brackets can be omitted.++```dot+diagram {+  io thing1++  io thing2 {+    title = "Thing 2"+  }+}++```++#### `->`++The `->` form declares a `Flow` between the nodes referenced by their+IDs. It can contain attributes. Empty attribute brackets can be omitted.+Flows must be declared after all nodes.++Note that the arrow can be reversed as well (`<-`).++```dot+diagram {+  thing1 -> thing2++  thing1 <- thing2 {+    operation = "Greet"+    data = "A nice greeting"+  }+}+```++## Example++The image from the top of this README is rendered from the following DataFlow+document.++```dot+diagram {+  title = "Webapp"++  threats = `+    No particular threats at this point.++    It's **extremely** safe.`++  boundary {+    title = "Browser"++    function client {+      title = "Client"+    }+  }++  boundary {+    title = "Amazon AWS"++    function server {+      title = "Web Server"+    }+    database logs {+      title = "Logs"+    }+  }+  io analytics {+    title = "Google Analytics"+  }++  client -> server {+    operation = "Request /"+    description = `User navigates with a browser to see some content.`+  }+  server -> logs {+    operation = "Log"+    data = `The user+            IP address.`+    description = `Logged to a ELK stack.`+  }+  server -> client {+    operation = "Response"+    data = "User Profile"+    description = `The server responds with some HTML.`+  }+  analytics <- client {+    operation = "Log"+    data = "Page Navigation"+    description = `The Google Analytics plugin sends navigation+                   data to Google.`+  }+}+```++## Run DataFlow++The `dataflow` executable takes an output format and a DataFlow source document+and writes the output to `stdout`.+ ```bash-cabal build+dataflow (dfd|seq) FILE ``` -## Install+## DFD -If you initialized a sandbox the executable will end up in the sandbox, i.e.-`.cabal-sandbox/bin/dataflow`. If you have no sandbox it will end up in-`~/.cabal/bin/dataflow`. If you get any stange errors during install try a `cabal clean`+![DFD Legend](examples/legend.dfd.png) +To use the *DFD* output you need [Graphviz](http://www.graphviz.org/) installed.+ ```bash-cabal install+dataflow dfd webapp.flow | dot -Tpng > webapp.png ```+### Output -## Tests+![DFD Output](examples/webapp.dfd.png) +## Sequence Diagram++![Sequence Diagram Legend](examples/legend.seq.png)++You can use [PlantUML](http://plantuml.sourceforge.net/) to generate a sequence+diagram.+ ```bash-./run-tests.sh-# or...-./watch-tests.sh+dataflow seq webapp.flow | java -Djava.awt.headless=true -jar plantuml.jar -tpng -pipe > webapp.png ``` -## Building the Examples+### Output +![Sequence Diagram Output](examples/webapp.seq.png)++## Templating++You can use [Hastache](https://github.com/lymar/hastache) to output arbitrary+text with its Mustache-like templates.+ ```bash-make -C examples+dataflow template template.ha webapp.flow > webapp.html ```++### Built-in Functions and Values++* `markdown` - Convert the attribute at the given key from Markdown to HTML.++  ```mustache+  {{#markdown}}my_markdown_attr{{/markdown}}+  ```++* `html_linebreaks` - Replace `\n` with `<br/>` elements in the attribute at+  the given key, to retain linebreaks in HTML output.++  ```mustache+  {{#html_linebreaks}}my_formatted_attr{{/html_linebreaks}}+  ```++* `filename_without_extension` - The input `.flow` file name with no path and+  no extension. Useful when generating graphics and text/HTML with matching+  filenames (e.g. `my-flow.html` includes `my-flow.png`).++  ```mustache+  <img src="{{filename_without_extension}}.png" />+  ```++* `flows` - a list of all the Flow nodes in the diagram. Attributes of the+  flow is accessible inside the iteration scope.++  ```mustache+  <ol>+  {{#flows}}+    <li>{{description}}</li>+  {{/flows}}+  </ol>+  ```++For an example see [template.ha](examples/template.ha) and the output HTML in+[webapp.html](examples/webapp.html).++### Output++![Sequence Diagram Output](examples/webapp.seq.png)++## Makefile Example++The following Makefile finds `.flow` sources in `src` and generates DFDs, in+SVG format, in `dist`.++```make+SOURCES=$(shell find src/*.flow)+TARGETS=$(SOURCES:src/%.flow=dist/%.dfd.svg)++K := $(if $(shell which dataflow),,$(error "No dataflow executable in PATH. See https://github.com/SonyMobile/dataflow for install instructions)))"))++dist/%.dfd.svg: src/%.flow+	@dataflow dfd $< | dot -Tsvg > $@++dfd: $(TARGETS)++clean:+  rm -f $(TARGETS)+```++## Build Instructions++See [BUILD.md](BUILD.md).  ## License 

@@ -1,36 +1,79 @@ module Main where +import System.IO import System.Environment-import DataFlow.Reader-import DataFlow.DFD-import DataFlow.SequenceDiagram-import DataFlow.Graphviz.Renderer-import DataFlow.PlantUML.Renderer+import System.Exit+import qualified Data.ByteString.Lazy.Char8 as BC+import qualified Data.Text.Lazy.IO as TL -data Command = DFD | Lint+import DataFlow.Reader+import qualified DataFlow.DFD as DFD+import qualified DataFlow.SequenceDiagram as SEQ+import qualified DataFlow.Graphviz.Renderer as GVR+import qualified DataFlow.PlantUML.Renderer as PUR+import qualified DataFlow.Hastache.Renderer as HR+import qualified DataFlow.JSONGraphFormat.Renderer as JG -usage :: String-usage = "Usage: dataflow (dfd|seq) FILE"+usage :: IO ()+usage = hPutStrLn stderr $ unlines [+    "Usage: dataflow command args*",+    "",+    "Commands",+    "--------",+    "dfd SRC               - outputs a DFD in the Graphviz DOT format",+    "seq SRC               - outputs a sequence diagram in PlantUML format",+    "template TEMPLATE SRC - renders the TEMPLATE using data from SRC",+    "json SRC              - outputs a sequence diagram in JSON Graph Format (http://jsongraphformat.info/)",+    "validate SRC          - validates the input",+    "",+    "All commands print to stdout."+  ]  dfd :: FilePath -> IO () dfd path = do   res <- readDiagramFile path   case res of     (Left err) -> print err-    (Right diagram) -> putStr $ renderGraphviz $ asDFD diagram+    (Right d) -> putStr $ GVR.renderGraphviz $ DFD.asDFD d  seq' :: FilePath -> IO () seq' path = do   res <- readDiagramFile path   case res of     (Left err) -> print err-    (Right diagram) -> putStr $ renderPlantUML $ asSequenceDiagram diagram+    (Right d) -> putStr $ PUR.renderPlantUML $ SEQ.asSequenceDiagram d +template :: FilePath -> FilePath -> IO ()+template tmplPath path = do+  res <- readDiagramFile path+  tmplStr <- readFile tmplPath+  case res of+    (Left err) -> print err+    (Right d) -> HR.renderTemplate tmplStr path d >>= TL.putStr +json :: FilePath -> IO ()+json path = do+  res <- readDiagramFile path+  case res of+    (Left err) -> print err+    (Right d) -> BC.putStrLn $ JG.renderJSONGraph d++validate :: FilePath -> IO ()+validate path = do+  res <- readDiagramFile path+  case res of+    (Left err) -> print err+    (Right _) -> return ()+ main :: IO () main = do   args <- getArgs   case args of     ["dfd", path] -> dfd path     ["seq", path] -> seq' path-    _ -> fail usage+    ["template", tmplPath, path] -> template tmplPath path+    ["json", path] -> json path+    ["validate", path] -> validate path+    ["--help"] -> usage+    _ -> do hPutStrLn stderr "Invalid command!\n\nRun with --help to see usage."+            exitWith $ ExitFailure 1

@@ -1,5 +1,5 @@ name:                dataflow-version:             0.6.1.0+version:             0.7.1.0 synopsis:            Generate Graphviz documents from a Haskell representation. description:         Render graphs using a declarative markup. Currently                      supports DFD (http://en.wikipedia.org/wiki/Data_flow_diagram)@@ -18,9 +18,12 @@                      examples/webapp.flow,                      examples/webapp.seq.png,                      examples/webapp.dfd.png,+                     examples/webapp.html,                      examples/legend.flow,                      examples/legend.seq.png,                      examples/legend.dfd.png,+                     examples/legend.html,+                     examples/template.ha,                      examples/Makefile cabal-version:       >=1.10 @@ -31,6 +34,7 @@ library   exposed-modules:     DataFlow.Core,+    DataFlow.Attributes,     DataFlow.Reader,     DataFlow.PrettyRenderer,     DataFlow.Graphviz,@@ -39,20 +43,33 @@     DataFlow.PlantUML,     DataFlow.PlantUML.Renderer,     DataFlow.SequenceDiagram,-    DataFlow.DFD+    DataFlow.DFD,+    DataFlow.Hastache.Renderer,+    DataFlow.JSONGraphFormat,+    DataFlow.JSONGraphFormat.Renderer   build-depends:-    base >=4 && <4.8,+    base >=4 && < 5,     mtl >=2.2,     containers >= 0.4,     MissingH,-    parsec >= 3.1.9+    parsec >= 3.1.9,+    filepath >= 1.3.0,+    text >= 1.0,+    blaze-html >= 0.8.0.2,+    markdown >= 0.1.13.2,+    hastache >= 0.6.1,+    bytestring >= 0.10,+    vector >= 0.11,+    aeson >= 0.9.0.1   hs-source-dirs:      src   default-language:    Haskell2010  executable dataflow   main-is: Main.hs   build-depends:-    base >=4 && <4.8,+    base >=4 && < 5,+    text >= 1.0,+    bytestring >= 0.10,     dataflow   hs-source-dirs:      cli   default-language:    Haskell2010@@ -63,8 +80,13 @@   default-language: Haskell98   hs-source-dirs: test   build-depends:-    base,+    base >=4 && < 5,+    containers >= 0.4,+    parsec >= 3.1.9,     HUnit,     hspec == 2.*,+    vector >= 0.11,+    aeson >= 0.9.0.1,+    bytestring >= 0.10,     dataflow   ghc-options: -Wall

@@ -1,6 +1,9 @@ SOURCES=$(shell find *.flow) DFD_TARGETS=$(SOURCES:%.flow=%.dfd.png) SEQ_TARGETS=$(SOURCES:%.flow=%.seq.png)+HTML_TARGETS=$(SOURCES:%.flow=%.html)+HTML_TEMPLATE=template.ha+JSON_TARGETS=$(SOURCES:%.flow=%.json) DATAFLOW=../dist/build/DataFlow/dataflow PLANTUML=/tmp/dataflow-build/plantuml.jar @@ -19,9 +22,21 @@ 	@echo "$< -> $@" 	@$(DATAFLOW) seq $< | java -Djava.awt.headless=true -jar $(PLANTUML) -tpng -pipe > $@ +%.html: %.flow $(DATAFLOW) $(HTML_TEMPLATE)+	@echo "$< -> $@"+	@$(DATAFLOW) template $(HTML_TEMPLATE) $< > $@++%.json: %.flow $(DATAFLOW)+	@echo "$< -> $@"+	@$(DATAFLOW) json $< > $@+ png: $(DFD_TARGETS) $(SEQ_TARGETS) +html: $(HTML_TARGETS)++json: $(JSON_TARGETS)+ clean: 	rm -f $(DFD_TARGETS) $(SEQ_TARGETS) -all: png+all: png html json

binary file changed (22795 → 24872 bytes)

@@ -1,11 +1,30 @@-diagram '' {-  boundary 'boundary' {-    function f 'function'-    database d 'database'-    io i 'io'+diagram {+  title = "Legend"++  boundary {+    title = "A boundary"++    function f {+      title = "function"+    }+    database d {+      title = "database"+    }+    io i {+      title = "io"+    }   } -  f -> d 'Operation' 'Data'-  i -> f '' 'Data'-  f -> i 'Operation' ''+  f -> d {+    action = "Operation"+    data = "Data"+  }+  i -> f {+    data = "Data"+  }+  f -> i {+    action = "Operation"+    data = `Some data,+            and other data.`+  } }

@@ -0,0 +1,37 @@+<!DOCTYPE html>+<html lang="en">+<head>+  <meta charset="UTF-8">+  <title>Legend</title>+</head>+<body>+<h1>Legend</h1>+++<img src="./legend.dfd.png">+<a href="./legend.seq.png">Sequence Diagram</a>++<ol>+  <li>+    +        <p><strong>Data:</strong> Data</p>+    +      </li>+  <li>+    +        <p><strong>Data:</strong> Data</p>+    +      </li>+  <li>+    +        <p><strong>Data:</strong> Some data,+and other data.</p>+    +      </li>+</ol>++<h2>Threats</h2>+++</body>+</html>

binary file changed (10827 → 11159 bytes)

@@ -0,0 +1,42 @@+<!DOCTYPE html>+<html lang="en">+<head>+  <meta charset="UTF-8">+  <title>{{title}}</title>+</head>+<body>+<h1>{{title}}</h1>++{{#description}}+<p>{{{description}}}</p>+{{/description}}++<img src="./{{filename_without_extension}}.dfd.png">+<a href="./{{filename_without_extension}}.seq.png">Sequence Diagram</a>++<ol>+{{#flows}}+  <li>+    {{#operation}}+    <p><strong>{{{operation}}}</strong></p>+    {{/operation}}++    {{#data}}+    <p><strong>Data:</strong> {{{data}}}</p>+    {{/data}}++    {{#description}}+    <p>{{#html_linebreaks}}description{{/html_linebreaks}}</p>+    {{/description}}+  </li>+{{/flows}}+</ol>++<h2>Threats</h2>++{{#threats}}+<p>{{#markdown}}threats{{/markdown}}</p>+{{/threats}}++</body>+</html>

binary file changed (47451 → 48497 bytes)

@@ -1,15 +1,52 @@-diagram 'Webapp' {-  boundary 'Browser' {-    function client 'Client'+diagram {+  title = "Webapp"++  threats = `+    No particular threats at this point.++    It's **extremely** safe.`++  boundary {+    title = "Browser"++    function client {+      title = "Client"+    }   }-  boundary 'Amazon AWS' {-    function server 'Web Server'-    database logs 'Logs'++  boundary {+    title = "Amazon AWS"++    function server {+      title = "Web Server"+    }+    database logs {+      title = "Logs"+    }   }-  io analytics 'Google<br/>Analytics'+  io analytics {+    title = "Google Analytics"+  } -  client -> server 'Request /' ''-  server -> logs 'Log' 'User IP'-  server -> client 'Response' 'User Profile'-  analytics <- client 'Log' 'Page<br/>Navigation'+  client -> server {+    operation = "Request /"+    description = `User navigates with a browser to see some content.`+  }+  server -> logs {+    operation = "Log"+    data = `The user+            IP address.`+    description = `Logged to a ELK stack.`+  }+  server -> client {+    operation = "Response"+    data = "User Profile"+    description = `The server responds with some HTML.`+  }+  analytics <- client {+    operation = "Log"+    data = "Page Navigation"+    description = `The Google Analytics plugin sends navigation+                   data to Google.`+  } }

@@ -0,0 +1,50 @@+<!DOCTYPE html>+<html lang="en">+<head>+  <meta charset="UTF-8">+  <title>Webapp</title>+</head>+<body>+<h1>Webapp</h1>+++<img src="./webapp.dfd.png">+<a href="./webapp.seq.png">Sequence Diagram</a>++<ol>+  <li>+        <p><strong>Request /</strong></p>+    +    +        <p>User navigates with a browser to see some content.</p>+      </li>+  <li>+        <p><strong>Log</strong></p>+    +        <p><strong>Data:</strong> The user+IP address.</p>+    +        <p>Logged to a ELK stack.</p>+      </li>+  <li>+        <p><strong>Response</strong></p>+    +        <p><strong>Data:</strong> User Profile</p>+    +        <p>The server responds with some HTML.</p>+      </li>+  <li>+        <p><strong>Log</strong></p>+    +        <p><strong>Data:</strong> Page Navigation</p>+    +        <p>The Google Analytics plugin sends navigation<br/>data to Google.</p>+      </li>+</ol>++<h2>Threats</h2>++<p><p>No particular threats at this point.</p><p>It's <b>extremely</b> safe.</p></p>++</body>+</html>

binary file changed (19244 → 20935 bytes)

@@ -0,0 +1,11 @@+module DataFlow.Attributes where++import qualified Data.Map as M++import DataFlow.Core++getTitleOrBlank :: Attributes -> String+getTitleOrBlank = M.findWithDefault "" "title"++getTitle :: Attributes -> Maybe String+getTitle = M.lookup "title"

@@ -1,33 +1,40 @@ module DataFlow.Core (   ID,-  Name,-  Operation,-  Description,+  Attributes,   Diagram(..),-  Object(..)+  RootNode(..),+  Flow(..),+  Node(..)   ) where +import Data.Map as M+ -- | An identifier corresponding to those in Graphviz. type ID = String--- | The name of a 'Diagram' or 'Object'.-type Name = String--- | Operation heading.-type Operation = String--- | Operation description.-type Description = String +type Attributes = M.Map String String+ -- | The top level diagram.-data Diagram = Diagram (Maybe Name) [Object] deriving (Eq, Show)+data Diagram = Diagram Attributes [RootNode] [Flow]+               deriving (Eq, Show) --- | An object in a diagram.-data Object =+-- | An root node in a diagram.+data RootNode =+              -- | A top level Node.+              Node Node+              -- | Surrounds other non-root nodes, denoting a boundary.+              | TrustBoundary Attributes [Node]+              deriving (Eq, Show)++data Node =             -- | A "Input" or "Output" in DFD.-            InputOutput ID Name-            -- | Surrounds other objects, denoting a boundary.-            | TrustBoundary ID Name [Object]+            InputOutput ID Attributes             -- | A \"Function\" in DFD.-            | Function ID Name+            | Function ID Attributes             -- | A \"Database\" in DFD.-            | Database ID Name-            -- | Describes the flow of data between two objects.-            | Flow ID ID Operation Description deriving (Show, Eq)+            | Database ID Attributes+            deriving (Show, Eq)++-- | Describes the flow of data between two nodes.+data Flow = Flow ID ID Attributes+            deriving (Show, Eq)

@@ -3,22 +3,35 @@ import Text.Printf import Control.Monad import Control.Monad.State+import qualified Data.Map as M+ import qualified DataFlow.Core as C+import DataFlow.Attributes import DataFlow.Graphviz import DataFlow.Graphviz.EdgeNormalization -type Step = Int-type DFD v = State Step v+data DFDState = DFDState { step :: Int, clusterID :: Int }+type DFD v = State DFDState v  incrStep :: DFD ()-incrStep = modify (+ 1)+incrStep = modify f+  where f s = DFDState (step s + 1) (clusterID s) +incrClusterID :: DFD ()+incrClusterID = modify f+  where f s = DFDState (step s) (clusterID s + 1)+ -- | Get the next \"step\" number (the order of flow arrows in the diagram). nextStep :: DFD Int nextStep = do   incrStep-  get+  liftM step get +nextClusterID :: DFD Int+nextClusterID = do+  incrClusterID+  liftM clusterID get+ inQuotes :: String -> String inQuotes s = "\"" ++ s ++ "\"" @@ -45,57 +58,78 @@ color _ "" = "" color c s = printf "<font color=\"%s\">%s</font>" c s -convertObject :: C.Object -> DFD StmtList+convertNode :: C.Node -> DFD StmtList -convertObject (C.InputOutput id' name) = return [+convertNode (C.InputOutput id' attrs) = return [     NodeStmt id' [       Attr "shape" "square",       Attr "style" "bold",-      label $ printf "<table border=\"0\" cellborder=\"0\" cellpadding=\"2\"><tr><td>%s</td></tr></table>" (bold name)+      label $+        printf "<table border=\"0\" cellborder=\"0\" cellpadding=\"2\"><tr><td>%s</td></tr></table>"+                (bold $ getTitleOrBlank attrs)     ]   ] -convertObject (C.TrustBoundary id' name objects) = do-  objectStmts <- convertObjects objects-  let sgId = "cluster_" ++ id'-      sgAttrStmt = AttrStmt Graph [-          Attr "fontsize" "10",-          Attr "fontcolor" "grey35",-          Attr "style" "dashed",-          Attr "color" "grey35",-          label $ italic name-        ]-      stmts = sgAttrStmt : objectStmts-  return [SubgraphStmt $ Subgraph sgId stmts]--convertObject (C.Function id' name) = return [+convertNode (C.Function id' attrs) = return [     NodeStmt id' [       Attr "shape" "circle",-      label $ bold name+      label $ bold $ getTitleOrBlank attrs     ]   ] -convertObject (C.Database id' name) = return [+convertNode (C.Database id' attrs) = return [     NodeStmt id' [       Attr "shape" "none",-      label $ printf "<table sides=\"TB\" cellborder=\"0\"><tr><td>%s</td></tr></table>" (bold name)+      label $ printf "<table sides=\"TB\" cellborder=\"0\"><tr><td>%s</td></tr></table>"+              (bold $ getTitleOrBlank attrs)     ]   ] -convertObject (C.Flow i1 i2 op desc) = do-    step <- nextStep-    let stepStr = color "#3184e4" $ bold $ printf "(%d) " step+convertNodes :: [C.Node] -> DFD StmtList+convertNodes = liftM concat . mapM convertNode++convertFlow :: C.Flow -> DFD StmtList+convertFlow (C.Flow i1 i2 attrs) = do+    s <- nextStep+    let stepStr = color "#3184e4" $ bold $ printf "(%d) " s+    let text = case (M.lookup "operation" attrs, M.lookup "data" attrs) of+                (Just op, Just d) -> bold op ++ "<br/>" ++ small d+                (Just op, Nothing) -> bold op+                (Nothing, Just d) -> small d+                _ -> ""     return [         EdgeStmt (EdgeExpr (IDOperand (NodeID i1 Nothing))                           Arrow                           (IDOperand (NodeID i2 Nothing))) [-          label $ stepStr ++ bold op ++ "<br/>" ++ small desc+          label $ stepStr ++ text         ]       ] -convertObjects :: [C.Object] -> DFD StmtList-convertObjects = liftM concat . mapM convertObject+convertFlows :: [C.Flow] -> DFD StmtList+convertFlows = liftM concat . mapM convertFlow +convertRootNode :: C.RootNode -> DFD StmtList+convertRootNode (C.TrustBoundary attrs nodes) = do+  nodeStmts <- convertNodes nodes+  id' <- nextClusterID+  let sgId = "cluster_" ++ show id'+      defaultSgAttrs = [+          Attr "fontsize" "10",+          Attr "fontcolor" "grey35",+          Attr "style" "dashed",+          Attr "color" "grey35"]+      sgAttrs = case getTitle attrs of+                  Just title -> defaultSgAttrs ++ [label $ italic title]+                  Nothing -> defaultSgAttrs+      sgAttrStmt = AttrStmt Graph sgAttrs+      stmts = sgAttrStmt : nodeStmts+  return [SubgraphStmt $ Subgraph sgId stmts]++convertRootNode (C.Node n) = convertNode n++convertRootNodes :: [C.RootNode] -> DFD StmtList+convertRootNodes = liftM concat . mapM convertRootNode+ defaultGraphStmts :: StmtList defaultGraphStmts = [     AttrStmt Graph [@@ -117,18 +151,19 @@     EqualsStmt "rankdir" "t"   ] -convertDiagram :: C.Diagram -> DFD Graph -convertDiagram (C.Diagram (Just name) objects) = do-  let lbl = EqualsStmt "label" (inAngleBrackets $ bold name)-  objs <- convertObjects objects-  let stmts = lbl : defaultGraphStmts ++ objs-  return $ normalize $ Digraph (inQuotes name) stmts--convertDiagram (C.Diagram Nothing objects) = do-  objs <- convertObjects objects-  return $ normalize $ Digraph "Untitled" $ defaultGraphStmts ++ objs+convertDiagram :: C.Diagram -> DFD Graph+convertDiagram (C.Diagram attrs rootNodes flows) = do+  n <- convertRootNodes rootNodes+  f <- convertFlows flows+  return $ case M.lookup "title" attrs of+              Just title ->+                let lbl = EqualsStmt "label" (inAngleBrackets $ bold title)+                    stmts = lbl : defaultGraphStmts ++ n ++ f+                in normalize $ Digraph (inQuotes title) stmts+              Nothing ->+                normalize $ Digraph "Untitled" $ defaultGraphStmts ++ n ++ f  asDFD :: C.Diagram -> Graph-asDFD d = evalState (convertDiagram d) 0+asDFD d = evalState (convertDiagram d) DFDState { step = 0, clusterID = 0 } 

@@ -6,15 +6,20 @@   ) where  import Data.Char+import Data.List.Utils import Text.Printf+ import DataFlow.PrettyRenderer import DataFlow.Graphviz +convertNewline :: String -> String+convertNewline = replace "\n" "<br/>"+ class Renderable t where   render :: t -> Renderer ()  instance Renderable Attr where-  render (Attr i1 i2) = writeln $ printf "%s = %s;" i1 i2+  render (Attr i1 i2) = writeln $ printf "%s = %s;" i1 (convertNewline i2)  instance Renderable AttrList where   render = mapM_ render

@@ -0,0 +1,55 @@+{-# LANGUAGE OverloadedStrings #-}+module DataFlow.Hastache.Renderer (renderTemplate) where++import Data.List.Utils+import qualified Data.Map as M+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import System.FilePath (dropExtension, takeFileName)+import Text.Blaze.Html.Renderer.Text (renderHtml)+import Text.Hastache+import Text.Hastache.Context+import Text.Markdown (markdown, def)++import DataFlow.Core++mkContextWithDefaults :: Attributes -> (String -> MuType IO) -> MuContext IO+mkContextWithDefaults attrs f =+  mkStrContext $ \key -> case f key of+                          MuNothing -> defaults key+                          v -> v+  where+    defaults "markdown" = MuLambda markdownAttr+    defaults "html_linebreaks" = MuLambda htmlLinebreaksAttr+    defaults key = case M.lookup key attrs of+                    (Just v) -> MuVariable v+                    _ -> MuNothing++    markdownAttr :: T.Text -> TL.Text+    markdownAttr t =+      let key = T.unpack t+          value = M.lookup key attrs+      in case value of+        (Just s) -> renderHtml $ markdown def $ TL.pack s+        _ -> ""+    htmlLinebreaksAttr t =+      let key = T.unpack t+          value = M.lookup key attrs+      in case value of+        (Just s) -> replace "\n" "<br/>" s+        _ -> ""++mkFlowContext :: Flow -> MuContext IO+mkFlowContext (Flow _ _ attrs) = mkContextWithDefaults attrs (const MuNothing)++mkDiagramContext :: FilePath -> Diagram -> MuContext IO+mkDiagramContext fp (Diagram attrs _ flows) =+  mkContextWithDefaults attrs ctx+  where+  ctx "filename_without_extension" = MuVariable $ dropExtension $ takeFileName fp+  ctx "flows" = MuList $ map mkFlowContext flows+  ctx _ = MuNothing++renderTemplate :: String -> FilePath -> Diagram -> IO TL.Text+renderTemplate tmpl fp d =+  hastacheStr defaultConfig (encodeStr tmpl) (mkDiagramContext fp d)

@@ -0,0 +1,68 @@+{-# LANGUAGE OverloadedStrings #-}+module DataFlow.JSONGraphFormat (+  Metadata(),+  Document(..),+  Graph(..),+  Node(..),+  Edge(..)+  ) where++import           Data.Aeson+import           Data.Aeson.Types (Pair)+import qualified Data.Map         as M+import           Data.Vector      (fromList)++type Metadata = M.Map String String++data Document = SingleGraph { graph :: Graph }+              | MultiGraph { graphs :: [Graph] }++instance ToJSON Document where+  toJSON (SingleGraph g) = object [+      "graph" .= toJSON g+    ]+  toJSON (MultiGraph gs) = object [+      "graphs" .= (Array $ fromList $ map toJSON gs)+    ]++data Graph = Graph { nodes    :: [Node]+                   , edges    :: [Edge]+                   , graphLabel    :: Maybe String+                   , graphMetadata :: Metadata+                   }++instance ToJSON Graph where+  toJSON (Graph nodes edges lbl metadata) = object $+    labelField lbl ++ [+      "nodes" .= Array (fromList $ map toJSON nodes),+      "edges" .= Array (fromList $ map toJSON edges),+      "metadata" .= toJSON metadata+    ]++data Node = Node { id :: String+                 , nodeLabel :: Maybe String+                 , nodeMetadata :: Metadata }++instance ToJSON Node where+  toJSON (Node id' lbl metadata) = object $+    labelField lbl ++ [+      "id" .= toJSON id',+      "metadata" .= toJSON metadata+    ]++data Edge = Edge { source :: String+                 , target :: String+                 , edgeLabel :: Maybe String+                 , edgeMetadata :: Metadata }++instance ToJSON Edge where+  toJSON (Edge source target lbl metadata) = object $+    labelField lbl ++ [+      "source" .= toJSON source,+      "target" .= toJSON target,+      "metadata" .= toJSON metadata+    ]++labelField :: Maybe String -> [Pair]+labelField (Just s) = [("label", toJSON s)]+labelField _ = []

@@ -0,0 +1,46 @@+module DataFlow.JSONGraphFormat.Renderer (convertDiagram, renderJSONGraph) where++import           Data.Aeson+import           Data.ByteString.Lazy     (ByteString)+import qualified Data.Map                 as M++import           DataFlow.Core+import qualified DataFlow.JSONGraphFormat as JG++withLabelAndMetadataFrom :: (Maybe String -> JG.Metadata -> v) -> Attributes -> v+f `withLabelAndMetadataFrom` attrs = f (M.lookup "title" attrs) (M.delete "title" attrs)++addType :: String -> JG.Metadata -> JG.Metadata+addType = M.insert "type"++addBoundary :: Maybe String -> JG.Metadata -> JG.Metadata+addBoundary (Just b) m = M.insert "trust-boundary" b m+addBoundary Nothing m = m++convertNode :: Maybe String -> Node -> JG.Node+convertNode b (InputOutput id attrs) =+  JG.Node id `withLabelAndMetadataFrom` addBoundary b (addType "io" attrs)+convertNode b (Function id attrs) =+  JG.Node id `withLabelAndMetadataFrom` addBoundary b (addType "function" attrs)+convertNode b (Database id attrs) =+  JG.Node id `withLabelAndMetadataFrom` addBoundary b (addType "database" attrs)++convertRootNode :: RootNode -> [JG.Node]+convertRootNode (Node node) = [convertNode Nothing node]+-- TODO: replace title attribute with mandatory ID for boundaries+convertRootNode (TrustBoundary attrs nodes) =+  map (convertNode (M.lookup "title" attrs)) nodes++convertFlow :: Flow -> JG.Edge+convertFlow (Flow source target attrs) =+  JG.Edge source target `withLabelAndMetadataFrom` attrs++convertDiagram :: Diagram -> JG.Document+convertDiagram (Diagram attrs rootNodes flows) =+  let nodes = concatMap convertRootNode rootNodes+      edges = map convertFlow flows+      graph = JG.Graph nodes edges `withLabelAndMetadataFrom` attrs+  in JG.SingleGraph graph++renderJSONGraph :: Diagram -> ByteString+renderJSONGraph = encode . convertDiagram

@@ -1,11 +1,14 @@-module DataFlow.Reader (readDiagram, readDiagramFile) where+module DataFlow.Reader where -import Text.ParserCombinators.Parsec+import Control.Monad+import Data.Functor ((<$>))+import Control.Applicative ((<*>)) import Data.Char-import DataFlow.Core+import Data.List+import qualified Data.Map as M+import Text.ParserCombinators.Parsec -nameToID :: String -> String-nameToID = filter isLetter . map toLower+import DataFlow.Core  identifier :: Parser ID identifier = do@@ -13,49 +16,66 @@   rest <-  many (letter <|> digit <|> char '_')   return $ first : rest -quoted :: Parser ID-quoted = do+str :: Parser String+str = do   -- TODO: Handle escaped characters.-  _ <- char '\''-  s <- many (noneOf "'")-  _ <- char '\''+  _ <- char '"'+  s <- many (noneOf "\"\r\n")+  _ <- char '"'   return s -skipWhitespace :: Parser ()-skipWhitespace = skipMany $ space <|> newline--skipWhitespace1 :: Parser ()-skipWhitespace1 = skipMany $ space <|> newline+textBlock :: Parser String+textBlock = do+  _ <- char '`'+  s <- anyToken `manyTill` try (char '`')+  return $ intercalate "\n" $ map (dropWhile isSpace) $ lines s  inBraces :: Parser t -> Parser t inBraces inside = do-  skipWhitespace+  spaces   _ <- char '{'-  skipWhitespace+  spaces   c <- inside-  skipWhitespace+  spaces   _ <- char '}'-  skipWhitespace+  spaces   return c -idAndNameObject :: String -> (ID -> ID -> t) -> Parser t-idAndNameObject keyword f = do+attr :: Parser (String, String)+attr = do+  key <- identifier+  skipMany1 $ char ' '+  _ <- char '='+  skipMany1 $ char ' '+  value <- try textBlock <|> str+  spaces+  return (key, value)++attrs :: Parser Attributes+attrs = liftM M.fromList $ many (try attr)++-- | Construct a parser for an node with an ID:+--+-- @+-- \<keyword\> \<id\> {+--   ...+-- }+-- @+idAndAttrsNode :: String -> (ID -> Attributes -> t) -> Parser t+idAndAttrsNode keyword f = do   _ <- string keyword   skipMany1 space   id' <- identifier-  skipMany1 space-  name <- quoted-  skipWhitespace1-  return $ f id' name+  f id' <$> option M.empty (try (inBraces attrs)) -function :: Parser Object-function = idAndNameObject "function" Function+function :: Parser Node+function = idAndAttrsNode "function" Function -database :: Parser Object-database = idAndNameObject "database" Database+database :: Parser Node+database = idAndAttrsNode "database" Database -io :: Parser Object-io = idAndNameObject "io" InputOutput+io :: Parser Node+io = idAndAttrsNode "io" InputOutput  data FlowType = Back | Forward @@ -67,64 +87,41 @@     "<-" -> return Back     _ -> fail "Invalid flow statement" -flow :: Parser Object+flow :: Parser Flow flow = do   i1 <- identifier   skipMany1 space-  a <- arrow+  arr <- arrow   skipMany1 space   i2 <- identifier-  skipMany1 space-  data' <- quoted-  skipMany1 space-  desc <- quoted-  skipWhitespace1-  case a of-    Back -> return $ Flow i2 i1 data' desc-    Forward -> return $ Flow i1 i2 data' desc+  a <- option M.empty $ try (inBraces attrs)+  case arr of+    Back -> return $ Flow i2 i1 a+    Forward -> return $ Flow i1 i2 a -boundary :: Parser Object+node :: Parser Node+node = do+  n <- try function+       <|> try database+       <|> io+  spaces+  return n++boundary :: Parser RootNode boundary = do   _ <- string "boundary"-  skipMany1 space-  name <- quoted-  let id' = nameToID name-  skipMany1 space-  objs <- inBraces objects-  skipWhitespace1-  return $ TrustBoundary id' name objs--object :: Parser Object-object =-  try boundary-  <|> try function-  <|> try database-  <|> try io-  <|> flow--objects :: Parser [Object]-objects = object `sepBy` many (space <|> newline)--namedDiagram :: Parser Diagram-namedDiagram = do-  _ <- string "diagram"-  skipMany1 space-  name <- quoted-  skipMany1 space-  objs <- inBraces objects-  return $ Diagram (Just name) objs+  inBraces (TrustBoundary <$> attrs <*> many node) -unnamedDiagram :: Parser Diagram-unnamedDiagram = do-  _ <- string "diagram"-  skipMany1 space-  objs <- inBraces objects-  return $ Diagram Nothing objs+rootNode :: Parser RootNode+rootNode = try (Node <$> node)+           <|> boundary  diagram :: Parser Diagram-diagram = try unnamedDiagram <|> namedDiagram+diagram = do+  _ <- string "diagram"+  inBraces (Diagram <$> attrs <*> many (try rootNode) <*> many flow) -readDiagram :: String -> String ->  Either ParseError Diagram+readDiagram :: String -> String -> Either ParseError Diagram readDiagram = parse diagram  readDiagramFile :: FilePath -> IO (Either ParseError Diagram)

@@ -1,12 +1,15 @@ module DataFlow.SequenceDiagram where +import qualified Data.Map as M+import Data.List.Utils import Text.Printf+ import qualified DataFlow.Core as C+import DataFlow.Attributes import DataFlow.PlantUML-import Data.List.Utils  convertNewline :: String -> String-convertNewline = replace "<br/>" "\\n"+convertNewline = replace "\n" "\\n"  bold :: String -> String bold "" = ""@@ -19,17 +22,18 @@   join "\\n" $ map italic' $ split "\\n" s   where italic' = printf "<i>%s</i>" -convertObject :: C.Object -> Stmt-convertObject (C.InputOutput id' name) =-  Entity id' $ convertNewline name-convertObject (C.TrustBoundary _ name objects) =-  Box (convertNewline name) $ map convertObject objects-convertObject (C.Function id' name) =-  Participant id' $ convertNewline name-convertObject (C.Database id' name) =-  Database id' $ convertNewline name-convertObject (C.Flow i1 i2 op desc) =-  let p = (convertNewline (bold op), italic $ convertNewline desc)+convertNode :: C.Node -> Stmt+convertNode (C.InputOutput id' attrs) =+  Entity id' $ convertNewline $ getTitleOrBlank attrs+convertNode (C.Function id' attrs) =+  Participant id' $ convertNewline $ getTitleOrBlank attrs+convertNode (C.Database id' attrs) =+  Database id' $ convertNewline $ getTitleOrBlank attrs++convertFlow :: C.Flow -> Stmt+convertFlow (C.Flow i1 i2 attrs) =+  let p = (convertNewline (bold $ M.findWithDefault "" "operation" attrs),+           italic $ convertNewline (M.findWithDefault "" "data" attrs))       s = case p of             ("", "") -> ""             ("", d) -> d@@ -37,6 +41,11 @@             (o, d) -> o ++ "\\n" ++ d   in Edge i1 i2 s +convertRootNode :: C.RootNode -> Stmt+convertRootNode (C.TrustBoundary attrs nodes) =+  Box (convertNewline $ M.findWithDefault "Untitled" "title" attrs) $ map convertNode nodes+convertRootNode (C.Node n) = convertNode n+ defaultSkinParams :: [Stmt] defaultSkinParams = [     SkinParam "BackgroundColor" "#white",@@ -79,5 +88,7 @@   ]  asSequenceDiagram :: C.Diagram -> Diagram-asSequenceDiagram (C.Diagram _ objects) =-  SequenceDiagram $ defaultSkinParams ++ map convertObject objects+asSequenceDiagram (C.Diagram _ rootNodes flows) =+  SequenceDiagram $ defaultSkinParams +                    ++ map convertRootNode rootNodes +                    ++ map convertFlow flows