hp2pretty 0.8.0.2 → 0.9
raw patch · 15 files changed
+262/−40 lines, 15 filesdep ~containersbinary-added
Dependency ranges changed: containers
Files
- LICENSE +1/−1
- NEWS +7/−0
- README +10/−2
- THANKS +1/−0
- examples/Describe2.hp.gz binary
- examples/Makefile +19/−0
- examples/figure.sh +27/−0
- examples/html.sh +34/−0
- examples/report.tex +23/−0
- hp2pretty.cabal +36/−6
- src/Args.hs +26/−1
- src/Main.hs +36/−13
- src/Print.hs +35/−14
- src/Prune.hs +1/−1
- src/SVG.hs +6/−2
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c)2010,2011,2015,2017 Claude Heiland-Allen+Copyright (c)2010,2011,2015,2017,2018 Claude Heiland-Allen All rights reserved.
NEWS view
@@ -1,3 +1,10 @@+v0.9 2018-08-01 detach++New flags and features:+ --key=inline|FILE.txt (optionally generate detached key)+ --title=inline|FILE.txt (optionally generate detached title)++ v0.8.0.2 2017-06-29 imports Add imports to fix build with even older GHC versions.
README view
@@ -14,8 +14,9 @@ hp2pretty - generate pretty graphs from heap profiles - Usage: hp2pretty [--uniform-scale AXES] [--sort FIELD] [--reverse]- [--trace PERCENT] [--bands COUNT] [--pattern] FILES...+ Usage: hp2pretty [--uniform-scale AXES] [--sort FIELD] [--key KEY]+ [--title TITLE] [--reverse] [--trace PERCENT] [--bands COUNT]+ [--pattern] FILES... Convert heap profile FILES.hp to pretty graphs FILES.svg Available options:@@ -23,6 +24,13 @@ of: none (default), time, memory, both. --sort FIELD How to sort the bands. One of: size (default), stddev, name.+ --key KEY Whether to embed the key in the image output. One of:+ inline (default), FILE.txt. Use - for standard output+ and ./inline for a file named literally "inline".+ --title TITLE Whether to embed the title in the image output. One+ of: inline (default), FILE.txt. Use - for standard+ output and ./inline for a file named literally+ "inline". --reverse Reverse the order of bands. --trace PERCENT Percentage of trace elements to combine. (default: 1.0)
THANKS view
@@ -1,3 +1,4 @@ Ian Lynagh (label text XML escaping bugfix patch) Edward Z. Yang (feature requests for stable colours and uniform scales) Pepe Iborra (parsing bugfix)+Hans-Peter Deifel (bug report about truncated key with long SCC names)
+ examples/Describe2.hp.gz view
binary file changed (absent → 155669 bytes)
+ examples/Makefile view
@@ -0,0 +1,19 @@+all: report.pdf report.html++clean:+ -rm -f Describe2.hp Describe2.svg title.txt key.txt figure.tex++Describe2.hp: Describe2.hp.gz+ gunzip < Describe2.hp.gz > Describe2.hp++Describe2.svg title.txt key.txt: Describe2.hp+ hp2pretty --title=title.txt --key=key.txt --pattern --bands=5 Describe2.hp ++figure.tex: figure.sh title.txt key.txt Describe2.svg+ bash figure.sh title.txt key.txt > figure.tex++report.pdf: report.tex figure.tex $(wildcard *.svg)+ pdflatex -synctex=1 -interaction=nonstopmode --shell-escape report.tex++report.html: html.sh title.txt key.txt Describe2.svg $(wildcard *.svg)+ bash html.sh title.txt key.txt > report.html
+ examples/figure.sh view
@@ -0,0 +1,27 @@+#!/bin/bash+cat $1 |+while read svg rest+do+ re='^(.+) [(](.+)[)]$'+ if [[ $rest =~ $re ]]+ then+ title="${BASH_REMATCH[1]}"+ date="${BASH_REMATCH[2]}"+ printf '\\begin{figure}[!ht]\n'+ printf '\\centering\n'+ printf '\\caption{\\lstinline[columns=fixed]{%s} (%s)}\n' "${title}" "${date}"+ printf '\\includesvg[width=\\textwidth,pretex=\\small]{%s}\n' "${svg}"+ printf '\\end{figure}\n'+ fi+done+printf '\\begin{table}[!ht]\n'+printf '\\centering\n'+printf '\\caption{Legend}\n'+printf '\\begin{tabular}{cl}\n'+cat $2 | sed 's|\\|\\\\|g' |+while read svg label+do+ printf '\includesvg[width=0.02109375\\textwidth]{%s} & |%s| \\\\\n' "${svg}" "${label}"+done+printf '\\end{tabular}\n'+printf '\\end{table}\n'
+ examples/html.sh view
@@ -0,0 +1,34 @@+#!/bin/bash+cat <<END+<!DOCTYPE html>+<html>+<head>+<title>hp2pretty</title>+</head>+<body style="width:1280px;margin:auto;">+<h1>hp2pretty</h1>+END+cat $1 |+while read svg rest+do+ re='^(.+) [(](.+)[)]$'+ if [[ $rest =~ $re ]]+ then+ title="${BASH_REMATCH[1]}"+ date="${BASH_REMATCH[2]}"+ printf '<h2><code>%s</code> (%s)</h2>\n' "${title}" "${date}"+ printf '<img src="%s" />\n' "${svg}"+ fi+done+printf '<h2>Legend</h2>\n' "${title}" "${date}"+printf '<table>\n'+cat $2 | sed 's|\\|\\\\|g' |+while read svg label+do+ printf '<tr><td><img src="%s" /></td><td><code>%s</code></td></tr>\n' "${svg}" "${label}"+done+printf '</table>\n'+cat <<END+</body>+</html>+END
+ examples/report.tex view
@@ -0,0 +1,23 @@+\documentclass{article}+\usepackage[margin=2cm]{geometry}+\usepackage[utf8]{inputenc}+\usepackage{lmodern}+\usepackage{svg}++\usepackage{listings}+\lstMakeShortInline[columns=fixed]|++\renewcommand{\familydefault}{\sfdefault}++\title{Report}+\author{hp2pretty}+\date{\today}++\begin{document}++\maketitle++\input{figure.tex}++\end{document}+
hp2pretty.cabal view
@@ -1,5 +1,5 @@ Name: hp2pretty-Version: 0.8.0.2+Version: 0.9 Synopsis: generate pretty graphs from heap profiles Description: hp2pretty is a rewrite of hp2ps, implemented in Haskell, with the aims of being maintainable, with more flexible output, and@@ -7,6 +7,26 @@ Vector Graphics (SVG) only, though PostScript (PS) is planned. Not all of hp2ps' options are implemented yet in hp2pretty. .+ In hp2pretty-0.9 a mode for detached key is added:+ .+ > hp2pretty --key=inline *.hp+ > hp2pretty --key=key.txt *.hp+ > hp2pretty --key=- *.hp+ .+ The output file is an simple text file, that mentions additional+ SVG files for the legend - how you format it is up to you.+ .+ A mode for detached titles is also added:+ .+ > hp2pretty --title=inline *.hp+ > hp2pretty --title=title.txt *.hp+ > hp2pretty --title=- *.hp+ .+ The output file is an simple text file, that mentions the image+ SVG files. You could use this for figure captions, etc.+ .+ See the examples/ directory in the source distribution for hints.+ . In hp2pretty-0.8 output filtering and sorting flags are added, as well as low-ink pattern fills for printing: .@@ -37,22 +57,32 @@ cost label, which should make colours have stable semantics across program runs. -Homepage: https://code.mathr.co.uk/hp2pretty+Homepage: https://mathr.co.uk/blog/hp2pretty.html License: BSD3 License-file: LICENSE Author: Claude Heiland-Allen Maintainer: claude@mathr.co.uk-Copyright: (C) 2010,2011,2015,2017 Claude Heiland-Allen+Copyright: (C) 2010,2011,2015,2017,2018 Claude Heiland-Allen Category: Development Build-type: Simple-Extra-source-files: BUGS NEWS README THANKS+Extra-source-files:+ BUGS+ NEWS+ README+ THANKS+ examples/Describe2.hp.gz+ examples/figure.sh+ examples/html.sh+ examples/Makefile+ examples/report.tex+ Cabal-version: >=1.6 Executable hp2pretty Build-depends: base >= 4 && < 5, array, attoparsec,- containers,+ containers >= 0.5, filepath, floatshow, mtl,@@ -80,4 +110,4 @@ Source-repository this type: git location: https://code.mathr.co.uk/hp2pretty.git- tag: v0.8.0.2+ tag: v0.9
src/Args.hs view
@@ -1,14 +1,18 @@-module Args (args, Args(..), Uniform(..), Sort(..)) where+module Args (args, Args(..), Uniform(..), Sort(..), KeyPlace(..), TitlePlace(..)) where import Options.Applicative import Data.Semigroup ((<>)) data Uniform = None | Time | Memory | Both deriving (Eq) data Sort = Size | StdDev | Name+data KeyPlace = KeyInline | KeyFile FilePath+data TitlePlace = TitleInline | TitleFile FilePath data Args = Args { uniformity :: Uniform , sorting :: Sort+ , keyPlace :: KeyPlace+ , titlePlace :: TitlePlace , reversing :: Bool , tracePercent :: Double , nBands :: Int@@ -28,6 +32,16 @@ <> help "How to sort the bands. One of: size (default), stddev, name." <> value Size <> metavar "FIELD" )+ <*> option parseKey+ ( long "key"+ <> help "Whether to embed the key in the image output. One of: inline (default), FILE.txt. Use - for standard output and ./inline for a file named literally \"inline\"."+ <> value KeyInline+ <> metavar "KEY" )+ <*> option parseTitle+ ( long "title"+ <> help "Whether to embed the title in the image output. One of: inline (default), FILE.txt. Use - for standard output and ./inline for a file named literally \"inline\"."+ <> value TitleInline+ <> metavar "TITLE" ) <*> switch ( long "reverse" <> help "Reverse the order of bands." )@@ -65,6 +79,17 @@ "name" -> Right Name _ -> Left "expected one of: size, stddev, name" +parseKey :: ReadM KeyPlace+parseKey = eitherReader $ \s -> case s of+ "inline" -> Right KeyInline+ "" -> Left "expected one of: inline, FILE.txt"+ f -> Right (KeyFile f)++parseTitle :: ReadM TitlePlace+parseTitle = eitherReader $ \s -> case s of+ "inline" -> Right TitleInline+ "" -> Left "expected one of: inline, FILE.txt"+ f -> Right (TitleFile f) args :: IO Args args = execParser opts
src/Main.hs view
@@ -1,23 +1,24 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-} module Main (main) where import Prelude hiding (print, readFile)-import Data.Text.IO (readFile, hPutStr)-import Control.Monad (forM_, when)-import Data.List (foldl1', isPrefixOf, partition)+import Data.Text.IO (readFile, hPutStr, hPutStrLn)+import qualified Data.Text as T+import Control.Monad (forM, forM_, when)+import Data.List (foldl1', nub) import Data.Tuple (swap)-import Data.Monoid (Last(..), mconcat)-import System.Environment (getArgs)+import Data.Semigroup ((<>)) import System.Exit (exitSuccess) import System.FilePath (replaceExtension)-import System.IO (withFile, IOMode(WriteMode))+import System.IO (withFile, IOMode(WriteMode), stdout) -import Args (args, Args(..), Uniform(..), Sort(..))+import Args (args, Args(..), Uniform(..), Sort(..), KeyPlace(..), TitlePlace(..)) import Total (total) import Prune (prune, cmpName, cmpSize, cmpStdDev) import Bands (bands) import Pretty (pretty)-import Print (print)+import Print (print, printKey) import SVG (svg) import Types (Header(..)) @@ -32,16 +33,23 @@ StdDev -> cmpStdDev reversing' = if reversing a then swap else id cmp = fst $ reversing' sorting'+ sepkey = case keyPlace a of+ KeyInline -> False+ KeyFile{} -> True+ noTitle = case titlePlace a of+ TitleInline -> False+ TitleFile{} -> True when (null (files a)) exitSuccess- if not (uniformTime || uniformMemory)- then forM_ (files a) $ \file -> do+ labelss <- if not (uniformTime || uniformMemory)+ then forM (files a) $ \file -> do input <- readFile file let (header, totals) = total input keeps = prune cmp (tracePercent a) (bound $ nBands a) totals (times, vals) = bands header keeps input ((sticks, vticks), (labels, coords)) = pretty header vals keeps- outputs = print svg (patterned a) header sticks vticks labels times coords+ outputs = print svg noTitle sepkey (patterned a) header sticks vticks labels times coords withFile (replaceExtension file "svg") WriteMode $ \h -> mapM_ (hPutStr h) outputs+ return $ (header, reverse labels) else do inputs <- mapM readFile (files a) let hts0 = map total inputs@@ -50,12 +58,27 @@ | otherwise = hts0 hts | uniformMemory = map (\(h, t) -> (h{ hValueRange = vmima }, t)) hts1 | otherwise = hts1- forM_ (zip3 (files a) inputs hts) $ \(file, input, (header, totals)) -> do+ forM (zip3 (files a) inputs hts) $ \(file, input, (header, totals)) -> do let keeps = prune cmp (tracePercent a) (bound $ nBands a) totals (times, vals) = bands header keeps input ((sticks, vticks), (labels, coords)) = pretty header vals keeps- outputs = print svg (patterned a) header sticks vticks labels times coords+ outputs = print svg noTitle sepkey (patterned a) header sticks vticks labels times coords withFile (replaceExtension file "svg") WriteMode $ \h -> mapM_ (hPutStr h) outputs+ return $ (header, reverse labels)+ case keyPlace a of+ KeyFile keyFile -> (if keyFile == "-" then ($ stdout) else withFile keyFile WriteMode) $ \txt -> do+ forM_ (nub $ concatMap snd labelss) $ \label -> do+ let (filename, content) = printKey svg (patterned a) label+ withFile filename WriteMode $ \h -> mapM_ (hPutStr h) content+ hPutStrLn txt (T.pack filename <> " " <> label)+ _ -> return ()+ case titlePlace a of+ TitleFile titleFile -> (if titleFile == "-" then ($ stdout) else withFile titleFile WriteMode) $ \txt -> do+ forM_ (files a `zip` map fst labelss) $ \(file, header) -> do+ let filename = replaceExtension file "svg"+ title = hJob header <> " (" <> hDate header <> ")"+ hPutStrLn txt (T.pack filename <> " " <> title)+ _ -> return () bound :: Int -> Int bound n
src/Print.hs view
@@ -1,21 +1,26 @@-module Print (print) where+module Print (print, printKey) where import Prelude hiding (print) import Data.Array.Unboxed (UArray, bounds, (!))-import Data.Text (Text, pack)+import Data.Text (Text, pack, unpack) import Numeric (showFFloat)+import System.FilePath (replaceExtension) import Types import Graphics+import SVG (fillStyleName) first :: (a -> c) -> (a, b) -> (c, b) first f (a, b) = (f a, b) -print :: Graphics -> Bool -> Header -> [Double] -> [Double] -> [Text] -> UArray Int Double -> UArray (Int, Int) Double -> [Text]-print gfx patterned header sticks vticks labels times coords =+filled0 :: Graphics -> Either PatternID RGB -> [Text] -> [Text]+filled0 gfx c = visual gfx (Just c) Nothing Nothing Nothing++print :: Graphics -> Bool -> Bool -> Bool -> Header -> [Double] -> [Double] -> [Text] -> UArray Int Double -> UArray (Int, Int) Double -> [Text]+print gfx notitle sepkey patterned header sticks vticks labels times coords = let bands = toPoints (bounds coords) times coords- filled c = visual gfx (Just c) Nothing Nothing Nothing labels' = reverse labels+ filled = filled0 gfx (colours, defs) | patterned = first (map Left) . unzip $ map (pattern gfx) labels' | otherwise = (map (Right . colour) labels', [])@@ -27,13 +32,13 @@ text gfx Nothing Start 15 (x + dy, y + dy * 0.6) [l] w = 1280 h = 720- gW = 960 - 2 * border- gH = 720 - 3 * border+ gW = (if sepkey then 1280 else 960) - 2 * border+ gH = if notitle then 720 - 2 * border else 720 - 3 * border border = 60 textOffset = 10 (xMin, xMax) = hSampleRange header (yMin, yMax) = hValueRange header- gRange@((gx0,gy0),(gx1,gy1)) = ((border*1.5, gH + border*1.5), (gW + border*1.5, border*1.5))+ gRange@((gx0,gy0),(gx1,gy1)) = ((border*1.5, gH + if notitle then border*0.5 else border*1.5), (gW + border*1.5, if notitle then border*0.5 else border*1.5)) p = rescalePoint ((xMin, yMin), (xMax, yMax)) gRange title = text gfx Nothing Middle 25 (w / 2, border * 0.75) [hJob header, pack " (", hDate header, pack ")"] background = filled (Right white) $ rect gfx (0,0) (w,h)@@ -50,19 +55,35 @@ ) (zip sticks (replicate (length sticks - 1) False ++ [True])) in document gfx (w,h) (concat defs) . concat $ [ background- , visual gfx (Just (Right black)) Nothing (Just black) (Just 1) $ concat- [ title- , leftLabel+ , visual gfx (Just (Right black)) Nothing (Just black) (Just 1) $ concat $+ (if notitle then [] else [title]) +++ [ leftLabel , bottomLabel , leftTicks , bottomTicks- , visual gfx Nothing (Just 0.7) Nothing Nothing $ concat+ , visual gfx Nothing (Just 0.7) Nothing Nothing $ concat $ [ box , polygons- , key- ]+ ] ++ if sepkey then [] else [key] ] ]++printKey :: Graphics -> Bool {- ^ patterned -} -> Text -> (FilePath, [Text])+printKey gfx True label =+ let (pname, pdef) = pattern gfx label+ in printKey' gfx pdef (Left pname) label+printKey gfx False label =+ let cname = colour label+ in printKey' gfx [] (Right cname) label++printKey' :: Graphics -> [Text] -> Either PatternID RGB -> Text -> (FilePath, [Text])+printKey' gfx defs c label =+ ( replaceExtension (unpack (fillStyleName c)) "svg"+ , document gfx (boxSize, boxSize) defs (filled0 gfx c $ rect gfx (0, 0) (boxSize, boxSize))+ )++boxSize :: Double+boxSize = 27 toPoints :: ((Int,Int),(Int,Int)) -> UArray Int Double -> UArray (Int,Int) Double -> [[(Double,Double)]] toPoints ((b0,s0),(b1,s1)) times coords =
src/Prune.hs view
@@ -9,7 +9,7 @@ import Data.Text (Text) import Data.List (foldl', sortBy) import Data.Ord (comparing)-import Data.Map (Map, toList, fromList)+import Data.Map.Strict (Map, toList, fromList) type Compare a = a -> a -> Ordering
src/SVG.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}-module SVG (svg) where+module SVG (svg, fillStyleName) where import Data.Text (Text, pack) import qualified Data.Text as T@@ -10,7 +10,7 @@ import Graphics (Graphics(Graphics), Point, Size, Angle, FontSize, Anchor(..), StrokeWidth, Opacity, RGB(..), PatternID, colour, patternIx) import qualified Graphics as G-import Pattern (Pattern, patterns)+import Pattern (patterns) svg :: Graphics svg =@@ -96,3 +96,7 @@ showF :: Double -> Text showF x = pack $ fshow (D7 x)++fillStyleName :: Either PatternID RGB -> Text+fillStyleName (Left c) = T.drop 5 (T.init c)+fillStyleName (Right c) = T.singleton 'C' <> T.tail (showRGB c)