dataflow 0.6.0.0 → 0.6.1.0

raw patch · 21 files changed

+333/−317 lines, 21 filesdep +MissingHdep ~parsecbinary-addedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: MissingH

Dependency ranges changed: parsec

API changes (from Hackage documentation)

Files

• LICENSE +22/−19
• README.md +26/−49
• cli/Main.hs +12/−2
• dataflow.cabal +19/−14
• examples/Makefile +16/−6
• examples/legend.dfd.png binary
• examples/legend.flow +3/−3
• examples/legend.seq.png binary
• examples/legend.svg +0/−54
• examples/webapp.dfd.png binary
• examples/webapp.flow +1/−1
• examples/webapp.seq.png binary
• examples/webapp.svg +0/−75
• src/DataFlow/DFD.hs +30/−30
• src/DataFlow/Graphviz.hs +1/−4
• src/DataFlow/Graphviz/EdgeNormalization.hs +1/−1
• src/DataFlow/Graphviz/Renderer.hs +13/−59
• src/DataFlow/PlantUML.hs +15/−0
• src/DataFlow/PlantUML/Renderer.hs +45/−0
• src/DataFlow/PrettyRenderer.hs +46/−0
• src/DataFlow/SequenceDiagram.hs +83/−0

@@ -1,21 +1,24 @@-The MIT License (MIT)--Copyright (c) 2015 Oskar Wickström--Permission is hereby granted, free of charge, to any person obtaining a copy-of this software and associated documentation files (the "Software"), to deal-in the Software without restriction, including without limitation the rights-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell-copies of the Software, and to permit persons to whom the Software is-furnished to do so, subject to the following conditions:+Copyright (c) 2015, Sony Mobile AB+All rights reserved. -The above copyright notice and this permission notice shall be included in-all copies or substantial portions of the Software.+Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above copyright+      notice, this list of conditions and the following disclaimer in the+      documentation and/or other materials provided with the distribution.+    * Neither the name of the <organization> nor the+      names of its contributors may be used to endorse or promote products+      derived from this software without specific prior written permission. -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN-THE SOFTWARE.+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+ LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -1,63 +1,45 @@ # DataFlow -Generate Graphviz documents from a Haskell representation.--## Getting Started+Render graphs using a declarative markup. Currently supports DFD+(http://en.wikipedia.org/wiki/Data_flow_diagram) and sequence diagrams+(http://plantuml.sourceforge.net/sequence.html). -```-cabal install dataflow@0.6.0.0-```+![DFD Output](examples/webapp.dfd.png)  ## Usage -![Legend](https://rawgit.com/owickstrom/dataflow/master/examples/legend.svg)--The objects supported by DataFlow is:+So you want to you use DataFlow? Then please read [Usage](USAGE.md). -* `boundary`-* `io`-* `function`-* `database`-* `->`+## Setup -These are composed in a `diagram` to get something printable.+```bash+cabal sandbox init # optional+cabal install --only-dependencies --enable-tests+cabal configure --enable-tests+``` -## Example+## Build +```bash+cabal build ```-diagram 'Webapp' {-  boundary 'Browser' {-    function client 'Client'-  }-  boundary 'Amazon AWS' {-    function server 'Web Server'-    database logs 'Logs'-  }-  io analytics 'Google<br/>Analytics' -  client -> server 'Request /' ''-  server -> logs 'Log' 'User IP'-  server -> client 'Response' 'User Profile'-  client -> analytics 'Log' 'Page Navigation'-}-```+## Install -Then generate your output with dot.+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`  ```bash-dataflow dfd webapp.flow | dot -Tsvg > webapp.svg+cabal install ``` -That should generate something like the following.--![Example Output](https://rawgit.com/owickstrom/dataflow/master/examples/webapp.svg)--## Build+## Tests -```-cabal sandbox init-cabal configure --enable-tests-cabal install --only-dependencies --enable-tests+```bash+./run-tests.sh+# or...+./watch-tests.sh ```  ## Building the Examples@@ -65,12 +47,7 @@ ```bash make -C examples ```-## Haskell Docs -See [the Hackage site](https://hackage.haskell.org/package/dataflow).--## Release+## License -```bash-cabal clean && cabal build && cabal sdist && cabal upload dist/dataflow-*.tar.gz-```+BSD-3, see [LICENSE](LICENSE).

