diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,68 @@
+# DataFlow
+
+Generate Graphviz documents from a Haskell representation.
+
+```
+cabal configure
+cabal build
+```
+
+## Usage
+
+
+
+The objects supported by DataFlow is:
+
+* `TrustBoundary`
+* `InputOutput`
+* `Function`
+* `Flow`
+
+These are composed in a `Diagram` to get something printable.
+
+For more information see the [Hackage site](https://hackage.haskell.org/package/dataflow).
+
+## Example
+
+```haskell
+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"
+ ]
+```
+
+Then generate your output with dot.
+
+```bash
+runhaskell example.hs | dot -Tsvg > example.svg
+```
+
+That should generate something like the following.
+
+
+
+## Building the Examples
+
+```bash
+cabal install
+make -C example
+```
diff --git a/dataflow.cabal b/dataflow.cabal
--- a/dataflow.cabal
+++ b/dataflow.cabal
@@ -1,16 +1,31 @@
name: dataflow
-version: 0.3.2.0
+version: 0.4.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 format.
+ 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
license-file: LICENSE
author: Oskar Wickström
-maintainer: oskar.wickstrom@live.com
--- copyright:
+maintainer: oskar.wickstrom@gmail.com
+copyright: oskar.wickstrom@gmail.com
+category: Code Generation, Compiler, Graphs
+
build-type: Simple
--- extra-source-files:
+extra-source-files: README.md,
+ LICENSE,
+ example/example.hs,
+ example/example.svg,
+ example/legend.hs,
+ example/legend.svg
cabal-version: >=1.10
+
+source-repository head
+ type: git
+ location: git@github.com:owickstrom/dataflow.git
library
exposed-modules:
diff --git a/example/example.hs b/example/example.hs
new file mode 100644
--- /dev/null
+++ b/example/example.hs
@@ -0,0 +1,23 @@
+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"
+ ]
diff --git a/example/example.svg b/example/example.svg
new file mode 100644
--- /dev/null
+++ b/example/example.svg
@@ -0,0 +1,70 @@
+
+
+
+
+
diff --git a/example/legend.hs b/example/legend.hs
new file mode 100644
--- /dev/null
+++ b/example/legend.hs
@@ -0,0 +1,17 @@
+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" ""
+ ]
+
diff --git a/example/legend.svg b/example/legend.svg
new file mode 100644
--- /dev/null
+++ b/example/legend.svg
@@ -0,0 +1,46 @@
+
+
+
+
+
diff --git a/src/DataFlow/Core.hs b/src/DataFlow/Core.hs
--- a/src/DataFlow/Core.hs
+++ b/src/DataFlow/Core.hs
@@ -1,31 +1,71 @@
-module DataFlow.Core where
+module DataFlow.Core (
+ ID,
+ Name,
+ Operation,
+ Description,
+ Diagram(..),
+ Object(..),
+ Gen,
+ evalDiagram,
+ write,
+ writeln,
+ nextStep,
+ indent,
+ dedent,
+ withIndent,
+ blank,
+ label,
+ tag,
+ bold,
+ table,
+ tr,
+ td,
+ Enclosing(..),
+ objectWith,
+ attrs
+ ) 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'.
type Name = String
+-- | Operation heading.
type Operation = String
+-- | Operation description.
type Description = String
-- | The top level diagram.
data Diagram = Diagram Name [Object]
-- | An object in a diagram.
-data Object = External ID Name
+data Object =
+ -- | A "Input" or "Output" in DFD.
+ InputOutput ID Name
+ -- | Surrounds other objects, denoting a boundary.
| TrustBoundary ID Name [Object]
- | Process ID Name
+ -- | A \"Function\" in DFD.
+ | Function ID Name
+ -- | A \"Database\" in DFD.
| Database ID Name
- | Edge ID ID Operation Description deriving (Show, Eq)
+ -- | 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 GenState = GenState Indent IndentNext Step
--- | The monad stack for generating output based on Diagram.
+-- | The Gen represents some output generator that runs on a 'Diagram'..
type Gen t = WriterT [String] (State GenState) t
+-- | Run the 'Gen' and get the output as a 'String'.
+evalDiagram :: Gen () -> String
+evalDiagram g = concat $ evalState (execWriterT g) (GenState 0 False 0)
+
+-- | Write a string to the output (no linefeed).
write :: String -> Gen ()
write s = do
(GenState n indentNext step) <- lift get
@@ -34,6 +74,7 @@
else tell [s]
put $ GenState n False step
+-- | Write a string to the output (with linefeed).
writeln :: String -> Gen ()
writeln s = do
write s
@@ -43,63 +84,80 @@
incrStep :: Gen ()
incrStep = modify $ \(GenState n indentNext s') -> GenState n indentNext (s' + 1)
+-- | Get the next \"step\" number (the order of flow arrows in the diagram).
nextStep :: Gen Int
nextStep = do
incrStep
(GenState _ _ s) <- lift get
return s
+-- | Increase indent with 2 spaces.
indent :: Gen ()
indent = modify $ \(GenState n indentNext s) -> GenState (n + 2) indentNext s
+-- | Decrease indent with 2 spaces.
dedent :: Gen ()
dedent = modify $ \(GenState n indentNext s) -> GenState (n - 2) indentNext s
+-- | Indent the output of gen with 2 spaces.
withIndent :: Gen () -> Gen ()
withIndent gen = do
indent
gen
dedent
+-- | Write a blank line.
blank :: Gen ()
blank = tell [""]
+-- | Write a label with the output of gen as its contents.
label :: Gen () -> Gen ()
label contents = do
write "label = <"
contents
writeln ">;"
+-- | Write an HTML tag t with the output of gen as its contents.
tag :: String -> String -> Gen () -> Gen ()
tag t a contents = do
write $ "<" ++ t ++ (if null a then "" else " " ++ a) ++ ">"
contents
write $ ""
+-- | Write a \ tag surrounding the output of another 'Gen'.
bold :: Gen () -> Gen ()
bold = tag "b" ""
+-- | Write a \ tag, with attributes, surrounding the output of
+-- another 'Gen'.
table :: String -> Gen () -> Gen ()
table = tag "table"
+-- | Write a \ tag surrounding the output of another 'Gen'.
tr :: Gen () -> Gen ()
tr = tag "tr" ""
+-- | Write a \ tag surrounding the output of another 'Gen'.
td :: Gen () -> Gen ()
td = tag "td" ""
-type Enclosing = (Char, Char)
-brackets, curlyBrackets :: Enclosing
-brackets = ('[', ']')
-curlyBrackets = ('{', '}')
+-- | The enclosing characters in a block.
+data Enclosing = Brackets | CurlyBrackets
+-- | Write an object with the given 'Enclosing' characters, 'ID' and 'Gen' as
+-- its contents.
objectWith :: Enclosing -> ID -> Gen () -> Gen ()
-objectWith (before, after) id' attributes = do
- blank
- writeln $ id' ++ " " ++ [before]
- withIndent attributes
- writeln [after]
+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 -> Gen ()
-attrs id' = objectWith brackets id' . writeln
-
+attrs id' = objectWith Brackets id' . writeln
diff --git a/src/DataFlow/DFD.hs b/src/DataFlow/DFD.hs
--- a/src/DataFlow/DFD.hs
+++ b/src/DataFlow/DFD.hs
@@ -1,7 +1,5 @@
module DataFlow.DFD where
-import Control.Monad.State
-import Control.Monad.Writer
import DataFlow.Core
-- | Type class for types that can be rendered as DFD.
@@ -9,7 +7,7 @@
dfd :: t -> Gen ()
instance DFD Object where
- dfd (External id' name) = objectWith brackets id' $ do
+ dfd (InputOutput id' name) = objectWith Brackets id' $ do
writeln "shape = square;"
writeln "style = bold;"
label $ bold $ write name
@@ -26,11 +24,11 @@
writeln "graph[style = dashed, color=grey30];"
writeln "}"
- dfd (Process id' name) = objectWith brackets id' $ do
+ dfd (Function id' name) = objectWith Brackets id' $ do
writeln "shape = circle;"
label $ bold $ write name
- dfd (Database id' name) = objectWith brackets id' $ do
+ dfd (Database id' name) = objectWith Brackets id' $ do
label $
table "sides=\"TB\" cellborder=\"0\"" $
tr $
@@ -38,7 +36,7 @@
bold $ write name
writeln "shape = none;"
- dfd (Edge i1 i2 operation description) = do
+ dfd (Flow i1 i2 operation description) = do
step <- nextStep
blank
writeln $ i1 ++ " -> " ++ i2 ++ " ["
@@ -70,9 +68,9 @@
writeln "}"
-- | Generates the DFD output as a String.
-runDfd :: Diagram -> String
-runDfd diagram = concat $ evalState (execWriterT (dfd diagram)) (GenState 0 False 0)
+evalDfd :: Diagram -> String
+evalDfd = evalDiagram . dfd
-- | Prints the DFD output to stdout.
printDfd :: Diagram -> IO ()
-printDfd = putStr . runDfd
+printDfd = putStr . evalDfd