module DataFlow.Core (
ID,
Name,
Operation,
Description,
Diagram(..),
Object(..),
Renderer,
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
type ID = String
type Name = String
type Operation = String
type Description = String
data Diagram = Diagram Name [Object]
data Object =
InputOutput ID Name
| TrustBoundary ID Name [Object]
| Function ID Name
| Database ID Name
| Flow ID ID Operation Description deriving (Show, Eq)
type Indent = Int
type IndentNext = Bool
type Step = Int
data RendererState = RendererState Indent IndentNext Step
type Renderer t = WriterT [String] (State RendererState) t
evalDiagram :: Renderer () -> String
evalDiagram g = concat $ evalState (execWriterT g) (RendererState 0 False 0)
write :: String -> Renderer ()
write s = do
(RendererState n indentNext step) <- lift get
if indentNext
then tell [replicate n ' ' ++ s]
else tell [s]
put $ RendererState n False step
writeln :: String -> Renderer ()
writeln s = do
write s
write "\n"
modify $ \(RendererState n _ s') -> RendererState n True s'
incrStep :: Renderer ()
incrStep = modify $ \(RendererState n indentNext s') -> RendererState n indentNext (s' + 1)
nextStep :: Renderer Int
nextStep = do
incrStep
(RendererState _ _ s) <- lift get
return s
indent :: Renderer ()
indent = modify $ \(RendererState n indentNext s) -> RendererState (n + 2) indentNext s
dedent :: Renderer ()
dedent = modify $ \(RendererState n indentNext s) -> RendererState (n 2) indentNext s
withIndent :: Renderer () -> Renderer ()
withIndent gen = do
indent
gen
dedent
blank :: Renderer ()
blank = tell [""]
label :: Renderer () -> Renderer ()
label contents = do
write "label = <"
contents
writeln ">;"
tag :: String -> String -> Renderer () -> Renderer ()
tag t a contents = do
write $ "<" ++ t ++ (if null a then "" else " " ++ a) ++ ">"
contents
write $ "</" ++ t ++ ">"
bold :: Renderer () -> Renderer ()
bold = tag "b" ""
table :: String -> Renderer () -> Renderer ()
table = tag "table"
tr :: Renderer () -> Renderer ()
tr = tag "tr" ""
td :: Renderer () -> Renderer ()
td = tag "td" ""
data Enclosing = Brackets | CurlyBrackets
objectWith :: Enclosing -> ID -> Renderer () -> Renderer ()
objectWith enc id' attributes =
do
blank
writeln $ id' ++ " " ++ before enc
withIndent attributes
writeln $ after enc
where before Brackets = "["
before CurlyBrackets = "{"
after Brackets = "]"
after CurlyBrackets = "}"
attrs :: ID -> String -> Renderer ()
attrs id' = objectWith Brackets id' . writeln