graph-trace-viz (empty) → 0.1.0.0
raw patch · 5 files changed
+215/−0 lines, 5 filesdep +basedep +bytestringdep +directory
Dependencies added: base, bytestring, directory, file-embed, graph-trace-dot, process
Files
- CHANGELOG.md +5/−0
- app/Main.hs +76/−0
- extras/footer.html +2/−0
- extras/header.html +85/−0
- graph-trace-viz.cabal +47/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for graph-trace-viz++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ app/Main.hs view
@@ -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 ()+
@@ -0,0 +1,2 @@+ </body>+</html>
+ extras/header.html view
@@ -0,0 +1,85 @@+<!DOCTYPE html>+<html lang="en">+ <head>+ <meta charset="utf-8"/>+ <script type="text/javascript">++const nodeCoords = {};++function scrollToPosition (x, y) {+ window.scrollTo (+ x - window.innerWidth / 2,+ y - window.innerHeight / 2+ );+};++window.onload = function () {+ const svgEl = document.getElementsByTagName("svg")[0].children[0];++ for (let i = 0; i < svgEl.children.length; i++) {+ const node = svgEl.children[i];+ // filter out non-nodes+ if (!node.classList.contains("node")) continue;++ const nodeName = node.children[0].textContent;+ const boundingRect = node.getBoundingClientRect();+ const position =+ { x: boundingRect.x + window.scrollX,+ y: boundingRect.y + window.scrollY };++ nodeCoords[nodeName] = position+ }++ function scrollToNode(event) {+ const nodeName = location.hash.slice(1);+ const pos = nodeCoords[decodeURI(nodeName)];+ if (pos) {+ event.preventDefault();+ scrollToPosition(pos.x, pos.y);+ history.pushState('', '', window.location.pathname)+ } else {+ console.log('Node not found: ' + nodeName);+ }+ };++ window.addEventListener('hashchange', scrollToNode, false);++ // Scroll to first node+ const firstNodePos = nodeCoords[Object.keys(nodeCoords)[0]];+ if (firstNodePos) {+ scrollToPosition(firstNodePos.x, firstNodePos.y);+ }++ document.getElementsByClassName("loading-backdrop")[0].remove();+};++ </script>+ <style>+ body {+ margin: 0;+ }++ .loading-backdrop {+ position: fixed;+ width: 100%;+ height: 100%;+ background-color: #00000040;+ }++ .loading-modal {+ padding: 30px;+ text-align: center;+ font-size: 1.5em;+ background-color: white;+ z-index: 1;+ left: 50%;+ top: 50%;+ transform: translate(-50%, -50%);+ position: absolute;+ }+ </style>+ </head>+ <body>+ <div class="loading-backdrop">+ <div class="loading-modal">Loading...</div>+ </div>
+ graph-trace-viz.cabal view
@@ -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