dataflow-0.7.3.0: cli/Main.hs

{-# LANGUAGE TemplateHaskell #-}
module Main where

import Development.GitRev
import qualified Data.ByteString.Lazy.Char8 as BC
import qualified Data.Text.Lazy.IO as TL
import System.IO
import System.Environment
import System.Exit

import DataFlow.Reader
import DataFlow.Core
import qualified DataFlow.Validation as V
import qualified DataFlow.DFD as DFD
import qualified DataFlow.SequenceDiagram as SEQ
import qualified DataFlow.Graphviz.Renderer as GVR
import qualified DataFlow.PlantUML.Renderer as PUR
import qualified DataFlow.Hastache.Renderer as HR
import qualified DataFlow.JSONGraphFormat.Renderer as JG

usage :: IO ()
usage = hPutStrLn stderr $ unlines [
    "Usage: dataflow command args*",
    "",
    "Commands",
    "--------",
    "dfd SRC               - outputs a DFD in the Graphviz DOT format",
    "seq SRC               - outputs a sequence diagram in PlantUML format",
    "template TEMPLATE SRC - renders the TEMPLATE using data from SRC",
    "json SRC              - outputs a sequence diagram in JSON Graph Format",
    "                        (http://jsongraphformat.info/)",
    "validate SRC          - validates the input",
    "",
    "--version             - display VCS information",
    "--help                - display this help message",
    "",
    "All commands print to stdout"
  ]

showErrors :: Show s => Either [s] v -> Either String v
showErrors = either (Left . unlines . map show) Right

readAndValidate :: FilePath -> IO (Either String Diagram)
readAndValidate path = do
  res <- readDiagramFile path
  case res of
    (Left err) -> return $ Left $ show err
    (Right d) -> return (showErrors $ V.validate d)

dfd :: FilePath -> IO ()
dfd path = do
  res <- readAndValidate path
  case res of
    (Left err) -> putStrLn err
    (Right d) -> putStr $ GVR.renderGraphviz $ DFD.asDFD d

seq' :: FilePath -> IO ()
seq' path = do
  res <- readAndValidate path
  case res of
    (Left err) -> putStrLn err
    (Right d) -> putStr $ PUR.renderPlantUML $ SEQ.asSequenceDiagram d

template :: FilePath -> FilePath -> IO ()
template tmplPath path = do
  res <- readAndValidate path
  tmplStr <- readFile tmplPath
  case res of
    (Left err) -> putStrLn err
    (Right d) -> HR.renderTemplate tmplStr path d >>= TL.putStr

json :: FilePath -> IO ()
json path = do
  res <- readAndValidate path
  case res of
    (Left err) -> putStrLn err
    (Right d) -> BC.putStrLn $ JG.renderJSONGraph d

validate :: FilePath -> IO ()
validate path = do
  res <- readAndValidate path
  case res of
    (Left err) -> putStrLn err
    (Right _) -> return ()

version :: IO ()
version = do
  putStrLn $ "Branch: " ++ $(gitBranch)
  putStrLn $ "Hash:   " ++ $(gitHash)

main :: IO ()
main = do
  args <- getArgs
  case args of
    ["dfd", path] -> dfd path
    ["seq", path] -> seq' path
    ["template", tmplPath, path] -> template tmplPath path
    ["json", path] -> json path
    ["validate", path] -> validate path
    ["--version"] -> version
    ["--help"] -> usage
    _ -> do hPutStrLn stderr "Invalid command!\n\nRun with --help to see usage."
            exitWith $ ExitFailure 1