dataflow 0.4.2.0 → 0.5.0.0
raw patch · 16 files changed
+494/−413 lines, 16 filesdep +HUnitdep +dataflowdep +hspecdep ~base
Dependencies added: HUnit, dataflow, hspec
Dependency ranges changed: base
Files
- README.md +15/−12
- dataflow.cabal +20/−5
- example/example.hs +0/−23
- example/example.svg +0/−70
- example/legend.hs +0/−17
- example/legend.svg +0/−46
- examples/Makefile +13/−0
- examples/legend.hs +19/−0
- examples/legend.svg +52/−0
- examples/webapp.hs +24/−0
- examples/webapp.svg +71/−0
- src/DataFlow/Core.hs +2/−132
- src/DataFlow/DFD.hs +89/−108
- src/DataFlow/Graphviz.hs +40/−0
- src/DataFlow/Graphviz/Renderer.hs +148/−0
- test/Spec.hs +1/−0
README.md view
@@ -2,14 +2,17 @@ Generate Graphviz documents from a Haskell representation. +## Getting Started+ ```-cabal configure-cabal build+cabal sandbox init+cabal configure --enable-tests+cabal install --only-dependencies --enable-tests ``` ## Usage -+ The objects supported by DataFlow is: @@ -29,13 +32,14 @@ module Main where import DataFlow.Core+import DataFlow.Graphviz.Renderer import DataFlow.DFD main :: IO ()-main = printDfd $- Diagram "My Diagram" [+main = putStr $ renderGraphviz $ asDFD $+ Diagram (Just "Webapp") [ TrustBoundary "browser" "Browser" [- Function "webapp" "Webapp"+ Function "client" "Client" ], TrustBoundary "aws" "Amazon AWS" [ Function "server" "Web Server",@@ -43,11 +47,11 @@ ], InputOutput "analytics" "Google Analytics", - Flow "webapp" "server" "Request /" "",+ Flow "client" "server" "Request /" "", Flow "server" "logs" "Log" "User IP",- Flow "server" "webapp" "Response" "User Profile",+ Flow "server" "client" "Response" "User Profile", - Flow "webapp" "analytics" "Log" "Page Navigation"+ Flow "client" "analytics" "Log" "Page Navigation" ] ``` @@ -59,13 +63,12 @@ That should generate something like the following. -+ ## Building the Examples ```bash-cabal install-make -C example+make -C examples ``` ## Release
dataflow.cabal view
@@ -1,5 +1,5 @@ name: dataflow-version: 0.4.2.0+version: 0.5.0.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@@ -17,10 +17,11 @@ build-type: Simple extra-source-files: README.md, LICENSE,- example/example.hs,- example/example.svg,- example/legend.hs,- example/legend.svg+ examples/webapp.hs,+ examples/webapp.svg,+ examples/legend.hs,+ examples/legend.svg,+ examples/Makefile cabal-version: >=1.10 source-repository head@@ -30,6 +31,8 @@ library exposed-modules: DataFlow.Core,+ DataFlow.Graphviz,+ DataFlow.Graphviz.Renderer, DataFlow.DFD build-depends: base >=4 && <4.8,@@ -37,3 +40,15 @@ containers >= 0.4 hs-source-dirs: src default-language: Haskell2010++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ default-language: Haskell98+ hs-source-dirs: test+ build-depends:+ base,+ HUnit,+ hspec == 2.*,+ dataflow+ ghc-options: -Wall
− example/example.hs
@@ -1,23 +0,0 @@-module Main where--import DataFlow.Core-import DataFlow.DFD--main :: IO ()-main = printDfd $- Diagram "My Diagram" [- TrustBoundary "browser" "Browser" [- Function "webapp" "Webapp"- ],- TrustBoundary "aws" "Amazon AWS" [- Function "server" "Web Server",- Database "logs" "Logs"- ],- InputOutput "analytics" "Google Analytics",-- Flow "webapp" "server" "Request /" "",- Flow "server" "logs" "Log" "User IP",- Flow "server" "webapp" "Response" "User Profile",-- Flow "webapp" "analytics" "Log" "Page Navigation"- ]
− example/example.svg
@@ -1,70 +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: My Diagram Pages: 1 -->-<svg width="502pt" height="382pt"- viewBox="0.00 0.00 502.14 382.14" 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 378.145)">-<title>My Diagram</title>-<polygon fill="white" stroke="none" points="-4,4 -4,-378.145 498.137,-378.145 498.137,4 -4,4"/>-<text text-anchor="start" x="193.172" y="-355.145" font-family="sans-serif" font-weight="bold" font-size="20.00">My Diagram</text>-<g id="clust2" class="cluster"><title>cluster_aws</title>-<polygon fill="none" stroke="#4d4d4d" stroke-dasharray="5,2" points="221.346,-190.145 221.346,-338.145 486.137,-338.145 486.137,-190.145 221.346,-190.145"/>-<text text-anchor="start" x="323.078" y="-326.145" font-family="sans-serif" font-size="10.00" fill="#4d4d4d">Amazon AWS</text>-</g>-<g id="clust1" class="cluster"><title>cluster_browser</title>-<polygon fill="none" stroke="#4d4d4d" stroke-dasharray="5,2" points="8,-110.145 8,-230.145 109.78,-230.145 109.78,-110.145 8,-110.145"/>-<text text-anchor="start" x="40.5524" y="-218.145" font-family="sans-serif" font-size="10.00" fill="#4d4d4d">Browser</text>-</g>-<!-- webapp -->-<g id="node1" class="node"><title>webapp</title>-<ellipse fill="none" stroke="black" cx="58.8898" cy="-161.145" rx="42.7799" ry="42.7799"/>-<text text-anchor="start" x="32.9406" y="-157.945" font-family="sans-serif" font-weight="bold" font-size="14.00">Webapp</text>-</g>-<!-- server -->-<g id="node2" class="node"><title>server</title>-<ellipse fill="none" stroke="black" cx="285.985" cy="-255.145" rx="56.7776" ry="56.7776"/>-<text text-anchor="start" x="249.153" y="-251.945" font-family="sans-serif" font-weight="bold" font-size="14.00">Web Server</text>-</g>-<!-- webapp->server -->-<g id="edge1" class="edge"><title>webapp->server</title>-<path fill="none" stroke="black" d="M98.8414,-177.411C133.323,-191.81 184.216,-213.063 224.076,-229.709"/>-<polygon fill="black" stroke="black" points="222.86,-232.994 233.436,-233.618 225.557,-226.534 222.86,-232.994"/>-<text text-anchor="start" x="129.128" y="-225.545" font-family="sans-serif" font-weight="bold" font-size="12.00">(1) Request /</text>-</g>-<!-- analytics -->-<g id="node4" class="node"><title>analytics</title>-<polygon fill="none" stroke="black" stroke-width="2" points="346.274,-120.434 225.695,-120.434 225.695,0.144879 346.274,0.144879 346.274,-120.434"/>-<text text-anchor="start" x="233.84" y="-56.9445" font-family="sans-serif" font-weight="bold" font-size="14.00">Google Analytics</text>-</g>-<!-- webapp->analytics -->-<g id="edge4" class="edge"><title>webapp->analytics</title>-<path fill="none" stroke="black" d="M84.2655,-126.418C94.0477,-114.842 106.228,-102.928 119.78,-95.1445 148.674,-78.5496 184.474,-69.7911 215.353,-65.1818"/>-<polygon fill="black" stroke="black" points="216.188,-68.6001 225.619,-63.7724 215.236,-61.6651 216.188,-68.6001"/>-<text text-anchor="start" x="144.799" y="-110.545" font-family="sans-serif" font-weight="bold" font-size="12.00">(4) Log</text>-<text text-anchor="start" x="119.78" y="-98.5445" font-family="sans-serif" font-size="12.00">Page Navigation</text>-</g>-<!-- server->webapp -->-<g id="edge3" class="edge"><title>server->webapp</title>-<path fill="none" stroke="black" d="M256.434,-206.502C240.39,-181.104 221.004,-153.919 207.84,-147.145 177.542,-131.553 139.128,-135.775 109.036,-143.516"/>-<polygon fill="black" stroke="black" points="107.874,-140.206 99.1738,-146.253 109.746,-146.952 107.874,-140.206"/>-<text text-anchor="start" x="127.792" y="-162.545" font-family="sans-serif" font-weight="bold" font-size="12.00">(3) Response</text>-<text text-anchor="start" x="132.468" y="-150.545" font-family="sans-serif" font-size="12.00">User Profile</text>-</g>-<!-- logs -->-<g id="node3" class="node"><title>logs</title>-<text text-anchor="start" x="434.958" y="-266.945" font-family="sans-serif" font-weight="bold" font-size="14.00">Logs</text>-<polyline fill="none" stroke="black" points="430.137,-258.145 470.137,-258.145 "/>-<polyline fill="none" stroke="black" points="470.137,-282.145 430.137,-282.145 "/>-</g>-<!-- server->logs -->-<g id="edge2" class="edge"><title>server->logs</title>-<path fill="none" stroke="black" d="M342.788,-260.307C365.568,-262.414 391.305,-264.795 411.754,-266.686"/>-<polygon fill="black" stroke="black" points="411.642,-270.191 421.922,-267.627 412.287,-263.221 411.642,-270.191"/>-<text text-anchor="start" x="365.122" y="-280.545" font-family="sans-serif" font-weight="bold" font-size="12.00">(2) Log</text>-<text text-anchor="start" x="364.129" y="-268.545" font-family="sans-serif" font-size="12.00">User IP</text>-</g>-</g>-</svg>
− example/legend.hs
@@ -1,17 +0,0 @@-module Main where--import DataFlow.Core-import DataFlow.DFD--main :: IO ()-main = printDfd $- Diagram "Legend" [- TrustBoundary "trust" "TrustBoundary" [- Function "function" "Function",- Database "database" "Database",- InputOutput "io" "InputOutput"- ],- Flow "function" "io" "Flow" "",- Flow "function" "database" "Flow" ""- ]-
− example/legend.svg
@@ -1,46 +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: Legend Pages: 1 -->-<svg width="297pt" height="284pt"- viewBox="0.00 0.00 296.55 284.00" 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 280)">-<title>Legend</title>-<polygon fill="white" stroke="none" points="-4,4 -4,-280 292.552,-280 292.552,4 -4,4"/>-<text text-anchor="start" x="110.907" y="-257" font-family="sans-serif" font-weight="bold" font-size="20.00">Legend</text>-<g id="clust1" class="cluster"><title>cluster_trust</title>-<polygon fill="none" stroke="#4d4d4d" stroke-dasharray="5,2" points="8,-8 8,-240 280.552,-240 280.552,-8 8,-8"/>-<text text-anchor="start" x="111.666" y="-228" font-family="sans-serif" font-size="10.00" fill="#4d4d4d">TrustBoundary</text>-</g>-<!-- function -->-<g id="node1" class="node"><title>function</title>-<ellipse fill="none" stroke="black" cx="60.0255" cy="-129" rx="44.051" ry="44.051"/>-<text text-anchor="start" x="33.1773" y="-125.8" font-family="sans-serif" font-weight="bold" font-size="14.00">Function</text>-</g>-<!-- database -->-<g id="node2" class="node"><title>database</title>-<text text-anchor="start" x="198.504" y="-30.8" font-family="sans-serif" font-weight="bold" font-size="14.00">Database</text>-<polyline fill="none" stroke="black" points="193.469,-22 262.469,-22 "/>-<polyline fill="none" stroke="black" points="262.469,-46 193.469,-46 "/>-</g>-<!-- function->database -->-<g id="edge2" class="edge"><title>function->database</title>-<path fill="none" stroke="black" d="M98.6807,-107.443C124.884,-92.4419 159.787,-72.4609 186.571,-57.1275"/>-<polygon fill="black" stroke="black" points="188.379,-60.1253 195.319,-52.1195 184.901,-54.0504 188.379,-60.1253"/>-<text text-anchor="start" x="122.051" y="-96.4" font-family="sans-serif" font-weight="bold" font-size="12.00">(2) Flow</text>-</g>-<!-- io -->-<g id="node3" class="node"><title>io</title>-<polygon fill="none" stroke="black" stroke-width="2" points="272.635,-213.665 183.304,-213.665 183.304,-124.335 272.635,-124.335 272.635,-213.665"/>-<text text-anchor="start" x="191.387" y="-165.8" font-family="sans-serif" font-weight="bold" font-size="14.00">InputOutput</text>-</g>-<!-- function->io -->-<g id="edge1" class="edge"><title>function->io</title>-<path fill="none" stroke="black" d="M102.9,-139.094C124.311,-144.255 150.608,-150.593 173.472,-156.105"/>-<polygon fill="black" stroke="black" points="172.828,-159.55 183.37,-158.49 174.468,-152.745 172.828,-159.55"/>-<text text-anchor="start" x="122.051" y="-157.4" font-family="sans-serif" font-weight="bold" font-size="12.00">(1) Flow</text>-</g>-</g>-</svg>
+ examples/Makefile view
@@ -0,0 +1,13 @@+SOURCES=$(shell find *.hs)+TARGETS=$(SOURCES:%.hs=%.svg)++%.svg: %.hs+ @echo "$< -> $@"+ @runhaskell -i../src $< | dot -Tsvg > $@++svg: $(TARGETS)++clean:+ rm -f $(TARGETS)++all: svg
+ examples/legend.hs view
@@ -0,0 +1,19 @@+module Main where++import DataFlow.Core+import DataFlow.Graphviz.Renderer+import DataFlow.DFD++main :: IO ()+main = putStr $ renderGraphviz $ asDFD $+ Diagram Nothing [+ TrustBoundary "trust" "TrustBoundary" [+ Function "function" "Function",+ Database "database" "Database",+ InputOutput "io" "InputOutput"+ ],+ Flow "function" "io" "Flow" "",+ Flow "io" "function" "Flow" "(backwards)",+ Flow "function" "database" "Flow" ""+ ]+
+ examples/legend.svg view
@@ -0,0 +1,52 @@+<?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: Untitled Pages: 1 -->+<svg width="370pt" height="300pt"+ viewBox="0.00 0.00 370.00 300.48" 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 296.481)">+<title>Untitled</title>+<polygon fill="white" stroke="none" points="-4,4 -4,-296.481 366,-296.481 366,4 -4,4"/>+<g id="clust1" class="cluster"><title>cluster_trust</title>+<polygon fill="none" stroke="#595959" stroke-dasharray="5,2" points="8,-8 8,-284.481 354,-284.481 354,-8 8,-8"/>+<text text-anchor="start" x="148.393" y="-273.481" font-family="Arial" font-style="italic" font-size="10.00" fill="#595959">TrustBoundary</text>+</g>+<!-- function -->+<g id="node1" class="node"><title>function</title>+<ellipse fill="none" stroke="black" cx="190" cy="-210.074" rx="46.8172" ry="46.8172"/>+<text text-anchor="start" x="163.152" y="-207.923" font-family="Arial" font-weight="bold" font-size="14.00">Function</text>+</g>+<!-- database -->+<g id="node2" class="node"><title>database</title>+<text text-anchor="start" x="58.5347" y="-58.3825" font-family="Arial" font-weight="bold" font-size="14.00">Database</text>+<polyline fill="none" stroke="black" points="53.5,-47.5825 122.5,-47.5825 "/>+<polyline fill="none" stroke="black" points="122.5,-73.5825 53.5,-73.5825 "/>+</g>+<!-- function->database -->+<g id="edge3" class="edge"><title>function->database</title>+<path fill="none" stroke="black" d="M156.061,-177.629C146.51,-167.788 136.58,-156.519 128.664,-145.165 116.243,-127.349 105.643,-105.165 98.3825,-88.129"/>+<polygon fill="black" stroke="black" points="101.565,-86.6655 94.5049,-78.7656 95.0974,-89.3438 101.565,-86.6655"/>+<text text-anchor="start" x="129" y="-132.464" font-family="Arial" font-weight="bold" font-size="12.00">Flow</text>+</g>+<!-- io -->+<g id="node3" class="node"><title>io</title>+<polygon fill="none" stroke="black" stroke-width="2" points="313.665,-105.248 224.335,-105.248 224.335,-15.9173 313.665,-15.9173 313.665,-105.248"/>+<text text-anchor="start" x="232.417" y="-58.4318" font-family="Arial" font-weight="bold" font-size="14.00">InputOutput</text>+</g>+<!-- function->io -->+<g id="edge1" class="edge"><title>function->io</title>+<path fill="none" stroke="black" d="M173.056,-166.198C170.005,-151.853 169.686,-136.207 176.664,-123.165 185.251,-107.116 200.073,-94.5268 215.359,-85.0284"/>+<polygon fill="black" stroke="black" points="217.483,-87.8421 224.369,-79.7904 213.965,-81.7904 217.483,-87.8421"/>+<text text-anchor="start" x="177" y="-132.464" font-family="Arial" font-weight="bold" font-size="12.00">Flow</text>+</g>+<!-- function->io -->+<g id="edge2" class="edge"><title>function->io</title>+<path fill="none" stroke="black" d="M216.6,-159.412C226.002,-141.858 236.5,-122.259 245.616,-105.241"/>+<polygon fill="black" stroke="black" points="213.433,-157.913 211.796,-168.381 219.603,-161.218 213.433,-157.913"/>+<text text-anchor="start" x="248.561" y="-136.565" font-family="Arial" font-weight="bold" font-size="12.00">Flow</text>+<text text-anchor="start" x="234" y="-126.165" font-family="Arial" font-size="10.00">(backwards)</text>+</g>+</g>+</svg>
+ examples/webapp.hs view
@@ -0,0 +1,24 @@+module Main where++import DataFlow.Core+import DataFlow.Graphviz.Renderer+import DataFlow.DFD++main :: IO ()+main = putStr $ renderGraphviz $ asDFD $+ Diagram (Just "Webapp") [+ TrustBoundary "browser" "Browser" [+ Function "client" "Client"+ ],+ TrustBoundary "aws" "Amazon AWS" [+ Function "server" "Web Server",+ Database "logs" "Logs"+ ],+ InputOutput "analytics" "Google<br/>Analytics",++ Flow "client" "server" "Request /" "",+ Flow "server" "logs" "Log" "User IP",+ Flow "server" "client" "Response" "User Profile",++ Flow "client" "analytics" "Log" "Page Navigation"+ ]
+ examples/webapp.svg view
@@ -0,0 +1,71 @@+<?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="333pt" height="450pt"+ viewBox="0.00 0.00 333.01 450.40" 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 446.4)">+<title>Webapp</title>+<polygon fill="white" stroke="none" points="-4,4 -4,-446.4 329.01,-446.4 329.01,4 -4,4"/>+<text text-anchor="start" x="125.44" y="-423.4" 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="115,-298.185 115,-403.402 201,-403.402 201,-298.185 115,-298.185"/>+<text text-anchor="start" x="139.663" y="-392.402" font-family="Arial" font-style="italic" font-size="10.00" fill="#595959">Browser</text>+</g>+<g id="clust2" class="cluster"><title>cluster_aws</title>+<polygon fill="none" stroke="#595959" stroke-dasharray="5,2" points="8,-8 8,-258.185 144,-258.185 144,-8 8,-8"/>+<text text-anchor="start" x="45.3408" y="-247.185" 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="158" cy="-341.044" rx="34.7182" ry="34.7182"/>+<text text-anchor="start" x="140.104" y="-338.893" font-family="Arial" 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="76" cy="-170.343" rx="60.1865" ry="60.1865"/>+<text text-anchor="start" x="39.1714" y="-168.192" font-family="Arial" font-weight="bold" font-size="14.00">Web Server</text>+</g>+<!-- client->server -->+<g id="edge1" class="edge"><title>client->server</title>+<path fill="none" stroke="black" d="M123.059,-338.065C89.5097,-334.089 40.5091,-322.371 16.6367,-288.185 2.08217,-267.343 11.5388,-242.438 26.8205,-220.986"/>+<polygon fill="black" stroke="black" points="29.6634,-223.03 32.9246,-212.949 24.0889,-218.796 29.6634,-223.03"/>+<text text-anchor="start" x="17" y="-275.484" font-family="Arial" font-weight="bold" font-size="12.00">Request /</text>+</g>+<!-- client->server -->+<g id="edge3" class="edge"><title>client->server</title>+<path fill="none" stroke="black" d="M138.654,-300.242C127.716,-277.74 113.896,-249.306 102.019,-224.873"/>+<polygon fill="black" stroke="black" points="135.631,-302.03 143.15,-309.493 141.927,-298.97 135.631,-302.03"/>+<text text-anchor="start" x="132" y="-279.585" font-family="Arial" font-weight="bold" font-size="12.00">Response</text>+<text text-anchor="start" x="132.899" y="-269.185" font-family="Arial" font-size="10.00">User Profile</text>+</g>+<!-- analytics -->+<g id="node4" class="node"><title>analytics</title>+<polygon fill="none" stroke="black" stroke-width="2" points="325.021,-206.364 252.979,-206.364 252.979,-134.323 325.021,-134.323 325.021,-206.364"/>+<text text-anchor="start" x="266.428" y="-174.143" font-family="Arial" font-weight="bold" font-size="14.00">Google</text>+<text text-anchor="start" x="260.99" y="-160.143" font-family="Arial" font-weight="bold" font-size="14.00">Analytics</text>+</g>+<!-- client->analytics -->+<g id="edge4" class="edge"><title>client->analytics</title>+<path fill="none" stroke="black" d="M181.196,-314.881C188.653,-306.533 196.835,-297.095 204,-288.185 223.027,-264.524 243.063,-237.118 258.9,-214.798"/>+<polygon fill="black" stroke="black" points="261.843,-216.698 264.754,-206.51 256.126,-212.659 261.843,-216.698"/>+<text text-anchor="start" x="248.681" y="-279.585" font-family="Arial" font-weight="bold" font-size="12.00">Log</text>+<text text-anchor="start" x="222" y="-269.185" font-family="Arial" font-size="10.00">Page Navigation</text>+</g>+<!-- logs -->+<g id="node3" class="node"><title>logs</title>+<text text-anchor="start" x="72.8208" y="-31.8" font-family="Arial" font-weight="bold" font-size="14.00">Logs</text>+<polyline fill="none" stroke="black" points="68,-21 108,-21 "/>+<polyline fill="none" stroke="black" points="108,-47 68,-47 "/>+</g>+<!-- server->logs -->+<g id="edge2" class="edge"><title>server->logs</title>+<path fill="none" stroke="black" d="M81.2983,-110.027C82.7846,-93.3881 84.3291,-76.0972 85.5602,-62.3138"/>+<polygon fill="black" stroke="black" points="89.0697,-62.3631 86.4733,-52.0913 82.0974,-61.7403 89.0697,-62.3631"/>+<text text-anchor="start" x="91.6592" y="-83.4" font-family="Arial" font-weight="bold" font-size="12.00">Log</text>+<text text-anchor="start" x="85" y="-73" font-family="Arial" font-size="10.00">User IP</text>+</g>+</g>+</svg>
src/DataFlow/Core.hs view
@@ -4,30 +4,9 @@ Operation, Description, Diagram(..),- Object(..),- Renderer,- evalDiagram,- write,- writeln,- nextStep,- indent,- dedent,- withIndent,- blank,- label,- tag,- bold,- table,- tr,- td,- Enclosing(..),- objectWith,- attrs+ Object(..) ) where -import Control.Monad.State-import Control.Monad.Writer- -- | An identifier corresponding to those in Graphviz. type ID = String -- | The name of a 'Diagram' or 'Object'.@@ -38,7 +17,7 @@ type Description = String -- | The top level diagram.-data Diagram = Diagram Name [Object]+data Diagram = Diagram (Maybe Name) [Object] -- | An object in a diagram. data Object =@@ -52,112 +31,3 @@ | Database ID Name -- | Describes the flow of data between two objects. | Flow ID ID Operation Description deriving (Show, Eq)--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---- | Run the 'Renderer' and get the output as a 'String'.-evalDiagram :: Renderer () -> String-evalDiagram g = concat $ evalState (execWriterT g) (RendererState 0 False 0)---- | 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'--incrStep :: Renderer ()-incrStep = modify $ \(RendererState n indentNext s') -> RendererState n indentNext (s' + 1)---- | Get the next \"step\" number (the order of flow arrows in the diagram).-nextStep :: Renderer Int-nextStep = do- incrStep- (RendererState _ _ s) <- lift get- return 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---- | Write a blank line.-blank :: Renderer ()-blank = tell [""]---- | Write a label with the output of gen as its contents.-label :: Renderer () -> Renderer ()-label contents = do- write "label = <"- contents- writeln ">;"---- | Write an HTML tag t with the output of gen as its contents.-tag :: String -> String -> Renderer () -> Renderer ()-tag t a contents = do- write $ "<" ++ t ++ (if null a then "" else " " ++ a) ++ ">"- contents- write $ "</" ++ t ++ ">"---- | Write a \<b\> tag surrounding the output of another 'Renderer'.-bold :: Renderer () -> Renderer ()-bold = tag "b" ""---- | Write a \<table\> tag, with attributes, surrounding the output of--- another 'Renderer'.-table :: String -> Renderer () -> Renderer ()-table = tag "table"---- | Write a \<tr\> tag surrounding the output of another 'Renderer'.-tr :: Renderer () -> Renderer ()-tr = tag "tr" ""---- | Write a \<td\> tag surrounding the output of another 'Renderer'.-td :: Renderer () -> Renderer ()-td = tag "td" ""---- | The enclosing characters in a block.-data Enclosing = Brackets | CurlyBrackets---- | Write an object with the given 'Enclosing' characters, 'ID' and 'Renderer' as--- its contents.-objectWith :: Enclosing -> ID -> Renderer () -> Renderer ()-objectWith enc id' attributes =- do- blank- writeln $ id' ++ " " ++ before enc- withIndent attributes- writeln $ after enc- where before Brackets = "["- before CurlyBrackets = "{"- after Brackets = "]"- after CurlyBrackets = "}"---- | Write an attributes declaration for the given 'ID'.-attrs :: ID -> String -> Renderer ()-attrs id' = objectWith Brackets id' . writeln
src/DataFlow/DFD.hs view
@@ -1,124 +1,105 @@ module DataFlow.DFD where -import Control.Monad.Identity-import Control.Monad.State-import Data.Map (Map)-import qualified Data.Map as Map-import DataFlow.Core--type DFDState v = State (Map (ID, ID) Bool) v-type DFDRenderer t = DFDState (Renderer t)---- | Type class for types that can be rendered as DFD.-class RenderDFD t where- dfd :: t -> DFDRenderer ()--return' :: t -> DFDRenderer t-return' v = return . lift . return $ v--exists :: (ID, ID) -> DFDState Bool-exists k = do- m <- get- return $ case Map.lookup k m of- (Just _) -> True- _ -> False+import Text.Printf+import qualified DataFlow.Core as C+import DataFlow.Graphviz+import DataFlow.Graphviz.EdgeNormalization -register :: (ID, ID) -> DFDState ()-register k = do- m <- get- put $ Map.insert k True m- return ()+inQuotes :: String -> String+inQuotes s = "\"" ++ s ++ "\"" -shouldInvert :: (ID, ID) -> DFDState Bool-shouldInvert k@(i1, i2) = do- e <- exists k- if e- then return False- else do- ie <- exists (i2, i1)- if ie- then return True- else do- register k- return False+inAngleBrackets :: String -> String+inAngleBrackets s = "<" ++ s ++ ">" -instance RenderDFD Object where- dfd (InputOutput id' name) =- return $ objectWith Brackets id' $ do- writeln "shape = square;"- writeln "style = bold;"- label $ bold $ write name+label :: String -> Attr+label s = Attr (ID "label") (ID $ inAngleBrackets s) - dfd (TrustBoundary id' name objects) = do- renderObjects <- mapM dfd objects- return $ do- blank- writeln $ "subgraph cluster_" ++ id' ++ " {"- withIndent $ do- blank- sequence_ renderObjects- writeln "fontsize = 10;"- writeln "fontcolor = grey30;"- label $ write name- writeln "graph[style = dashed, color=grey30];"- writeln "}"+bold :: String -> String+bold s = "<b>" ++ s ++ "</b>" - dfd (Function id' name) = return $ objectWith Brackets id' $ do- writeln "shape = circle;"- label $ bold $ write name+italic :: String -> String+italic s = "<i>" ++ s ++ "</i>" - dfd (Database id' name) = return $ objectWith Brackets id' $ do- label $- table "sides=\"TB\" cellborder=\"0\"" $- tr $- td $- bold $ write name- writeln "shape = none;"+convertObject :: C.Object -> StmtList - dfd (Flow i1 i2 operation description)= do- back <- shouldInvert (i1, i2)- return $ do- step <- nextStep- blank- if back- then writeln $ i2 ++ " -> " ++ i1 ++ " ["- else writeln $ i1 ++ " -> " ++ i2 ++ " ["- withIndent $ do- when back $- writeln "dir = back;"- label $ do- bold $ write $ "(" ++ show step ++ ") " ++ operation- write "<br/>"- write description- writeln "]"+convertObject (C.InputOutput id' name) = [+ NodeStmt (ID id') [+ Attr (ID "shape") (ID "square"),+ Attr (ID "style") (ID "bold"),+ label $ bold name+ ]+ ] -instance RenderDFD Diagram where- dfd (Diagram title objects) =- do- renderObjects <- mapM dfd objects- return $ do- writeln $ "digraph \"" ++ title ++ "\" {"- withIndent $ do- attrs "graph" "fontname=\"sans-serif\""- attrs "node" "fontname=\"sans-serif\""- attrs "edge" "fontname=\"sans-serif\", fontsize=12"- blank+convertObject (C.TrustBoundary id' name objects) =+ let sgId = (ID $ "cluster_" ++ id')+ objectStmts = convertObjects objects+ sgAttrStmt = AttrStmt Graph [+ Attr (ID "fontsize") (ID "10"),+ Attr (ID "fontcolor") (ID "grey35"),+ Attr (ID "style") (ID "dashed"),+ Attr (ID "color") (ID "grey35"),+ label $ italic name+ ]+ stmts = sgAttrStmt : objectStmts+ in [SubgraphStmt $ Subgraph sgId stmts] - writeln "labelloc = \"t\";"- label $ bold $ write title- writeln "fontsize = 20;"+convertObject (C.Function id' name) =+ [+ NodeStmt (ID id') [+ Attr (ID "shape") (ID "circle"),+ label $ bold name+ ]+ ] - writeln "nodesep = 1;"- writeln "rankdir = LR;"+convertObject (C.Database id' name) =+ [+ NodeStmt (ID id') [+ Attr (ID "shape") (ID "none"),+ label $ printf "<table sides=\"TB\" cellborder=\"0\"><tr><td>%s</td></tr></table>" (bold name)+ ]+ ] - sequence_ renderObjects+convertObject (C.Flow i1 i2 op desc) =+ [+ EdgeStmt (EdgeExpr (IDOperand (NodeID (ID i1) Nothing))+ Arrow+ (IDOperand (NodeID (ID i2) Nothing))) [+ label $+ let d = if null desc then ""+ else "<font point-size=\"10\">" ++ desc ++ "</font>"+ in bold op ++ "<br/>" ++ d+ ]+ ] - writeln "}"+convertObjects :: [C.Object] -> StmtList+convertObjects = concatMap convertObject --- | Generates the DFD output as a String.-evalDfd :: Diagram -> String-evalDfd d = evalDiagram (evalState (dfd d) Map.empty)+defaultGraphStmts :: StmtList+defaultGraphStmts = [+ AttrStmt Graph [+ Attr (ID "fontname") (ID "Arial"),+ Attr (ID "fontsize") (ID "14")+ ],+ AttrStmt Node [+ Attr (ID "fontname") (ID "Arial"),+ Attr (ID "fontsize") (ID "14")+ ],+ AttrStmt Edge [+ Attr (ID "shape") (ID "none"),+ Attr (ID "fontname") (ID "Arial"),+ Attr (ID "fontsize") (ID "12")+ ],+ EqualsStmt (ID "labelloc") (ID $ inQuotes "t"),+ EqualsStmt (ID "fontsize") (ID "20"),+ EqualsStmt (ID "nodesep") (ID "1"),+ EqualsStmt (ID "rankdir") (ID "t")+ ] --- | Prints the DFD output to stdout.-printDfd :: Diagram -> IO ()-printDfd = putStr . evalDfd+asDFD :: C.Diagram -> Graph+asDFD (C.Diagram (Just name) objects) =+ normalize $ Digraph (ID $ inQuotes name) $+ let lbl = EqualsStmt (ID "label") (ID $ inAngleBrackets $ bold name)+ in lbl : defaultGraphStmts ++ convertObjects objects+asDFD (C.Diagram Nothing objects) =+ normalize $ Digraph (ID "Untitled") $+ defaultGraphStmts ++ convertObjects objects
+ src/DataFlow/Graphviz.hs view
@@ -0,0 +1,40 @@+-- | DataFlow.Graphviz provides a model corresponding to the Graphviz language+-- described at http://www.graphviz.org/content/dot-language. All features+-- 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++data Attr = Attr ID ID deriving (Show, Eq)+type AttrList = [Attr]++data Compass = N | NE | E | SE | S | SW | W | NW | C deriving (Show, Eq, Ord)++data Port = Port (Maybe ID) Compass deriving (Show, Eq, Ord)++data NodeID = NodeID ID (Maybe Port) deriving (Show, Eq, Ord)++data Subgraph = Subgraph ID StmtList deriving (Show, Eq)++data EdgeOperator = Arrow | Line deriving (Show, Eq)++data EdgeOperand = IDOperand NodeID+ | SubgraphOperand Subgraph deriving (Show, Eq)++data EdgeExpr = EdgeExpr EdgeOperand EdgeOperator EdgeOperand deriving (Show, Eq)++data AttrStmtType = Graph | Node | Edge deriving (Show, Eq)++data Stmt = NodeStmt ID AttrList+ | EdgeStmt EdgeExpr AttrList+ | AttrStmt AttrStmtType AttrList+ | EqualsStmt ID ID+ | SubgraphStmt Subgraph deriving (Show, Eq)++type StmtList = [Stmt]++-- TODO: Support undirected graph+data Graph = Digraph ID StmtList deriving (Show, Eq)
+ src/DataFlow/Graphviz/Renderer.hs view
@@ -0,0 +1,148 @@+{-# LANGUAGE FlexibleInstances #-}++module DataFlow.Graphviz.Renderer (+ renderGraphviz+ ) where++import Control.Monad.State+import Control.Monad.Writer+import Data.Char+import Text.Printf+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)++instance Renderable AttrList where+ render = mapM_ render++instance Renderable Port where+ render (Port (Just id') c) =+ write $ printf "%s:%s" (show id') (map toLower $ show c)+ render (Port Nothing c) =+ write $ map toLower $ show c++instance Renderable NodeID where+ render (NodeID id' (Just port)) = do+ render id'+ write ":"+ render port+ render (NodeID id' Nothing) = render id'++instance Renderable Subgraph where+ render (Subgraph id' []) =+ writeln $ printf "subgraph %s {}" (show id')+ render (Subgraph id' stmts) = do+ writeln $ printf "subgraph %s {" (show id')+ withIndent $ render stmts+ writeln "}"++instance Renderable EdgeOperator where+ render Arrow = write " -> "+ render Line = write " -- "++instance Renderable EdgeOperand where+ render (IDOperand nodeId) = render nodeId+ render (SubgraphOperand sg) = render sg++instance Renderable EdgeExpr where+ render (EdgeExpr o1 operator o2) = do+ render o1+ render operator+ render o2++instance Renderable AttrStmtType where+ render = write . map toLower . show++inBrackets :: Renderer () -> Renderer ()+inBrackets r = do+ writeln " ["+ withIndent r+ writeln "]"++instance Renderable Stmt where+ render (NodeStmt id' []) = do+ render id'+ writeln ""+ render (NodeStmt id' attrs) = do+ render id'+ inBrackets $ render attrs+ render (EdgeStmt expr []) = do+ render expr+ writeln ";"+ render (EdgeStmt expr attrs) = do+ render expr+ inBrackets $ render attrs+ render (AttrStmt t []) = do+ render t+ writeln " []"+ render (AttrStmt t attrs) = do+ render t+ inBrackets $ render attrs+ render (EqualsStmt i1 i2) = do+ render i1+ write " = "+ render i2+ writeln ";"+ render (SubgraphStmt sg) = render sg++instance Renderable StmtList where+ render = mapM_ render++instance Renderable Graph where+ render (Digraph id' stmts) = do+ writeln $ printf "digraph %s {" (show id')+ withIndent $ render stmts+ writeln "}"++renderString :: Renderer () -> String+renderString r =+ concat $ evalState (execWriterT r) (RendererState 0 False 0)++renderGraphviz :: Graph -> String+renderGraphviz = renderString . render
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}