diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -5,9 +5,7 @@ ## Getting Started ``` -cabal sandbox init -cabal configure --enable-tests -cabal install --only-dependencies --enable-tests +cabal install dataflow@0.6.0.0 ``` ## Usage @@ -16,60 +14,60 @@ The objects supported by DataFlow is: -* `TrustBoundary` -* `InputOutput` -* `Function` -* `Database` -* `Flow` - -These are composed in a `Diagram` to get something printable. +* `boundary` +* `io` +* `function` +* `database` +* `->` -For more on Haskell data types, see [the Hackage site](https://hackage.haskell.org/package/dataflow). +These are composed in a `diagram` to get something printable. ## Example -```haskell -module Main where - -import DataFlow.Core -import DataFlow.Graphviz.Renderer -import DataFlow.DFD - -main :: IO () -main = putStr $ renderGraphviz $ asDFD $ - Diagram (Just "Webapp") [ - TrustBoundary "browser" "Browser" [ - Function "client" "Client" - ], - TrustBoundary "aws" "Amazon AWS" [ - Function "server" "Web Server", - Database "logs" "Logs" - ], - InputOutput "analytics" "Google Analytics", - - Flow "client" "server" "Request /" "", - Flow "server" "logs" "Log" "User IP", - Flow "server" "client" "Response" "User Profile", +``` +diagram 'Webapp' { + boundary 'Browser' { + function client 'Client' + } + boundary 'Amazon AWS' { + function server 'Web Server' + database logs 'Logs' + } + io analytics 'Google
Analytics' - Flow "client" "analytics" "Log" "Page Navigation" - ] + client -> server 'Request /' '' + server -> logs 'Log' 'User IP' + server -> client 'Response' 'User Profile' + client -> analytics 'Log' 'Page Navigation' +} ``` Then generate your output with dot. ```bash -runhaskell example.hs | dot -Tsvg > example.svg +dataflow dfd webapp.flow | dot -Tsvg > webapp.svg ``` That should generate something like the following. ![Example Output](https://rawgit.com/owickstrom/dataflow/master/examples/webapp.svg) +## Build + +``` +cabal sandbox init +cabal configure --enable-tests +cabal install --only-dependencies --enable-tests +``` + ## Building the Examples ```bash make -C examples ``` +## Haskell Docs + +See [the Hackage site](https://hackage.haskell.org/package/dataflow). ## Release diff --git a/cli/Main.hs b/cli/Main.hs new file mode 100644 --- /dev/null +++ b/cli/Main.hs @@ -0,0 +1,26 @@ +module Main where + +import System.Environment +import DataFlow.Core +import DataFlow.Reader +import DataFlow.DFD +import DataFlow.Graphviz.Renderer + +data Command = DFD | Lint + +usage :: String +usage = "Usage: dataflow (dfd|lint) FILE" + +dfd :: FilePath -> IO () +dfd path = do + res <- readDiagramFile path + case res of + (Left err) -> print err + (Right diagram) -> putStr $ renderGraphviz $ asDFD diagram + +main :: IO () +main = do + args <- getArgs + case args of + ["dfd", path] -> dfd path + _ -> fail usage diff --git a/dataflow.cabal b/dataflow.cabal --- a/dataflow.cabal +++ b/dataflow.cabal @@ -1,5 +1,5 @@ name: dataflow -version: 0.5.4.0 +version: 0.6.0.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 @@ -17,9 +17,9 @@ build-type: Simple extra-source-files: README.md, LICENSE, - examples/webapp.hs, + examples/webapp.flow, examples/webapp.svg, - examples/legend.hs, + examples/legend.flow, examples/legend.svg, examples/Makefile cabal-version: >=1.10 @@ -31,6 +31,7 @@ library exposed-modules: DataFlow.Core, + DataFlow.Reader, DataFlow.Graphviz, DataFlow.Graphviz.EdgeNormalization, DataFlow.Graphviz.Renderer, @@ -38,8 +39,17 @@ build-depends: base >=4 && <4.8, mtl >=2.2, - containers >= 0.4 + containers >= 0.4, + parsec hs-source-dirs: src + default-language: Haskell2010 + +executable dataflow + main-is: Main.hs + build-depends: + base >=4 && <4.8, + dataflow + hs-source-dirs: cli default-language: Haskell2010 test-suite spec diff --git a/examples/Makefile b/examples/Makefile --- a/examples/Makefile +++ b/examples/Makefile @@ -1,9 +1,13 @@ -SOURCES=$(shell find *.hs) -TARGETS=$(SOURCES:%.hs=%.svg) +SOURCES=$(shell find *.flow) +TARGETS=$(SOURCES:%.flow=%.svg) +DATAFLOW=../dist/build/DataFlow/dataflow -%.svg: %.hs +$(DATAFLOW): + cd .. && cabal build + +%.svg: %.flow $(DATAFLOW) @echo "$< -> $@" - @runhaskell -i../src $< | dot -Tsvg > $@ + @$(DATAFLOW) dfd $< | dot -Nfontname=Courier -Efontname=Courier -Tsvg > $@ svg: $(TARGETS) diff --git a/examples/legend.flow b/examples/legend.flow new file mode 100644 --- /dev/null +++ b/examples/legend.flow @@ -0,0 +1,11 @@ +diagram '' { + boundary 'boundary' { + function f 'function' + database d 'database' + io i 'io' + } + + f -> d 'Data' 'Description' + i -> f '' 'Description' + f -> i 'Data' '' +} diff --git a/examples/legend.hs b/examples/legend.hs deleted file mode 100644 --- a/examples/legend.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Main where - -import DataFlow.Core -import DataFlow.Graphviz.Renderer -import DataFlow.DFD - -main :: IO () -main = putStr $ renderGraphviz $ asDFD $ - Diagram Nothing [ - TrustBoundary "trust" "TrustBoundary" [ - Function "function" "Function", - Database "database" "Database", - InputOutput "io" "InputOutput" - ], - Flow "function" "io" "Flow" "", - Flow "io" "function" "Flow" "(backwards)", - Flow "function" "database" "Flow" "" - ] - diff --git a/examples/legend.svg b/examples/legend.svg --- a/examples/legend.svg +++ b/examples/legend.svg @@ -3,53 +3,52 @@ "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd"> - - - -Untitled - -cluster_trust - -TrustBoundary + + + + +cluster_boundary + +boundary - -function - -Function + +f + +function - -database -Database - - + +i + +io - -function->database - - -(3) -Flow + +f->i + + +(2) +Description - -io - -InputOutput + +f->i + + +(3) +Data - -function->io - - -(1) -Flow + +d +database + + - -function->io - - -(2) -Flow -(backwards) + +d->f + + +(1) +Data +Description diff --git a/examples/webapp.flow b/examples/webapp.flow new file mode 100644 --- /dev/null +++ b/examples/webapp.flow @@ -0,0 +1,15 @@ +diagram 'Webapp' { + boundary 'Browser' { + function client 'Client' + } + boundary 'Amazon AWS' { + function server 'Web Server' + database logs 'Logs' + } + io analytics 'Google
Analytics' + + client -> server 'Request /' '' + server -> logs 'Log' 'User IP' + server -> client 'Response' 'User Profile' + analytics <- client 'Log' 'Page Navigation' +} diff --git a/examples/webapp.hs b/examples/webapp.hs deleted file mode 100644 --- a/examples/webapp.hs +++ /dev/null @@ -1,24 +0,0 @@ -module Main where - -import DataFlow.Core -import DataFlow.Graphviz.Renderer -import DataFlow.DFD - -main :: IO () -main = putStr $ renderGraphviz $ asDFD $ - Diagram (Just "Webapp") [ - TrustBoundary "browser" "Browser" [ - Function "client" "Client" - ], - TrustBoundary "aws" "Amazon AWS" [ - Function "server" "Web Server", - Database "logs" "Logs" - ], - InputOutput "analytics" "Google
Analytics", - - Flow "client" "server" "Request /" "", - Flow "server" "logs" "Log" "User IP", - Flow "server" "client" "Response" "User Profile", - - Flow "client" "analytics" "Log" "Page Navigation" - ] diff --git a/examples/webapp.svg b/examples/webapp.svg --- a/examples/webapp.svg +++ b/examples/webapp.svg @@ -4,72 +4,72 @@ - - + + Webapp - -Webapp + +Webapp cluster_browser - -Browser + +Browser -cluster_aws - -Amazon AWS +cluster_amazonaws + +Amazon AWS client - -Client + +Client server - -Web Server - - -client->server - - -(1) -Request / - - -client->server - - -(3) -Response -User Profile + +Web Server - -analytics - -Google -Analytics + +server->client + + +(1) +Request / - -client->analytics - - -(4) -Log -Page Navigation + +server->client + + +(3) +Response +User Profile logs -Logs - - +Logs + + - -server->logs - - -(2) -Log -User IP + +logs->server + + +(2) +Log +User IP + + +analytics + +Google +Analytics + + +analytics->client + + +(4) +Log +Page Navigation diff --git a/src/DataFlow/Core.hs b/src/DataFlow/Core.hs --- a/src/DataFlow/Core.hs +++ b/src/DataFlow/Core.hs @@ -17,7 +17,7 @@ type Description = String -- | The top level diagram. -data Diagram = Diagram (Maybe Name) [Object] +data Diagram = Diagram (Maybe Name) [Object] deriving (Eq, Show) -- | An object in a diagram. data Object = diff --git a/src/DataFlow/Reader.hs b/src/DataFlow/Reader.hs new file mode 100644 --- /dev/null +++ b/src/DataFlow/Reader.hs @@ -0,0 +1,131 @@ +module DataFlow.Reader (readDiagram, readDiagramFile) where + +import Text.ParserCombinators.Parsec +import Data.Char +import DataFlow.Core + +nameToID :: String -> String +nameToID = filter isLetter . map toLower + +identifier :: Parser ID +identifier = do + first <- letter + rest <- many (letter <|> digit <|> char '_') + return $ first : rest + +quoted :: Parser ID +quoted = do + -- TODO: Handle escaped characters. + _ <- char '\'' + s <- many (noneOf "'") + _ <- char '\'' + return s + +skipWhitespace :: Parser () +skipWhitespace = skipMany $ space <|> newline + +skipWhitespace1 :: Parser () +skipWhitespace1 = skipMany $ space <|> newline + +inBraces :: Parser t -> Parser t +inBraces inside = do + skipWhitespace + _ <- char '{' + skipWhitespace + c <- inside + skipWhitespace + _ <- char '}' + skipWhitespace + return c + +idAndNameObject :: String -> (ID -> ID -> t) -> Parser t +idAndNameObject keyword f = do + _ <- string keyword + skipMany1 space + id' <- identifier + skipMany1 space + name <- quoted + skipWhitespace1 + return $ f id' name + +function :: Parser Object +function = idAndNameObject "function" Function + +database :: Parser Object +database = idAndNameObject "database" Database + +io :: Parser Object +io = idAndNameObject "io" InputOutput + +data FlowType = Back | Forward + +arrow :: Parser FlowType +arrow = do + s <- string "->" <|> string "--" <|> string "<-" + case s of + "->" -> return Forward + "<-" -> return Back + _ -> fail "Invalid flow statement" + +flow :: Parser Object +flow = do + i1 <- identifier + skipMany1 space + a <- arrow + skipMany1 space + i2 <- identifier + skipMany1 space + data' <- quoted + skipMany1 space + desc <- quoted + skipWhitespace1 + case a of + Back -> return $ Flow i2 i1 data' desc + Forward -> return $ Flow i1 i2 data' desc + +boundary :: Parser Object +boundary = do + _ <- string "boundary" + skipMany1 space + name <- quoted + let id' = nameToID name + skipMany1 space + objs <- inBraces objects + skipWhitespace1 + return $ TrustBoundary id' name objs + +object :: Parser Object +object = + try boundary + <|> try function + <|> try database + <|> try io + <|> flow + +objects :: Parser [Object] +objects = object `sepBy` many (space <|> newline) + +namedDiagram :: Parser Diagram +namedDiagram = do + _ <- string "diagram" + skipMany1 space + name <- quoted + skipMany1 space + objs <- inBraces objects + return $ Diagram (Just name) objs + +unnamedDiagram :: Parser Diagram +unnamedDiagram = do + _ <- string "diagram" + skipMany1 space + objs <- inBraces objects + return $ Diagram Nothing objs + +diagram :: Parser Diagram +diagram = try unnamedDiagram <|> namedDiagram + +readDiagram :: String -> String -> Either ParseError Diagram +readDiagram = parse diagram + +readDiagramFile :: FilePath -> IO (Either ParseError Diagram) +readDiagramFile = parseFromFile diagram