dataflow 0.4.1.0 → 0.4.2.0

raw patch · 5 files changed

+138/−88 lines, 5 filesdep +containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: containers

API changes (from Hackage documentation)

Files

• README.md +3/−2
• dataflow.cabal +3/−2
• example/example.svg +5/−5
• src/DataFlow/Core.hs +35/−35
• src/DataFlow/DFD.hs +92/−44

@@ -16,11 +16,12 @@ * `TrustBoundary` * `InputOutput` * `Function`+* `Database` * `Flow`  These are composed in a `Diagram` to get something printable. -For more information see the [Hackage site](https://hackage.haskell.org/package/dataflow).+For more on Haskell data types, see [the Hackage site](https://hackage.haskell.org/package/dataflow).  ## Example @@ -70,5 +71,5 @@ ## Release  ```bash-cabal clean && cabal build && cabal haddock && cabal sdist && cabal upload dist/dataflow-*.tar.gz+cabal clean && cabal build && cabal sdist && cabal upload dist/dataflow-*.tar.gz ```

@@ -1,5 +1,5 @@ name:                dataflow-version:             0.4.1.0+version:             0.4.2.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@@ -33,6 +33,7 @@     DataFlow.DFD   build-depends:     base >=4 && <4.8,-    mtl >=2.2+    mtl >=2.2,+    containers >= 0.4   hs-source-dirs:      src   default-language:    Haskell2010

@@ -10,14 +10,14 @@ <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="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> <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"/>@@ -32,7 +32,7 @@ <g id="edge1" class="edge"><title>webapp&#45;&gt;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="middle" x="163.81" y="-224.545" font-family="sans-serif" font-size="12.00">webappserver&#45;&gt;</text>+<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>

@@ -5,7 +5,7 @@   Description,   Diagram(..),   Object(..),-  Gen,+  Renderer,   evalDiagram,   write,   writeln,@@ -56,97 +56,97 @@ type Indent = Int type IndentNext = Bool type Step = Int-data GenState = GenState Indent IndentNext Step+data RendererState = RendererState Indent IndentNext Step --- | The Gen represents some output generator that runs on a 'Diagram'..-type Gen t = WriterT [String] (State GenState) t+-- | The Renderer represents some output generator that runs on a 'Diagram'.+type Renderer t = WriterT [String] (State RendererState) t --- | Run the 'Gen' and get the output as a 'String'.-evalDiagram :: Gen () -> String-evalDiagram g = concat $ evalState (execWriterT g) (GenState 0 False 0)+-- | 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 -> Gen ()+write :: String -> Renderer () write s = do-  (GenState n indentNext step) <- lift get+  (RendererState n indentNext step) <- lift get   if indentNext     then tell [replicate n ' ' ++ s]     else tell [s]-  put $ GenState n False step+  put $ RendererState n False step  -- | Write a string to the output (with linefeed).-writeln :: String -> Gen ()+writeln :: String -> Renderer () writeln s = do   write s   write "\n"-  modify $ \(GenState n _ s') -> GenState n True s'+  modify $ \(RendererState n _ s') -> RendererState n True s' -incrStep :: Gen ()-incrStep = modify $ \(GenState n indentNext s') -> GenState n indentNext (s' + 1)+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 :: Gen Int+nextStep :: Renderer Int nextStep = do   incrStep-  (GenState _ _ s) <- lift get+  (RendererState _ _ s) <- lift get   return s  -- | Increase indent with 2 spaces.-indent :: Gen ()-indent = modify $ \(GenState n indentNext s) -> GenState (n + 2) indentNext s+indent :: Renderer ()+indent = modify $ \(RendererState n indentNext s) -> RendererState (n + 2) indentNext s  -- | Decrease indent with 2 spaces.-dedent :: Gen ()-dedent = modify $ \(GenState n indentNext s) -> GenState (n - 2) indentNext s+dedent :: Renderer ()+dedent = modify $ \(RendererState n indentNext s) -> RendererState (n - 2) indentNext s  -- | Indent the output of gen with 2 spaces.-withIndent :: Gen () -> Gen ()+withIndent :: Renderer () -> Renderer () withIndent gen = do   indent   gen   dedent  -- | Write a blank line.-blank :: Gen ()+blank :: Renderer () blank = tell [""]  -- | Write a label with the output of gen as its contents.-label :: Gen () -> Gen ()+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 -> Gen () -> Gen ()+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 'Gen'.-bold :: Gen () -> Gen ()+-- | 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 'Gen'.-table :: String -> Gen () -> Gen ()+--   another 'Renderer'.+table :: String -> Renderer () -> Renderer () table = tag "table" --- | Write a \<tr\> tag surrounding the output of another 'Gen'.-tr :: Gen () -> Gen ()+-- | 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 'Gen'.-td :: Gen () -> Gen ()+-- | 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 'Gen' as+-- | Write an object with the given 'Enclosing' characters, 'ID' and 'Renderer' as --   its contents.-objectWith :: Enclosing -> ID -> Gen () -> Gen ()+objectWith :: Enclosing -> ID -> Renderer () -> Renderer () objectWith enc id' attributes =   do     blank@@ -159,5 +159,5 @@         after CurlyBrackets = "}"  -- | Write an attributes declaration for the given 'ID'.-attrs :: ID -> String -> Gen ()+attrs :: ID -> String -> Renderer () attrs id' = objectWith Brackets id' . writeln

@@ -1,34 +1,73 @@ 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 DFD t where-  dfd :: t -> Gen ()+class RenderDFD t where+  dfd :: t -> DFDRenderer () -instance DFD Object where-  dfd (InputOutput id' name) = objectWith Brackets id' $ do-    writeln "shape = square;"-    writeln "style = bold;"-    label $ bold $ write name+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++register :: (ID, ID) -> DFDState ()+register k = do+  m <- get+  put $ Map.insert k True m+  return ()++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++instance RenderDFD Object where+  dfd (InputOutput id' name) =+    return $ objectWith Brackets id' $ do+      writeln "shape = square;"+      writeln "style = bold;"+      label $ bold $ write name+   dfd (TrustBoundary id' name objects) = do-    blank-    writeln $ "subgraph cluster_" ++ id' ++ " {"-    withIndent $ do-      mapM_ dfd objects+    renderObjects <- mapM dfd objects+    return $ do       blank-      writeln "fontsize = 10;"-      writeln "fontcolor = grey30;"-      label $ write name-      writeln "graph[style = dashed, color=grey30];"-    writeln "}"+      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 "}" -  dfd (Function id' name) = objectWith Brackets id' $ do+  dfd (Function id' name) = return $ objectWith Brackets id' $ do     writeln "shape = circle;"     label $ bold $ write name -  dfd (Database id' name) = objectWith Brackets id' $ do+  dfd (Database id' name) = return $ objectWith Brackets id' $ do     label $       table "sides=\"TB\" cellborder=\"0\"" $         tr $@@ -36,40 +75,49 @@             bold $ write name     writeln "shape = none;" -  dfd (Flow i1 i2 operation description) = do-    step <- nextStep-    blank-    writeln $ i1 ++ " -> " ++ i2 ++ " ["-    withIndent $-      label $ do-        bold $ write $ "(" ++ show step ++ ") " ++ operation-        write "<br/>"-        write description-    writeln "]"--instance DFD Diagram where-  dfd (Diagram title objects) = do-    writeln $ "digraph \"" ++ title ++ "\" {"-    withIndent $ do-      attrs "graph" "fontname=\"sans-serif\""-      attrs "node" "fontname=\"sans-serif\""-      attrs "edge" "fontname=\"sans-serif\", fontsize=12"+  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 "]" -      writeln "labelloc = \"t\";"-      label $ bold $ write title-      writeln "fontsize = 20;"+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 -      writeln "nodesep = 1;"-      writeln "rankdir = LR;"+          writeln "labelloc = \"t\";"+          label $ bold $ write title+          writeln "fontsize = 20;" -      mapM_ dfd objects+          writeln "nodesep = 1;"+          writeln "rankdir = LR;" -    writeln "}"+          sequence_ renderObjects +        writeln "}"+ -- | Generates the DFD output as a String. evalDfd :: Diagram -> String-evalDfd = evalDiagram . dfd+evalDfd d = evalDiagram (evalState (dfd d) Map.empty)  -- | Prints the DFD output to stdout. printDfd :: Diagram -> IO ()