@@ -1,15 +1,16 @@ module Main where  import System.Environment-import DataFlow.Core import DataFlow.Reader import DataFlow.DFD+import DataFlow.SequenceDiagram import DataFlow.Graphviz.Renderer+import DataFlow.PlantUML.Renderer  data Command = DFD | Lint  usage :: String-usage = "Usage: dataflow (dfd|lint) FILE"+usage = "Usage: dataflow (dfd|seq) FILE"  dfd :: FilePath -> IO () dfd path = do@@ -18,9 +19,18 @@     (Left err) -> print err     (Right diagram) -> putStr $ renderGraphviz $ asDFD diagram +seq' :: FilePath -> IO ()+seq' path = do+  res <- readDiagramFile path+  case res of+    (Left err) -> print err+    (Right diagram) -> putStr $ renderPlantUML $ asSequenceDiagram diagram++ main :: IO () main = do   args <- getArgs   case args of     ["dfd", path] -> dfd path+    ["seq", path] -> seq' path     _ -> fail usage

@@ -1,46 +1,51 @@ name:                dataflow-version:             0.6.0.0+version:             0.6.1.0 synopsis:            Generate Graphviz documents from a Haskell representation.-description:         Outputs .dot files that can be processed by the dot-                     command. Currently it only supports the DFD output format-                     (http://en.wikipedia.org/wiki/Data_flow_diagram). Support-                     for a Graphviz-like input format (instead of using the-                     data structures in Haskell) is planned.-homepage:            https://github.com/owickstrom/dataflow-license:             MIT+description:         Render graphs using a declarative markup. Currently+                     supports DFD (http://en.wikipedia.org/wiki/Data_flow_diagram)+                     and sequence diagrams (http://plantuml.sourceforge.net/sequence.html).+homepage:            https://github.com/sonyxperiadev/dataflow+license:             BSD3 license-file:        LICENSE-author:              Oskar Wickström+author:              Oskar Wickström (Sony Mobile Communications) maintainer:          oskar.wickstrom@gmail.com-copyright:           oskar.wickstrom@gmail.com+copyright:           Sony Mobile Communications category:            Code Generation, Compiler, Graphs  build-type:          Simple extra-source-files:  README.md,                      LICENSE,                      examples/webapp.flow,-                     examples/webapp.svg,+                     examples/webapp.seq.png,+                     examples/webapp.dfd.png,                      examples/legend.flow,-                     examples/legend.svg,+                     examples/legend.seq.png,+                     examples/legend.dfd.png,                      examples/Makefile cabal-version:       >=1.10  source-repository head   type: git-  location: git@github.com:owickstrom/dataflow.git+  location: git@github.com:sonyxperiadev/dataflow.git  library   exposed-modules:     DataFlow.Core,     DataFlow.Reader,+    DataFlow.PrettyRenderer,     DataFlow.Graphviz,     DataFlow.Graphviz.EdgeNormalization,     DataFlow.Graphviz.Renderer,+    DataFlow.PlantUML,+    DataFlow.PlantUML.Renderer,+    DataFlow.SequenceDiagram,     DataFlow.DFD   build-depends:     base >=4 && <4.8,     mtl >=2.2,     containers >= 0.4,-    parsec+    MissingH,+    parsec >= 3.1.9   hs-source-dirs:      src   default-language:    Haskell2010 

@@ -1,17 +1,27 @@ SOURCES=$(shell find *.flow)-TARGETS=$(SOURCES:%.flow=%.svg)+DFD_TARGETS=$(SOURCES:%.flow=%.dfd.png)+SEQ_TARGETS=$(SOURCES:%.flow=%.seq.png) DATAFLOW=../dist/build/DataFlow/dataflow+PLANTUML=/tmp/dataflow-build/plantuml.jar  $(DATAFLOW): 	cd .. && cabal build -%.svg: %.flow $(DATAFLOW)+$(PLANTUML):+	@mkdir -p /tmp/dataflow-build+	@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"++%.dfd.png: %.flow $(DATAFLOW) 	@echo "$< -> $@"-	@$(DATAFLOW) dfd $< | dot -Nfontname=Courier -Efontname=Courier -Tsvg > $@+	@$(DATAFLOW) dfd $< | dot -Tpng > $@ -svg: $(TARGETS)+%.seq.png: %.flow $(DATAFLOW) $(PLANTUML)+	@echo "$< -> $@"+	@$(DATAFLOW) seq $< | java -Djava.awt.headless=true -jar $(PLANTUML) -tpng -pipe > $@ +png: $(DFD_TARGETS) $(SEQ_TARGETS)+ clean:-	rm -f $(TARGETS)+	rm -f $(DFD_TARGETS) $(SEQ_TARGETS) -all: svg+all: png

binary file changed (absent → 22795 bytes)

@@ -5,7 +5,7 @@     io i 'io'   } -  f -> d 'Data' 'Description'-  i -> f '' 'Description'-  f -> i 'Data' ''+  f -> d 'Operation' 'Data'+  i -> f '' 'Data'+  f -> i 'Operation' '' }

