hp2pretty 0.9 → 0.10

raw patch · 11 files changed

+39/−36 lines, 11 files

Files

THANKS +1/−0
hp2pretty.cabal +8/−4
src/Bands.hs +3/−3
src/Graphics.hs +1/−1
src/Main.hs +11/−13
src/Pretty.hs +1/−1
src/Print.hs +1/−1
src/Prune.hs +1/−1
src/SVG.hs +2/−2
src/Total.hs +2/−2
src/Types.hs +8/−8

THANKS view

@@ -2,3 +2,4 @@ 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)+David Hewson (lazy text streaming for very large files)

hp2pretty.cabal view

@@ -1,5 +1,5 @@ Name:                hp2pretty-Version:             0.9+Version:             0.10 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,9 @@                      Vector Graphics (SVG) only, though PostScript (PS) is planned.                      Not all of hp2ps' options are implemented yet in hp2pretty.                      .+                     In hp2pretty-0.10 parsing of very large files is made possible+                     by reading the file(s) twice as Text.Lazy.+                     .                      In hp2pretty-0.9 a mode for detached key is added:                      .                      > hp2pretty --key=inline *.hp@@ -62,7 +65,7 @@ License-file:        LICENSE Author:              Claude Heiland-Allen Maintainer:          claude@mathr.co.uk-Copyright:           (C) 2010,2011,2015,2017,2018  Claude Heiland-Allen+Copyright:           (C) 2010,2011,2015,2017,2018,2021  Claude Heiland-Allen Category:            Development Build-type:          Simple Extra-source-files:@@ -76,7 +79,7 @@   examples/Makefile   examples/report.tex -Cabal-version:       >=1.6+Cabal-version:       >=1.10  Executable hp2pretty   Build-depends:       base >= 4 && < 5,@@ -91,6 +94,7 @@                        text   GHC-options:         -Wall -rtsopts   HS-source-dirs:      src+  Default-Language:    Haskell2010   Main-is:             Main.hs   Other-modules:       Args                        Types@@ -110,4 +114,4 @@ Source-repository this   type:                git   location:            https://code.mathr.co.uk/hp2pretty.git-  tag:                 v0.9+  tag:                 v0.10

src/Bands.hs view

@@ -8,8 +8,8 @@ import Data.Array.Unboxed (UArray) import Data.Map (Map, lookup, size) import Prelude hiding (lookup, lines, words, length)-import Data.Text (Text, pack, unpack, lines, words, isPrefixOf, length)-import qualified Data.Text as T+import Data.Text.Lazy (Text, pack, unpack, lines, words, isPrefixOf, length, toStrict)+import qualified Data.Text.Lazy as T import Data.Attoparsec.Text (parseOnly, double)  import Types@@ -47,7 +47,7 @@   else error $ "Parse.sampleTime: expected " ++ unpack name ++ " but got " ++ unpack h  readDouble :: Text -> Double-readDouble s = case parseOnly double s of+readDouble s = case parseOnly double (toStrict s) of   Right x -> x   _ -> error $ "Parse.readDouble: no parse " ++ unpack s

src/Graphics.hs view

@@ -1,6 +1,6 @@ module Graphics where -import Data.Text (Text, foldl')+import Data.Text.Lazy (Text, foldl') import Data.Char (ord) import Data.Bits (shiftR) import Data.Int (Int32, Int64)

src/Main.hs view

