module DataFlow.DFD where
import DataFlow.Core
class DFD t where
dfd :: t -> Gen ()
instance DFD Object where
dfd (InputOutput 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 = grey30;"
label $ write name
writeln "graph[style = dashed, color=grey30];"
writeln "}"
dfd (Function 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 (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"
blank
writeln "labelloc = \"t\";"
label $ bold $ write title
writeln "fontsize = 20;"
writeln "nodesep = 1;"
writeln "rankdir = LR;"
mapM_ dfd objects
writeln "}"
evalDfd :: Diagram -> String
evalDfd = evalDiagram . dfd
printDfd :: Diagram -> IO ()
printDfd = putStr . evalDfd