module DataFlow.DFD where
import Control.Monad.State
import Control.Monad.Writer
import DataFlow.Core
class DFD t where
dfd :: t -> Gen ()
instance DFD Object where
dfd (External id' name) = 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
blank
writeln "fontsize = 10;"
writeln "fontcolor = gray25;"
label $ write name
writeln "graph[style = dashed];"
writeln "}"
dfd (Process id' name) = objectWith brackets id' $ do
writeln "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
writeln "shape = none;"
dfd (Edge 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
useFont "graph" "sans-serif"
useFont "node" "sans-serif"
useFont "edge" "sans-serif"
blank
writeln "labelloc = \"t\";"
label $ bold $ write title
writeln "rankdir = LR;"
mapM_ dfd objects
writeln "}"
runDfd :: Diagram -> String
runDfd diagram = concat $ evalState (execWriterT (dfd diagram)) (GenState 0 False 0)
printDfd :: Diagram -> IO ()
printDfd = putStr . runDfd