diff --git a/THANKS b/THANKS --- a/THANKS +++ b/THANKS @@ -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) diff --git a/hp2pretty.cabal b/hp2pretty.cabal --- a/hp2pretty.cabal +++ b/hp2pretty.cabal @@ -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 diff --git a/src/Bands.hs b/src/Bands.hs --- a/src/Bands.hs +++ b/src/Bands.hs @@ -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 diff --git a/src/Graphics.hs b/src/Graphics.hs --- a/src/Graphics.hs +++ b/src/Graphics.hs @@ -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) diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -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) diff --git a/src/Pretty.hs b/src/Pretty.hs --- a/src/Pretty.hs +++ b/src/Pretty.hs @@ -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) diff --git a/src/Print.hs b/src/Print.hs --- a/src/Print.hs +++ b/src/Print.hs @@ -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) diff --git a/src/Prune.hs b/src/Prune.hs --- a/src/Prune.hs +++ b/src/Prune.hs @@ -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) diff --git a/src/SVG.hs b/src/SVG.hs --- a/src/SVG.hs +++ b/src/SVG.hs @@ -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) diff --git a/src/Total.hs b/src/Total.hs --- a/src/Total.hs +++ b/src/Total.hs @@ -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 diff --git a/src/Types.hs b/src/Types.hs --- a/src/Types.hs +++ b/src/Types.hs @@ -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 }