module DataFlow.Core 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 = External 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
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 ++ "\";"