@@ -3,8 +3,8 @@ module Main (main) where  import Prelude hiding (print, readFile)-import Data.Text.IO (readFile, hPutStr, hPutStrLn)-import qualified Data.Text as T+import Data.Text.Lazy.IO (readFile, hPutStr, hPutStrLn)+import qualified Data.Text.Lazy as T import Control.Monad (forM, forM_, when) import Data.List (foldl1', nub) import Data.Tuple (swap)@@ -42,26 +42,24 @@   when (null (files a)) exitSuccess   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+      (header, totals) <- total <$> readFile file+      let keeps = prune cmp (tracePercent a) (bound $ nBands a) totals+      (times, vals) <- bands header keeps <$> readFile file+      let ((sticks, vticks), (labels, coords)) = pretty header vals keeps           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-          (smima, vmima) = foldl1' (\((!smi, !sma), (!vmi, !vma)) ((!smi', !sma'), (!vmi', !vma')) -> ((smi`min`smi', sma`max`sma'), (vmi`min`vmi', vma`max`vma'))) . map (\(h, _) -> (hSampleRange h, hValueRange h)) $ hts0+      hts0 <- map total <$> mapM readFile (files a)+      let (smima, vmima) = foldl1' (\((!smi, !sma), (!vmi, !vma)) ((!smi', !sma'), (!vmi', !vma')) -> ((smi`min`smi', sma`max`sma'), (vmi`min`vmi', vma`max`vma'))) . map (\(h, _) -> (hSampleRange h, hValueRange h)) $ hts0           hts1 | uniformTime = map (\(h, t) -> (h{ hSampleRange = smima }, t)) hts0                | 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 (zip (files a) hts) $ \(file, (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+        (times, vals) <- bands header keeps <$> readFile file+        let ((sticks, vticks), (labels, coords)) = pretty header vals keeps             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)

src/Pretty.hs view

@@ -4,7 +4,7 @@ import Data.Array.MArray (thaw) import Data.Array.ST (runSTUArray, writeArray, readArray) import Data.Array.Unboxed (UArray, bounds)-import Data.Text (Text, pack)+import Data.Text.Lazy (Text, pack) import Data.List (sortBy) import Data.Map (Map, toList) import Data.Ord (comparing)

src/Print.hs view

@@ -2,7 +2,7 @@  import Prelude hiding (print) import Data.Array.Unboxed (UArray, bounds, (!))-import Data.Text (Text, pack, unpack)+import Data.Text.Lazy (Text, pack, unpack) import Numeric (showFFloat) import System.FilePath (replaceExtension)

src/Prune.hs view

@@ -6,7 +6,7 @@   , cmpStdDev   ) where -import Data.Text (Text)+import Data.Text.Lazy (Text) import Data.List (foldl', sortBy) import Data.Ord (comparing) import Data.Map.Strict (Map, toList, fromList)

src/SVG.hs view

@@ -1,8 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} module SVG (svg, fillStyleName) where -import Data.Text (Text, pack)-import qualified Data.Text as T+import Data.Text.Lazy (Text, pack)+import qualified Data.Text.Lazy as T import Data.List (intersperse) import Data.Monoid ((<>), mconcat) import Numeric (showHex)

src/Total.hs view

@@ -5,7 +5,7 @@ import Data.List (foldl') import Data.Map (Map, empty, lookup, insert, alter) import Prelude hiding (init, lookup, lines, words, drop, length)-import Data.Text (Text, init, pack, unpack, lines, words, isPrefixOf, drop, length)+import Data.Text.Lazy (Text, init, pack, unpack, lines, words, isPrefixOf, drop, length, toStrict) import Data.Attoparsec.Text (parseOnly, double)  import Types@@ -100,7 +100,7 @@   else error $ "Parse.sampleTime: expected " ++ unpack name ++ " but got " ++ unpack h  readDouble :: Text -> Double-readDouble s = case parseOnly double s of+readDouble s = case parseOnly double (toStrict s) of   Right x -> x   _ -> error $ "Parse.readDouble: no parse " ++ unpack s

src/Types.hs view

@@ -1,14 +1,14 @@ module Types where -import Data.Text (Text)+import Data.Text.Lazy (Text)  data Header =   Header-  { hJob         :: Text-  , hDate        :: Text-  , hSampleUnit  :: Text-  , hValueUnit   :: Text-  , hSampleRange :: (Double, Double)-  , hValueRange  :: (Double, Double)-  , hCount       :: Int+  { hJob         :: !Text+  , hDate        :: !Text+  , hSampleUnit  :: !Text+  , hValueUnit   :: !Text+  , hSampleRange :: !(Double, Double)+  , hValueRange  :: !(Double, Double)+  , hCount       :: !Int   }