dataflow (empty) → 0.1.0.0

raw patch · 5 files changed

+215/−0 lines, 5 filesdep +basedep +mtlsetup-changed

Dependencies added: base, mtl

Files

• LICENSE +21/−0
• Setup.hs +2/−0
• dataflow.cabal +23/−0
• src/DataFlow/Core.hs +95/−0
• src/DataFlow/DFD.hs +74/−0

@@ -0,0 +1,21 @@+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:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,23 @@+name:                dataflow+version:             0.1.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.+license:             MIT+license-file:        LICENSE+author:              Oskar Wickström+maintainer:          oskar.wickstrom@live.com+-- copyright:+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++library+  exposed-modules:+    DataFlow.Core,+    DataFlow.DFD+  build-depends:+    base >=4.6 && <4.8,+    mtl >=2.2+  hs-source-dirs:      src+  default-language:    Haskell2010

@@ -0,0 +1,95 @@+module DataFlow.Core where++import Control.Monad.State+import Control.Monad.Writer++type ID = String+type Name = String+type Operation = String+type Description = String++-- | The top level diagram.+data Diagram = Diagram Name [Object]++-- | An object in a diagram.+data Object = Client ID Name+            | TrustBoundary ID Name [Object]+            | Process ID Name+            | Database ID Name+            | Edge ID ID Operation Description deriving (Show, Eq)++type Indent = Int+type Step = Int+data GenState = GenState Indent Step++-- | The monad stack for generating output based on Diagram.+type Gen t = WriterT [String] (State GenState) t++write :: String -> Gen ()+write s = do+  (GenState n _) <- lift get+  tell [replicate n ' ' ++ s]++incrStep :: Gen ()+incrStep = modify $ \(GenState n s') -> GenState n (s' + 1)++nextStep :: Gen Int+nextStep = do+  incrStep+  (GenState _ s) <- lift get+  return s++indent :: Gen ()+indent = modify $ \(GenState n s) -> GenState (n + 2) s++dedent :: Gen ()+dedent = modify $ \(GenState n s) -> GenState (n - 2) s++withIndent :: Gen () -> Gen ()+withIndent gen = do+  indent+  gen+  dedent++blank :: Gen ()+blank = tell [""]++label :: Gen () -> Gen ()+label contents = do+  write "label = <"+  withIndent contents+  write ">;"++tag :: String -> String -> Gen () -> Gen ()+tag t attrs contents = do+  write $ "<" ++ t ++ (if null attrs then "" else " " ++ attrs) ++ ">"+  withIndent contents+  write $ "</" ++ t ++ ">"++bold :: Gen () -> Gen ()+bold = tag "b" ""++table :: String -> Gen () -> Gen ()+table = tag "table"++tr :: Gen () -> Gen ()+tr = tag "tr" ""++td :: Gen () -> Gen ()+td = tag "td" ""++type Enclosing = (Char, Char)+brackets, curlyBrackets :: Enclosing+brackets = ('[', ']')+curlyBrackets = ('{', '}')++objectWith :: Enclosing -> ID -> Gen () -> Gen ()+objectWith (before, after) id' attributes = do+  blank+  write $ id' ++ " " ++ [before]+  withIndent attributes+  write [after]++useFont :: ID -> String -> Gen ()+useFont id' font = objectWith brackets id' $ write $ "fontname = \"" ++ font ++ "\";"+

@@ -0,0 +1,74 @@+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.+class DFD t where+  dfd :: t -> Gen ()++instance DFD Object where+  dfd (Client id' name) = objectWith brackets id' $ do+    write "shape = square;"+    write "style = bold;"+    label $ bold $ write name++  dfd (TrustBoundary id' name objects) = do+    blank+    write $ "subgraph cluster_" ++ id' ++ " {"+    withIndent $ do+      mapM_ dfd objects+      blank+      write $ "label = <<b>" ++ name ++ "</b>>;"+      write "graph[style = dashed];"+    write "}"++  dfd (Process id' name) = objectWith brackets id' $ do+    write "shape = circle;"+    label $ bold $ write name++  dfd (Database id' name) = objectWith brackets id' $ do+    label $+      table "sides=\"TB\" cellborder=\"0\"" $+        tr $+          td $+            bold $ write name+    write "shape = none;"++  dfd (Edge i1 i2 operation description) = do+    step <- nextStep+    blank+    write $ i1 ++ " -> " ++ i2 ++ " ["+    withIndent $+      label $ do+        bold $ write $ "(" ++ show step ++ ") " ++ operation+        write "<br/>"+        write description+    write "]"++instance DFD Diagram where+  dfd (Diagram title objects) = do+    write $ "digraph \"" ++ title ++ "\" {"+    withIndent $ do+      useFont "graph" "sans-serif"+      useFont "node" "sans-serif"+      useFont "edge" "sans-serif"+      blank++      write "labelloc = \"t\";"+      label $ bold $ write title++      write "rankdir = LR;"++      mapM_ dfd objects++    write "}"++-- | Generates the DFD output as a String.+runDfd :: Diagram -> String+runDfd diagram = unlines $ evalState (execWriterT (dfd diagram)) (GenState 0 0)++-- | Prints the DFD output to stdout.+printDfd :: Diagram -> IO ()+printDfd = putStr . runDfd