diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for graph-trace-viz + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module Main where + +import Control.Monad +import qualified Data.ByteString as BS +import qualified Data.ByteString.Builder as BSB +import qualified Data.ByteString.Lazy as BSL +import Data.FileEmbed (embedFile) +import Data.Foldable (for_) +import qualified Data.List as List +import Data.Maybe (isJust) +import qualified System.Directory as Dir +import System.Environment +import System.Exit (die) +import System.IO +import qualified System.Process as Proc + +import qualified Graph.Trace.Dot as Dot + +main :: IO () +main = do + args <- getArgs + + traceFiles <- case args of + [] -> do + contents <- Dir.listDirectory =<< Dir.getCurrentDirectory + let isTraceFile = (".trace" `List.isSuffixOf`) + pure $ filter isTraceFile contents + xs -> pure xs + + for_ traceFiles $ \traceFile -> do + logContents + <- either (\err -> fail $ "Failed parsing trace file: " <> err) id + . Dot.parseLogEntries + <$> BSL.readFile traceFile + + let dotFileContent = Dot.graphToDot $ Dot.buildGraph logContents + fileName = (<> ".html") + $ if ".trace" `List.isSuffixOf` traceFile + then reverse . drop 6 $ reverse traceFile + else traceFile + + htmlHeader = $(embedFile "extras/header.html") + htmlFooter = $(embedFile "extras/footer.html") + + dotExists <- isJust <$> Dir.findExecutable "dot" + unless dotExists $ die "Error! Graphviz is not installed or not accessible" + + withFile fileName WriteMode $ \h -> do + hSetBinaryMode h True + hSetBuffering h (BlockBuffering Nothing) + BS.hPut h htmlHeader + writeSvg h dotFileContent + BS.hPut h htmlFooter + +-- | Invoke @dot@ to produce an svg document and write to the file handle +writeSvg :: Handle -> BSB.Builder -> IO () +writeSvg htmlFile dotContent = + Proc.withCreateProcess (Proc.proc "dot" ["-Tsvg"]) + { Proc.std_in = Proc.CreatePipe + , Proc.std_out = Proc.CreatePipe + } go + where + go (Just stdIn) (Just stdOut) _ _ = do + hSetBinaryMode stdIn True + hSetBuffering stdIn (BlockBuffering Nothing) + hSetBinaryMode stdOut True + hSetBuffering stdOut (BlockBuffering Nothing) + _ <- BSB.hPutBuilder stdIn dotContent + hClose stdIn + svg <- BSL.hGetContents stdOut + BSL.hPut htmlFile svg + hClose stdOut + go _ _ _ _ = pure () + diff --git a/extras/footer.html b/extras/footer.html new file mode 100644 --- /dev/null +++ b/extras/footer.html @@ -0,0 +1,2 @@ + + diff --git a/extras/header.html b/extras/header.html new file mode 100644 --- /dev/null +++ b/extras/header.html @@ -0,0 +1,85 @@ + + + + + + + + +
+
Loading...
+
diff --git a/graph-trace-viz.cabal b/graph-trace-viz.cabal new file mode 100644 --- /dev/null +++ b/graph-trace-viz.cabal @@ -0,0 +1,47 @@ +cabal-version: 2.4 +name: graph-trace-viz +version: 0.1.0.0 + +synopsis: + Converts a graph-trace log into an HTML document + +description: + Creates an HTML document with an explorable graph which represents + the execution of a program. Each unique invocation of a function is + represented as an edge in the graph. + . + See the [README](https://github.com/aaronallen8455/graph-trace#graph-trace) for details. + +-- A URL where users can report bugs. +bug-reports: https://github.com/aaronallen8455/graph-trace/issues + +-- The license under which the package is released. +license: MIT + +-- The package author(s). +-- author: +maintainer: aaronallen8455@gmail.com + +-- A copyright notice. +copyright: Copyright (C) 2022 Aaron Allen +category: tooling, debug, development, graph, plugin +extra-source-files: CHANGELOG.md, extras/*.html +tested-with: GHC==9.2.1, GHC==9.0.1, GHC==8.10.7 + +executable graph-trace-viz + main-is: Main.hs + + -- Modules included in this executable, other than Main. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + build-depends: base >= 4.9 && < 5, + graph-trace-dot, + process, + bytestring, + file-embed, + directory + hs-source-dirs: app + default-language: Haskell2010 + ghc-options: -Wall