binary file changed (absent → 10827 bytes)

@@ -1,54 +0,0 @@-<?xml version="1.0" encoding="UTF-8" standalone="no"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"- "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<!-- Generated by graphviz version 2.38.0 (20140413.2041)- -->-<!-- Pages: 1 -->-<svg width="313pt" height="357pt"- viewBox="0.00 0.00 313.00 356.62" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">-<g id="graph0" class="graph" transform="scale(1 1) rotate(0) translate(4 352.624)">-<polygon fill="white" stroke="none" points="-4,4 -4,-352.624 309,-352.624 309,4 -4,4"/>-<g id="clust1" class="cluster"><title>cluster_boundary</title>-<polygon fill="none" stroke="#595959" stroke-dasharray="5,2" points="8,-8 8,-340.624 297,-340.624 297,-8 8,-8"/>-<text text-anchor="start" x="131.65" y="-329.624" font-family="Arial" font-style="italic" font-size="10.00" fill="#595959">boundary</text>-</g>-<!-- f -->-<g id="node1" class="node"><title>f</title>-<ellipse fill="none" stroke="black" cx="155" cy="-166.562" rx="52.6248" ry="52.6248"/>-<text text-anchor="start" x="121.395" y="-163.362" font-family="Courier,monospace" font-weight="bold" font-size="14.00">function</text>-</g>-<!-- i -->-<g id="node3" class="node"><title>i</title>-<polygon fill="none" stroke="black" stroke-width="2" points="179,-56 139,-56 139,-16 179,-16 179,-56"/>-<text text-anchor="start" x="150.599" y="-32.8" font-family="Courier,monospace" font-weight="bold" font-size="14.00">io</text>-</g>-<!-- f&#45;&gt;i -->-<g id="edge2" class="edge"><title>f&#45;&gt;i</title>-<path fill="none" stroke="black" d="M109.247,-140.496C83.3903,-122.922 59.1313,-98.3119 74.9893,-74 86.8169,-55.8669 109.748,-46.5597 128.668,-41.8175"/>-<polygon fill="black" stroke="black" points="129.651,-45.1851 138.67,-39.6256 128.153,-38.3474 129.651,-45.1851"/>-<text text-anchor="start" x="92.603" y="-87.4" font-family="Courier,monospace" font-weight="bold" font-size="12.00" fill="#3184e4">(2) </text>-<text text-anchor="start" x="74" y="-77" font-family="Courier,monospace" font-size="10.00">Description</text>-</g>-<!-- f&#45;&gt;i -->-<g id="edge3" class="edge"><title>f&#45;&gt;i</title>-<path fill="none" stroke="black" d="M156.92,-103.866C157.459,-86.521 158.007,-68.9241 158.405,-56.1386"/>-<polygon fill="black" stroke="black" points="153.417,-103.908 156.604,-114.012 160.413,-104.126 153.417,-103.908"/>-<text text-anchor="start" x="157" y="-82.4" font-family="Courier,monospace" font-weight="bold" font-size="12.00" fill="#3184e4">(3) </text>-<text text-anchor="start" x="185.805" y="-82.4" font-family="Courier,monospace" font-weight="bold" font-size="12.00">Data</text>-</g>-<!-- d -->-<g id="node2" class="node"><title>d</title>-<text text-anchor="start" x="121.895" y="-291.925" font-family="Courier,monospace" font-weight="bold" font-size="14.00">database</text>-<polyline fill="none" stroke="black" points="116.5,-283.125 193.5,-283.125 "/>-<polyline fill="none" stroke="black" points="193.5,-307.125 116.5,-307.125 "/>-</g>-<!-- d&#45;&gt;f -->-<g id="edge1" class="edge"><title>d&#45;&gt;f</title>-<path fill="none" stroke="black" d="M155,-277.056C155,-264.647 155,-247.026 155,-229.538"/>-<polygon fill="black" stroke="black" points="158.5,-229.297 155,-219.297 151.5,-229.297 158.5,-229.297"/>-<text text-anchor="start" x="159.201" y="-250.525" font-family="Courier,monospace" font-weight="bold" font-size="12.00" fill="#3184e4">(1) </text>-<text text-anchor="start" x="188.005" y="-250.525" font-family="Courier,monospace" font-weight="bold" font-size="12.00">Data</text>-<text text-anchor="start" x="155" y="-240.125" font-family="Courier,monospace" font-size="10.00">Description</text>-</g>-</g>-</svg>

