packages feed

flo (empty) → 0.1

raw patch · 5 files changed

+366/−0 lines, 5 filesdep +basedep +bytestringdep +mtlsetup-changed

Dependencies added: base, bytestring, mtl, parsec, regex-compat, text

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Chris Done++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Chris Done nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ flo.cabal view
@@ -0,0 +1,39 @@+Name:                flo+Version:             0.1+Synopsis:            Generate flow charts from your code base.+Description:+  See "Development.Flo" for syntax and examples. Example commandline usage:+   +  @+   find . | grep '\.js$' | xargs flo '-js=\/\/\/ ' | dot -Tpng > flow.png+  @+License:             BSD3+License-file:        LICENSE+Author:              Chris Done+Maintainer:          chrisdone@gmail.com+Category:            Development+Build-type:          Simple+Cabal-version:       >=1.2+Stability:           unstable++Library+  Hs-source-dirs:    src+  Ghc-options:       -O2 -Wall+  Exposed-modules:   Development.Flo+  Build-depends:     base > 4 && <5,+                     text >= 0.11,+                     mtl >= 1.1,+                     parsec >= 3.0,+                     bytestring >= 0.9,+                     regex-compat >= 0.92++Executable flo+  Hs-source-dirs:    src+  Ghc-options:       -O2 -Wall+  Main-is:           Main.hs+  Build-depends:     base > 4 && <5,+                     text >= 0.11,+                     mtl >= 1.1,+                     parsec >= 3.0,+                     bytestring >= 0.9,+                     regex-compat >= 0.92
+ src/Development/Flo.hs view
@@ -0,0 +1,256 @@+{-# OPTIONS -Wall -fno-warn-unused-do-bind #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RankNTypes #-}++-- | Generate a flow chart by from annotations from a code base.+--+-- The syntax is as follows:+--+-- @+--  expr  <- label \/ next \/ do \/ if \/ task+--  label <- \"label\" name+--  task  <- \"task\" text+--  next  <- \"next\" name \/ \"trigger\" name+--  do    <- \"do\" text+--  if    <- \"if\" name \"\\n\" \"then\" name (\"\\n\" \"else\" name)?+-- @+-- +--  where @name@ and @text@ are both arbitrary text.+--+-- A @label@ is used to label a node in the graph.  @next@ is used to+-- link the current node to another node by its label.  The text for a+-- node is written by @do@, which explains what this node does, or by+-- using @if@ which makes this node a conditional which goes to one of+-- two possible nodes.+--+-- Example (assuming '\/\//' to be the declaration prefix):+--+-- @+--  \/\/\/ label main+--  \/\/\/ if Logged in?+--  \/\/\/ then display_overview+--  \/\/\/ else display_login+--  \/\/\/ label display_overview+--  \/\/\/ do Display overview.+--  \/\/\/ next display_event+--  \/\/\/ next display_paper+--  \/\/ Event list code here.+--  event_list();+--  \/\/\/ label display_login+--  \/\/\/ do Display login.+--  \/\/\/ next try_login+--  \/\/ Login display code here.+--  display_login();+--  \/\/\/ label try_login+--  \/\/\/ do Check login.+--  \/\/\/ next main+--  \/\/\/ trigger log_access_time+--  \/\/ Login attempt code here.+--  if(check_login()) log_attempt_success();+--  \/\/\/ label display_event+--  \/\/\/ do Display a single event.+--  \/\/\/ next display_paper+--  \/\/ Event list code here.+--  display_event();+--  \/\/\/ label display_paper+--  \/\/\/ do Display a single paper.+--  \/\/ Paper display code here.+--  display_paper();+--  \/\/\/ label log_access_time+--  \/\/\/ task Log login accesses.+--  log_login();+-- @+--+-- In other words: You have a main page which either displays a login+-- screen or lists the user's events if logged in. From the events+-- page you can get to the event page.+--+-- Custom syntax can be used, too. Example:+--+-- @+--  {- # bar -}+-- SELECT * FROM mysql;+-- @+-- ++module Development.Flo+  (-- * Types+   Node (..),+   Type (..),+   Edge (..),+   Decl (..),+   Name,+   -- * Functions+   digraph,+   nodesToDot,+   declsToNodes,+   parseFile)+  where++import           Control.Applicative+import           Control.Monad.Error  ()+import           Control.Monad.State+import           Control.Monad.Writer+import           Data.ByteString      (ByteString)+import qualified Data.ByteString      as B+import           Data.Char+import           Data.Maybe+import           Data.List+import           Text.Parsec          hiding ((<|>))++-- | A workflow node.+data Node =+  Node { nodeName  :: Name+       , nodeEdges :: [Edge]+       , nodeDesc  :: String+       , nodeType  :: Type+       } deriving Show++-- | Type of the node.+data Type = Action | Condition | Background+  deriving (Eq,Enum,Show)++-- | A workflow connection.+data Edge =+  Edge { edgeLabel :: String+       , edgeTo    :: Name+       } deriving Show++-- | A workflow declaration.+data Decl+  = Label Name                  -- ^ Sets the current node.+  | Next Name                   -- ^ Links to a next node (an edge).+  | Do String                   -- ^ Describes this node.+  | Task String                 -- ^ Run some task (create db entry,+                                --   delete file, send email etc.).+  | If String Name (Maybe Name) -- ^ Makes this node a conditional.+  deriving Show++-- | A node name.+newtype Name = Name String+  deriving (Eq,Show)++-- | Simple alias for the parser type.+type P = Parsec ByteString ()++-- | Wrap a string up in a digraph.+digraph :: String -> String+digraph x = "digraph G {\n" ++ x ++ "\n}"++-- | Convert a list of nodes to a Graphviz dot document.+nodesToDot :: [Node] -> String+nodesToDot nodes = concat . map nodeToDot $ nodes where+  nodeToDot Node{..} =+    normalizeName nodeName ++ " [" ++ props ++ "]\n" +++    concat (map (edgeToDot nodeName) nodeEdges)+    where props = intercalate ","+                  ["label=" ++ show nodeDesc+                  ,"shape=" ++ case nodeType of+                                 Condition -> "house"+                                 Action -> "box"+                                 Background -> "oval"+                  ]+  edgeToDot from Edge{..} = normalizeName from ++ " -> " ++ normalizeName edgeTo +++                            " [label=" ++ show edgeLabel ++ +                            ",style=" ++ (if trig then "dotted" else "solid") +++                            "]\n"+     where trig = maybe False ((==Background).nodeType) $+                    find ((==edgeTo).nodeName) nodes++-- | Normalize a node name to fit Dot syntax.+normalizeName :: Name -> String+normalizeName (Name name) = replace name where+  replace [] = []+  replace (x:xs) | isDigit x || isLetter x || x== '_' = x : replace xs+                 | otherwise = "_" ++ show (fromEnum x) ++ replace xs++-- | Converts a list of declarations to a list of nodes.+declsToNodes :: [Decl] -> [Node]+declsToNodes ds = snd $ runWriter (runStateT (go ds) Nothing) where+  go (Label name@(Name desc):xs) = do+    let setNew = put (Just $ Node name [] desc Action)+    get >>= maybe setNew (\x -> do tell [x]; setNew)+    go xs+  go (Next edge:xs) = do+    modify $ fmap $ \node ->+      if nodeType node /= Condition+         then node { nodeEdges = Edge "" edge : nodeEdges node }+         else node+    go xs+  go (Do desc:xs) = do+    modify $ fmap $ \node -> node { nodeDesc = desc }+    go xs+  go (Task desc:xs) = do+    modify $ fmap $ \node -> node { nodeDesc = desc, nodeType = Background }+    go xs+  go (If cond xthen xelse:xs) = do+    modify $ fmap $ \node ->+      node { nodeType = Condition+           , nodeDesc = cond+           , nodeEdges = [Edge "Yes" xthen] +++                         maybe [] (return . Edge "No") xelse+           }+    go xs+  go [] = get >>= maybe (return ()) (tell . return)++-- | Parse a source file containing commented declarations.+parseFile :: FilePath -> String -> Maybe String -> IO (Either ParseError [Decl])+parseFile path start end = do+  contents <- B.readFile path+  return $ parse (parseDeclsInSource startP endP)+                 path+                 (contents `mappend` "\n")+  +  where startP = spaces *> string start *> pure ()+        endP = maybe (void $ lookAhead newline)+                     (void.string)+                      end+        void p = p *> pure ()++-- | Parse all line-separated prefixed declarations in a source file.+parseDeclsInSource :: P () -> P () -> P [Decl]+parseDeclsInSource start end = do+  ls <- many1 (floComment <|> normalSource) <* eof+  return $ catMaybes ls+  +  where floComment = try (Just <$> parseDecl start end)+        normalSource = const Nothing <$> manyTill anyChar newline++-- | Parse a declaration (spanning many lines in some cases e.g. "if").+parseDecl :: P () -> P () -> P Decl+parseDecl start end = do+  start+  keyword <- choice $ map (try.string) ["label","next","do","if","trigger","task"]+  space; spaces+  value <- manyTill anyChar (try $ lookAhead end)+  end+  case keyword of+    "if"      -> parseIfClauses value start end+    "next"    -> return $ Next $ Name value+    "trigger" -> return $ Next $ Name value+    "do"      -> return $ Do value+    "task"    -> return $ Task value+    _         -> return $ Label $ Name value++-- | Parse the then/else clauses of the if with the given condition.+parseIfClauses :: String -> P () -> P () -> P Decl+parseIfClauses cond start end = do+  start+  string "then"+  space; spaces+  value <- manyTill anyChar (try $ lookAhead end)+  end+  elseClause <- Just <$> (parseElseClause start end) <|> return Nothing+  return $ If cond (Name value) elseClause++-- | Parse the else clause for an `if' expression.+parseElseClause :: P () -> P () -> P Name+parseElseClause start end = do+  start+  string "else"+  space; spaces+  value <- manyTill anyChar (try $ lookAhead newline)+  end+  return $ Name value
+ src/Main.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE ViewPatterns #-}++-- | Generate a flow chart by scanning for annotations from a code base.++module Main where++import Control.Monad+import Data.List+import Data.Maybe+import Development.Flo+import System.Environment+import System.IO+import Text.Regex++-- | Main entry point.+main :: IO ()+main = do+  args <- getArgs+  let files = filter (not.opt) args+      optish = filter opt args+      opts  = catMaybes (map parseOpt optish)+      opt   = isPrefixOf "-"+  when (any (=="-v") optish) (hPrint stderr opts)+  mapM (scanAndPrint opts) files >>= putStrLn.digraph.join.join++    where scanAndPrint opts file =+            fmap (either (error.show) (return.nodesToDot.declsToNodes))+                 (parseFile file start end)+                 +            where start = fromMaybe (error $ "No pattern specified for " ++ ext)+                                    (lookup ext opts)+                  end = lookup (ext++"-end") opts+                  ext = reverse.takeWhile (/='.').reverse $ file++-- | Parse an -x=y option.+parseOpt :: String -> Maybe (String,String)+parseOpt (matchRegex (mkRegex "^-([a-zA-Z-]+)=(.+)$") -> Just [lang,start])+  | all (not.null) [lang,start] = Just (lang,start)+parseOpt _ = Nothing