diff options
| -rw-r--r-- | CmdLine.hs | 26 | ||||
| -rw-r--r-- | Graphviz.hs | 20 | ||||
| -rw-r--r-- | debug-me.hs | 2 |
3 files changed, 31 insertions, 17 deletions
@@ -6,16 +6,28 @@ data CmdLine = CmdLine { mode :: Mode } -data Mode = Test | Graphviz FilePath +data Mode + = Test + | Graphviz GraphvizOpts + +data GraphvizOpts = GraphvizOpts + { graphvizLogFile :: FilePath + , graphvizShowHashes :: Bool + } parseCmdLine :: Parser CmdLine -parseCmdLine = CmdLine <$> (parsegraphviz <|> pure Test) +parseCmdLine = CmdLine <$> ((Graphviz <$> parsegraphviz) <|> pure Test) where - parsegraphviz = Graphviz <$> option str - ( long "graphviz" - <> metavar "logfile" - <> help "visualize log file with graphviz" - ) + parsegraphviz = GraphvizOpts + <$> option str + ( long "graphviz" + <> metavar "logfile" + <> help "visualize log file with graphviz" + ) + <*> switch + ( long "show-hashes" + <> help "display hashes in graphviz" + ) getCmdLine :: IO CmdLine getCmdLine = execParser opts diff --git a/Graphviz.hs b/Graphviz.hs index d4db9d3..6a5cb52 100644 --- a/Graphviz.hs +++ b/Graphviz.hs @@ -4,6 +4,7 @@ module Graphviz (graphviz) where import Types import Hash +import CmdLine import Data.Aeson import Data.Char @@ -21,13 +22,13 @@ import qualified Data.Text.Lazy as T import qualified Data.Text.Lazy.Encoding as T import Data.Text.Encoding.Error -graphviz :: FilePath -> IO () -graphviz logfile = do - parsed <- parseLog <$> L.readFile logfile +graphviz :: GraphvizOpts -> IO () +graphviz opts = do + parsed <- parseLog <$> L.readFile (graphvizLogFile opts) case lefts parsed of [] -> do - let g = genGraph (rights parsed) - f <- createImage logfile Png g + let g = genGraph opts (rights parsed) + f <- createImage (graphvizLogFile opts) Png g putStrLn ("Generated " ++ f) errs -> error $ unlines errs @@ -43,8 +44,8 @@ nl = fromIntegral (ord '\n') createImage :: PrintDotRepr dg n => FilePath -> GraphvizOutput -> dg n -> IO FilePath createImage f o g = Data.GraphViz.addExtension (runGraphvizCommand Dot g) o f -genGraph :: [ActivityLog] -> G.DotGraph T.Text -genGraph ls = digraph (Str "debug-me") $ do +genGraph :: GraphvizOpts -> [ActivityLog] -> G.DotGraph T.Text +genGraph opts ls = digraph (Str "debug-me") $ do nodeAttrs [style filled] forM_ ls $ showactivity [ xcolor Green ] @@ -76,8 +77,9 @@ genGraph ls = digraph (Str "debug-me") $ do Nothing -> return () Just p -> link p h s link a b s = edge (display a) (display b) $ s ++ - [ textLabel (shorthash a) - ] + if graphvizShowHashes opts + then [ textLabel (shorthash a) ] + else [] -- The "h:" prefix is to work around this bug: -- https://github.com/ivan-m/graphviz/issues/16 shorthash h = display $ Val $ "h:" <> (B.take 5 $ val $ hashValue h) diff --git a/debug-me.hs b/debug-me.hs index 7a9f527..25f216b 100644 --- a/debug-me.hs +++ b/debug-me.hs @@ -26,7 +26,7 @@ main = do c <- getCmdLine case mode c of Test -> test - Graphviz logfile -> graphviz logfile + Graphviz g -> graphviz g test :: IO () test = do |