binary file changed (absent → 47451 bytes)

@@ -11,5 +11,5 @@   client -> server 'Request /' ''   server -> logs 'Log' 'User IP'   server -> client 'Response' 'User Profile'-  analytics <- client 'Log' 'Page Navigation'+  analytics <- client 'Log' 'Page<br/>Navigation' }

binary file changed (absent → 19244 bytes)

@@ -1,75 +0,0 @@-<?xml version="1.0" encoding="UTF-8" standalone="no"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"- "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<!-- Generated by graphviz version 2.38.0 (20140413.2041)- -->-<!-- Title: Webapp Pages: 1 -->-<svg width="410pt" height="470pt"- viewBox="0.00 0.00 409.97 470.25" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">-<g id="graph0" class="graph" transform="scale(1 1) rotate(0) translate(4 466.246)">-<title>Webapp</title>-<polygon fill="white" stroke="none" points="-4,4 -4,-466.246 405.972,-466.246 405.972,4 -4,4"/>-<text text-anchor="start" x="163.92" y="-443.246" font-family="Arial" font-weight="bold" font-size="20.00">Webapp</text>-<g id="clust1" class="cluster"><title>cluster_browser</title>-<polygon fill="none" stroke="#595959" stroke-dasharray="5,2" points="139.472,-8 139.472,-127.396 239.472,-127.396 239.472,-8 139.472,-8"/>-<text text-anchor="start" x="171.134" y="-116.396" font-family="Arial" font-style="italic" font-size="10.00" fill="#595959">Browser</text>-</g>-<g id="clust2" class="cluster"><title>cluster_amazonaws</title>-<polygon fill="none" stroke="#595959" stroke-dasharray="5,2" points="22.4718,-167.396 22.4718,-423.248 164.472,-423.248 164.472,-167.396 22.4718,-167.396"/>-<text text-anchor="start" x="62.8126" y="-412.248" font-family="Arial" font-style="italic" font-size="10.00" fill="#595959">Amazon AWS</text>-</g>-<!-- client -->-<g id="node1" class="node"><title>client</title>-<ellipse fill="none" stroke="black" cx="189.472" cy="-57.9485" rx="41.897" ry="41.897"/>-<text text-anchor="start" x="164.268" y="-54.7485" font-family="Courier,monospace" font-weight="bold" font-size="14.00">Client</text>-</g>-<!-- server -->-<g id="node2" class="node"><title>server</title>-<ellipse fill="none" stroke="black" cx="93.4718" cy="-238.572" rx="63.353" ry="63.353"/>-<text text-anchor="start" x="51.4649" y="-235.372" font-family="Courier,monospace" font-weight="bold" font-size="14.00">Web Server</text>-</g>-<!-- server&#45;&gt;client -->-<g id="edge1" class="edge"><title>server&#45;&gt;client</title>-<path fill="none" stroke="black" d="M38.7491,-206.273C12.0359,-186.823 -11.0623,-160.767 5.85655,-135.396 34.9435,-91.7784 94.114,-73.0083 137.453,-64.9548"/>-<polygon fill="black" stroke="black" points="138.286,-68.363 147.548,-63.2173 137.099,-61.4645 138.286,-68.363"/>-<text text-anchor="start" x="6.47178" y="-143.796" font-family="Courier,monospace" font-weight="bold" font-size="12.00" fill="#3184e4">(1) </text>-<text text-anchor="start" x="35.2765" y="-143.796" font-family="Courier,monospace" font-weight="bold" font-size="12.00">Request /</text>-</g>-<!-- server&#45;&gt;client -->-<g id="edge3" class="edge"><title>server&#45;&gt;client</title>-<path fill="none" stroke="black" d="M127.976,-173.372C142.103,-147.086 157.928,-117.641 169.986,-95.2041"/>-<polygon fill="black" stroke="black" points="124.709,-172.056 123.058,-182.522 130.875,-175.37 124.709,-172.056"/>-<text text-anchor="start" x="147.472" y="-148.796" font-family="Courier,monospace" font-weight="bold" font-size="12.00" fill="#3184e4">(3) </text>-<text text-anchor="start" x="176.276" y="-148.796" font-family="Courier,monospace" font-weight="bold" font-size="12.00">Response</text>-<text text-anchor="start" x="154.673" y="-138.396" font-family="Courier,monospace" font-size="10.00">User Profile</text>-</g>-<!-- logs -->-<g id="node3" class="node"><title>logs</title>-<text text-anchor="start" x="86.169" y="-374.548" font-family="Courier,monospace" font-weight="bold" font-size="14.00">Logs</text>-<polyline fill="none" stroke="black" points="80.9718,-365.748 123.972,-365.748 "/>-<polyline fill="none" stroke="black" points="123.972,-389.748 80.9718,-389.748 "/>-</g>-<!-- logs&#45;&gt;server -->-<g id="edge2" class="edge"><title>logs&#45;&gt;server</title>-<path fill="none" stroke="black" d="M101.35,-359.652C100.547,-347.405 99.4043,-329.994 98.2381,-312.219"/>-<polygon fill="black" stroke="black" points="101.698,-311.497 97.5511,-301.748 94.7134,-311.956 101.698,-311.497"/>-<text text-anchor="start" x="100.472" y="-333.148" font-family="Courier,monospace" font-weight="bold" font-size="12.00" fill="#3184e4">(2) </text>-<text text-anchor="start" x="129.276" y="-333.148" font-family="Courier,monospace" font-weight="bold" font-size="12.00">Log</text>-<text text-anchor="start" x="104.672" y="-322.748" font-family="Courier,monospace" font-size="10.00">User IP</text>-</g>-<!-- analytics -->-<g id="node4" class="node"><title>analytics</title>-<polygon fill="none" stroke="black" stroke-width="2" points="401.972,-288.072 302.972,-288.072 302.972,-189.072 401.972,-189.072 401.972,-288.072"/>-<text text-anchor="start" x="327.768" y="-242.372" font-family="Courier,monospace" font-weight="bold" font-size="14.00">Google</text>-<text text-anchor="start" x="315.166" y="-228.372" font-family="Courier,monospace" font-weight="bold" font-size="14.00">Analytics</text>-</g>-<!-- analytics&#45;&gt;client -->-<g id="edge4" class="edge"><title>analytics&#45;&gt;client</title>-<path fill="none" stroke="black" d="M307.931,-188.763C281.593,-159.9 248.722,-123.878 224.292,-97.1064"/>-<polygon fill="black" stroke="black" points="226.645,-94.4922 217.319,-89.4647 221.474,-99.2107 226.645,-94.4922"/>-<text text-anchor="start" x="296.275" y="-148.796" font-family="Courier,monospace" font-weight="bold" font-size="12.00" fill="#3184e4">(4) </text>-<text text-anchor="start" x="325.08" y="-148.796" font-family="Courier,monospace" font-weight="bold" font-size="12.00">Log</text>-<text text-anchor="start" x="276.472" y="-138.396" font-family="Courier,monospace" font-size="10.00">Page Navigation</text>-</g>-</g>-</svg>

@@ -26,8 +26,8 @@ inAngleBrackets s = "<" ++ s ++ ">"  label :: String -> Attr-label "" = Attr (ID "label") (ID "")-label s = Attr (ID "label") (ID $ inAngleBrackets s)+label "" = Attr "label" ""+label s = Attr "label" $ inAngleBrackets s  bold :: String -> String bold "" = ""@@ -48,36 +48,36 @@ convertObject :: C.Object -> DFD StmtList  convertObject (C.InputOutput id' name) = return [-    NodeStmt (ID id') [-      Attr (ID "shape") (ID "square"),-      Attr (ID "style") (ID "bold"),+    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)     ]   ]  convertObject (C.TrustBoundary id' name objects) = do   objectStmts <- convertObjects objects-  let sgId = ID $ "cluster_" ++ id'+  let sgId = "cluster_" ++ id'       sgAttrStmt = AttrStmt Graph [-          Attr (ID "fontsize") (ID "10"),-          Attr (ID "fontcolor") (ID "grey35"),-          Attr (ID "style") (ID "dashed"),-          Attr (ID "color") (ID "grey35"),+          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 [-    NodeStmt (ID id') [-      Attr (ID "shape") (ID "circle"),+    NodeStmt id' [+      Attr "shape" "circle",       label $ bold name     ]   ]  convertObject (C.Database id' name) = return [-    NodeStmt (ID id') [-      Attr (ID "shape") (ID "none"),+    NodeStmt id' [+      Attr "shape" "none",       label $ printf "<table sides=\"TB\" cellborder=\"0\"><tr><td>%s</td></tr></table>" (bold name)     ]   ]@@ -86,9 +86,9 @@     step <- nextStep     let stepStr = color "#3184e4" $ bold $ printf "(%d) " step     return [-        EdgeStmt (EdgeExpr (IDOperand (NodeID (ID i1) Nothing))+        EdgeStmt (EdgeExpr (IDOperand (NodeID i1 Nothing))                           Arrow-                          (IDOperand (NodeID (ID i2) Nothing))) [+                          (IDOperand (NodeID i2 Nothing))) [           label $ stepStr ++ bold op ++ "<br/>" ++ small desc         ]       ]@@ -99,35 +99,35 @@ defaultGraphStmts :: StmtList defaultGraphStmts = [     AttrStmt Graph [-      Attr (ID "fontname") (ID "Arial"),-      Attr (ID "fontsize") (ID "14")+      Attr "fontname" "Arial",+      Attr "fontsize" "14"     ],     AttrStmt Node [-      Attr (ID "fontname") (ID "Arial"),-      Attr (ID "fontsize") (ID "14")+      Attr "fontname" "Arial",+      Attr "fontsize" "14"     ],     AttrStmt Edge [-      Attr (ID "shape") (ID "none"),-      Attr (ID "fontname") (ID "Arial"),-      Attr (ID "fontsize") (ID "12")+      Attr "shape" "none",+      Attr "fontname" "Arial",+      Attr "fontsize" "12"     ],-    EqualsStmt (ID "labelloc") (ID $ inQuotes "t"),-    EqualsStmt (ID "fontsize") (ID "20"),-    EqualsStmt (ID "nodesep") (ID "1"),-    EqualsStmt (ID "rankdir") (ID "t")+    EqualsStmt "labelloc" (inQuotes "t"),+    EqualsStmt "fontsize" "20",+    EqualsStmt "nodesep" "1",+    EqualsStmt "rankdir" "t"   ]  convertDiagram :: C.Diagram -> DFD Graph  convertDiagram (C.Diagram (Just name) objects) = do-  let lbl = EqualsStmt (ID "label") (ID $ inAngleBrackets $ bold name)+  let lbl = EqualsStmt "label" (inAngleBrackets $ bold name)   objs <- convertObjects objects   let stmts = lbl : defaultGraphStmts ++ objs-  return $ normalize $ Digraph (ID $ inQuotes name) stmts+  return $ normalize $ Digraph (inQuotes name) stmts  convertDiagram (C.Diagram Nothing objects) = do   objs <- convertObjects objects-  return $ normalize $ Digraph (ID "Untitled") $ defaultGraphStmts ++ objs+  return $ normalize $ Digraph "Untitled" $ defaultGraphStmts ++ objs  asDFD :: C.Diagram -> Graph asDFD d = evalState (convertDiagram d) 0

@@ -3,10 +3,7 @@ --   in the grammar are not supported. module DataFlow.Graphviz where -newtype ID = ID String deriving (Eq, Ord)--instance Show ID where-  show (ID i) = i+type ID = String  data Attr = Attr ID ID deriving (Show, Eq) type AttrList = [Attr]

@@ -33,7 +33,7 @@ normalizeStmt e@(EdgeStmt (EdgeExpr (IDOperand i1) op (IDOperand i2)) attrs) = do   i <- shouldInvert (i1, i2)   return $ if i then EdgeStmt (EdgeExpr (IDOperand i2) op (IDOperand i1))-                              (Attr (ID "dir") (ID "back") : attrs)+                              (Attr "dir" "back" : attrs)            else e  normalizeStmt (SubgraphStmt (Subgraph id' stmts)) = do

@@ -1,62 +1,20 @@ {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}  module DataFlow.Graphviz.Renderer (   renderGraphviz   ) where -import Control.Monad.State-import Control.Monad.Writer import Data.Char import Text.Printf+import DataFlow.PrettyRenderer import DataFlow.Graphviz -type Indent = Int-type IndentNext = Bool-type Step = Int-data RendererState = RendererState Indent IndentNext Step---- | The Renderer represents some output generator that runs on a 'Diagram'.-type Renderer t = WriterT [String] (State RendererState) t- class Renderable t where   render :: t -> Renderer () --- | Write a string to the output (no linefeed).-write :: String -> Renderer ()-write s = do-  (RendererState n indentNext step) <- lift get-  if indentNext-    then tell [replicate n ' ' ++ s]-    else tell [s]-  put $ RendererState n False step---- | Write a string to the output (with linefeed).-writeln :: String -> Renderer ()-writeln s = do-  write s-  write "\n"-  modify $ \(RendererState n _ s') -> RendererState n True s'---- | Increase indent with 2 spaces.-indent :: Renderer ()-indent = modify $ \(RendererState n indentNext s) -> RendererState (n + 2) indentNext s---- | Decrease indent with 2 spaces.-dedent :: Renderer ()-dedent = modify $ \(RendererState n indentNext s) -> RendererState (n - 2) indentNext s---- | Indent the output of gen with 2 spaces.-withIndent :: Renderer () -> Renderer ()-withIndent gen = do-  indent-  gen-  dedent--instance Renderable ID where-  render (ID s) = write s- instance Renderable Attr where-  render (Attr i1 i2) = writeln $ printf "%s = %s;" (show i1) (show i2)+  render (Attr i1 i2) = writeln $ printf "%s = %s;" i1 i2  instance Renderable AttrList where   render = mapM_ render@@ -69,16 +27,16 @@  instance Renderable NodeID where   render (NodeID id' (Just port)) = do-    render id'+    write id'     write ":"     render port-  render (NodeID id' Nothing) = render id'+  render (NodeID id' Nothing) = write id'  instance Renderable Subgraph where   render (Subgraph id' []) =-    writeln $ printf "subgraph %s {}" (show id')+    writeln $ printf "subgraph %s {}" id'   render (Subgraph id' stmts) = do-    writeln $ printf "subgraph %s {" (show id')+    writeln $ printf "subgraph %s {" id'     withIndent $ render stmts     writeln "}" @@ -107,10 +65,10 @@  instance Renderable Stmt where   render (NodeStmt id' []) = do-    render id'+    write id'     writeln ""   render (NodeStmt id' attrs) = do-    render id'+    write id'     inBrackets $ render attrs   render (EdgeStmt expr []) = do     render expr@@ -125,9 +83,9 @@     render t     inBrackets $ render attrs   render (EqualsStmt i1 i2) = do-    render i1+    write i1     write " = "-    render i2+    write i2     writeln ";"   render (SubgraphStmt sg) = render sg @@ -136,13 +94,9 @@  instance Renderable Graph where   render (Digraph id' stmts) = do-    writeln $ printf "digraph %s {" (show id')+    writeln $ printf "digraph %s {" id'     withIndent $ render stmts     writeln "}" -renderString :: Renderer () -> String-renderString r =-  concat $ evalState (execWriterT r) (RendererState 0 False 0)- renderGraphviz :: Graph -> String-renderGraphviz = renderString . render+renderGraphviz = renderWithIndent . render

@@ -0,0 +1,15 @@+module DataFlow.PlantUML where++type ID = String+type Name = String++data Stmt = SkinParam String String+          | Box Name StmtList+          | Participant ID Name+          | Database ID Name+          | Entity ID Name+          | Edge ID ID String deriving (Show, Eq)++type StmtList = [Stmt]++data Diagram = SequenceDiagram StmtList deriving (Show, Eq)

@@ -0,0 +1,45 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}++module DataFlow.PlantUML.Renderer (+    renderPlantUML+  ) where++import Text.Printf+import DataFlow.PrettyRenderer+import DataFlow.PlantUML++class Renderable t where+  render :: t -> Renderer ()++instance Renderable Stmt where+  render (SkinParam name value) = do+    write "skinparam "+    write name+    write " "+    writeln value+  render (Box name stmts) = do+    writeln $ printf "box \"%s\"" name+    withIndent $ render stmts+    writeln "end box"+  render (Participant id' name) =+    writeln $ printf "participant \"%s\" as %s" name id'+  render (Database id' name) =+    writeln $ printf "database \"%s\" as %s" name id'+  render (Entity id' name) =+    writeln $ printf "entity \"%s\" as %s" name id'+  render (Edge i1 i2 description) =+    writeln $ printf "%s -> %s : %s" i1 i2 description+++instance Renderable StmtList where+  render = mapM_ render++instance Renderable Diagram where+  render (SequenceDiagram stmts) = do+    writeln "@startuml"+    render stmts+    writeln "@enduml"++renderPlantUML :: Diagram -> String+renderPlantUML = renderWithIndent . render

@@ -0,0 +1,46 @@+module DataFlow.PrettyRenderer where++import Control.Monad.State+import Control.Monad.Writer++type Indent = Int+type IndentNext = Bool+data RendererState = RendererState Indent IndentNext++-- | The Renderer represents some output generator that runs on a 'Diagram'.+type Renderer t = WriterT [String] (State RendererState) t++-- | Write a string to the output (no linefeed).+write :: String -> Renderer ()+write s = do+  (RendererState n indentNext) <- lift get+  if indentNext+    then tell [replicate n ' ' ++ s]+    else tell [s]+  put $ RendererState n False++-- | Write a string to the output (with linefeed).+writeln :: String -> Renderer ()+writeln s = do+  write s+  write "\n"+  modify $ \(RendererState n _) -> RendererState n True++-- | Increase indent with 2 spaces.+indent :: Renderer ()+indent = modify $ \(RendererState n indentNext) -> RendererState (n + 2) indentNext++-- | Decrease indent with 2 spaces.+dedent :: Renderer ()+dedent = modify $ \(RendererState n indentNext) -> RendererState (n - 2) indentNext++-- | Indent the output of gen with 2 spaces.+withIndent :: Renderer () -> Renderer ()+withIndent gen = do+  indent+  gen+  dedent++renderWithIndent :: Renderer () -> String+renderWithIndent r =+  concat $ evalState (execWriterT r) (RendererState 0 False)

@@ -0,0 +1,83 @@+module DataFlow.SequenceDiagram where++import Text.Printf+import qualified DataFlow.Core as C+import DataFlow.PlantUML+import Data.List.Utils++convertNewline :: String -> String+convertNewline = replace "<br/>" "\\n"++bold :: String -> String+bold "" = ""+bold s = printf "<b>%s</b>" s++italic :: String -> String+italic "" = ""+italic s =+  -- each line (separated by \n) needs to be wrapped in its own <i></i>+  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)+      s = case p of+            ("", "") -> ""+            ("", d) -> d+            (o, "") -> o+            (o, d) -> o ++ "\\n" ++ d+  in Edge i1 i2 s++defaultSkinParams :: [Stmt]+defaultSkinParams = [+    SkinParam "BackgroundColor" "#white",+    SkinParam "Shadowing" "false",+    SkinParam "SequenceMessageAlign" "center",+    SkinParam "DefaultFontName" "Arial",+    SkinParam "DefaultFontStyle" "bold",+    SkinParam "DefaultFontColor" "#333333",++    SkinParam "NoteBackgroundColor" "#fbfb77",+    SkinParam "NoteBorderColor" "#cbcb47",++    SkinParam "NoteBackgroundColor" "#ffffcd",+    SkinParam "NoteBorderColor" "#a9a980",+    SkinParam "NoteFontColor" "#676735",+    SkinParam "NoteFontStyle" "italic",++    SkinParam "SequenceArrowColor" "#555555",+    SkinParam "SequenceArrowFontColor" "#555555",+    SkinParam "SequenceArrowFontStyle" "none",++    SkinParam "SequenceBoxBackgroundColor" "#fafafa",+    SkinParam "SequenceBoxBorderColor" "#eeeeee",+    SkinParam "SequenceBoxFontColor" "#666666",+    SkinParam "SequenceBoxFontSize" "12",+    SkinParam "SequenceBoxFontStyle" "italic",++    SkinParam "ParticipantBackgroundColor" "#dde5ff",+    SkinParam "ParticipantBorderColor" "#cccccc",+    SkinParam "ParticipantFontColor" "#333333",+    SkinParam "ParticipantFontStyle" "bold",++    SkinParam "DatabaseBackgroundColor" "#df4646",+    SkinParam "DatabaseFontColor" "#red",+    SkinParam "DatabaseFontStyle" "bold",++    SkinParam "EntityBackgroundColor" "#999999",++    SkinParam "SequenceLifeLineBorderColor" "#bbbbbb"+  ]++asSequenceDiagram :: C.Diagram -> Diagram+asSequenceDiagram (C.Diagram _ objects) =+  SequenceDiagram $ defaultSkinParams ++ map convertObject objects