packages feed

hp2pretty 0.5 → 0.6

raw patch · 12 files changed

+76/−76 lines, 12 filesdep +textdep −bytestring

Dependencies added: text

Dependencies removed: bytestring

Files

BUGS view
@@ -1,8 +1,1 @@ empty heap profile gives NaN in SVG - detect and abort?-use Text for correct unicode instead of ByteString-	$ ./unicode +RTS -h-	$ hp2pretty unicode.hp-	$ rsvg unicode.svg unicode.png-	Error reading SVG:Error domain 1 code 9 on line 83 column 39 unicode.svg: Input is not proper UTF-8, indicate encoding !-	Bytes: 0xF8 0x62 0x2F 0x6D-	$
NEWS view
@@ -1,3 +1,8 @@+v0.6	2015-04-08	text++ByteString is replaced by Text, fixing bugs with Unicode.++ v0.5	2011-10-15	acceleration  Vastly improved runtime performance thanks to 'floatshow'
hp2pretty.cabal view
@@ -1,5 +1,5 @@ Name:                hp2pretty-Version:             0.5+Version:             0.6 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@@ -8,6 +8,9 @@                      Also none (count'em) of hp2ps' options are implemented yet in                      hp2pretty.                      .+                     In hp2pretty-0.6 ByteString is replaced by Text, fixing bugs+                     with Unicode.+                     .                      In hp2pretty-0.5 using attoparsec and floatshow internally                      should give a healthy speedup.                      .@@ -25,21 +28,20 @@                      cost label, which should make colours have stable semantics                      across program runs. -Homepage:            http://gitorious.org/hp2pretty+Homepage:            http://code.mathr.co.uk/hp2pretty License:             BSD3 License-file:        LICENSE Author:              Claude Heiland-Allen-Maintainer:          claudiusmaximus@goto10.org-Copyright:           (C) 2010,2011  Claude Heiland-Allen+Maintainer:          claude@mathr.co.uk+Copyright:           (C) 2010,2011,2015  Claude Heiland-Allen Category:            Development Build-type:          Simple Extra-source-files:  BUGS NEWS README THANKS Cabal-version:       >=1.6  Executable hp2pretty-  Build-depends:       base >= 4 && < 5, array, attoparsec, bytestring, containers, filepath, floatshow, mtl+  Build-depends:       base >= 4 && < 5, array, attoparsec, containers, filepath, floatshow, mtl, text   GHC-options:         -Wall -rtsopts-  GHC-prof-options:    -prof -auto-all -caf-all   HS-source-dirs:      src   Main-is:             Main.hs   Other-modules:       Types@@ -53,9 +55,9 @@  Source-repository head   type:                git-  location:            git://gitorious.org/hp2pretty/hp2pretty.git+  location:            http://code.mathr.co.uk/hp2pretty.git  Source-repository this   type:                git-  location:            git://gitorious.org/hp2pretty/hp2pretty.git-  tag:                 v0.5+  location:            http://code.mathr.co.uk/hp2pretty.git+  tag:                 v0.6
src/Bands.hs view
@@ -8,13 +8,13 @@ import Data.Array.Unboxed (UArray) import Data.Map (Map, lookup, size) import Prelude hiding (lookup, lines, words, length)-import Data.ByteString.Char8 (ByteString, pack, unpack, lines, words, isPrefixOf, length)-import qualified Data.ByteString.Char8 as BS-import Data.Attoparsec.Char8 (parseOnly, double)+import Data.Text (Text, pack, unpack, lines, words, isPrefixOf, length)+import qualified Data.Text as T+import Data.Attoparsec.Text (parseOnly, double)  import Types -bands :: Header -> Map ByteString Int -> ByteString -> (UArray Int Double, UArray (Int, Int) Double)+bands :: Header -> Map Text Int -> Text -> (UArray Int Double, UArray (Int, Int) Double) bands h bs input = runST $ do   times <- newArray (1, hCount h) 0   vals  <- newArray ((-1,1), (size bs, hCount h)) 0@@ -30,7 +30,7 @@   vals'  <- unsafeFreezeSTUArray vals   return (times', vals') -chunkSamples :: [ByteString] -> [[ByteString]]+chunkSamples :: [Text] -> [[Text]] chunkSamples [] = [] chunkSamples (x:xs)   | sBEGIN_SAMPLE `isPrefixOf` x =@@ -40,17 +40,17 @@             (_:ws) -> (x:ys) : chunkSamples ws   | otherwise = [] -- expected BEGIN_SAMPLE or EOF... -sampleTime :: ByteString -> ByteString -> Double+sampleTime :: Text -> Text -> Double sampleTime name h =   if name `isPrefixOf` h-  then readDouble .  BS.drop (length name + 1) $ h+  then readDouble .  T.drop (length name + 1) $ h   else error $ "Parse.sampleTime: expected " ++ unpack name ++ " but got " ++ unpack h -readDouble :: ByteString -> Double+readDouble :: Text -> Double readDouble s = case parseOnly double s of   Right x -> x   _ -> error $ "Parse.readDouble: no parse " ++ unpack s -sBEGIN_SAMPLE, sEND_SAMPLE :: ByteString+sBEGIN_SAMPLE, sEND_SAMPLE :: Text sBEGIN_SAMPLE = pack "BEGIN_SAMPLE" sEND_SAMPLE = pack "END_SAMPLE"
src/Graphics.hs view
@@ -1,6 +1,6 @@ module Graphics where -import Data.ByteString.Char8 (ByteString, foldl')+import Data.Text (Text, foldl') import Data.Char (ord) import Data.Bits (shiftR) import Data.Int (Int32, Int64)@@ -18,12 +18,12 @@  data Graphics =   Graphics-  { text     :: Maybe Angle -> Anchor -> FontSize -> Point -> [ByteString] -> [ByteString]-  , rect     :: Point -> Size -> [ByteString]-  , line     :: Point -> Point -> [ByteString]-  , polygon  :: [Point] -> [ByteString]-  , visual   :: Maybe RGB -> Maybe Opacity -> Maybe RGB -> Maybe StrokeWidth -> [ByteString] -> [ByteString]-  , document :: Size -> [ByteString] -> [ByteString]+  { text     :: Maybe Angle -> Anchor -> FontSize -> Point -> [Text] -> [Text]+  , rect     :: Point -> Size -> [Text]+  , line     :: Point -> Point -> [Text]+  , polygon  :: [Point] -> [Text]+  , visual   :: Maybe RGB -> Maybe Opacity -> Maybe RGB -> Maybe StrokeWidth -> [Text] -> [Text]+  , document :: Size -> [Text] -> [Text]   }  rescalePoint :: (Point,Point) -> (Point,Point) -> Point -> Point@@ -38,10 +38,10 @@ black = RGB 0 0 0 white = RGB 1 1 1 -colour :: ByteString -> RGB+colour :: Text -> RGB colour s = hsvToRGB (c 0x12345) (c 0x6789a) (c 0xbcdef)   where-    c m = fromIntegral (hashByteString m s) * 667 / fromIntegral (maxBound :: Int32)+    c m = fromIntegral (hashText m s) * 667 / fromIntegral (maxBound :: Int32)  hsvToRGB :: Double -> Double -> Double -> RGB hsvToRGB h0 s0 v0 =@@ -64,8 +64,8 @@ -- hashing functions copied and modified from BSD-style LICENSE'd -- base-4.3.1.0:Data.HashTable (c) The University of Glasgow 2003 -hashByteString :: Int32 -> ByteString -> Int32-hashByteString magic = foldl' f golden+hashText :: Int32 -> Text -> Int32+hashText magic = foldl' f golden   where f m c = fromIntegral (ord c) * magic + hashInt32 m  hashInt32 :: Int32 -> Int32
src/Main.hs view
@@ -2,7 +2,7 @@ module Main (main) where  import Prelude hiding (print, readFile)-import Data.ByteString.Char8 (readFile, hPutStr)+import Data.Text.IO (readFile, hPutStr) import Control.Monad (forM_, when) import Data.List (foldl1', isPrefixOf, partition) import Data.Monoid (Last(..), mconcat)
src/Pretty.hs view
@@ -4,14 +4,14 @@ import Data.Array.MArray (thaw) import Data.Array.ST (runSTUArray, writeArray, readArray) import Data.Array.Unboxed (UArray, bounds)-import Data.ByteString.Char8 (ByteString, pack)+import Data.Text (Text, pack) import Data.List (sortBy) import Data.Map (Map, toList) import Data.Ord (comparing)  import Types -pretty :: Header -> UArray (Int, Int) Double -> Map ByteString Int -> (([Double], [Double]), ([ByteString], UArray (Int, Int) Double))+pretty :: Header -> UArray (Int, Int) Double -> Map Text Int -> (([Double], [Double]), ([Text], UArray (Int, Int) Double)) pretty header vals bs =   let sticks = uncurry (ticks 20) (hSampleRange header)       vticks = uncurry (ticks 20) (hValueRange header)
src/Print.hs view
@@ -2,13 +2,13 @@  import Prelude hiding (print) import Data.Array.Unboxed (UArray, bounds, (!))-import Data.ByteString.Char8 (ByteString, pack)+import Data.Text (Text, pack) import Numeric (showFFloat)  import Types import Graphics -print :: Graphics -> Header -> [Double] -> [Double] -> [ByteString] -> UArray Int Double -> UArray (Int, Int) Double -> [ByteString]+print :: Graphics -> Header -> [Double] -> [Double] -> [Text] -> UArray Int Double -> UArray (Int, Int) Double -> [Text] print gfx header sticks vticks labels times coords =   let bands = toPoints (bounds coords) times coords       filled c = visual gfx (Just c) Nothing Nothing Nothing@@ -71,7 +71,7 @@     up   b = [s0 + b - b .. s1]     down b = [s1 + b - b, s1 - 1 .. s0] -showSI :: Double -> [ByteString]+showSI :: Double -> [Text] showSI x | x < 1e3   = [ showF  x       ""  ]          | x < 1e6   = [ showF (x/1e3 ) "k" ]          | x < 1e9   = [ showF (x/1e6 ) "M" ]
src/Prune.hs view
@@ -1,11 +1,11 @@ module Prune (prune) where -import Data.ByteString.Char8 (ByteString)+import Data.Text (Text) import Data.List (foldl', sortBy) import Data.Ord (comparing) import Data.Map (Map, toList, fromList) -prune :: Map ByteString Double -> Map ByteString Int+prune :: Map Text Double -> Map Text Int prune ts =   let ccTotals = sortBy (flip $ comparing snd) (toList ts)       sizes = map snd ccTotals
src/SVG.hs view
@@ -1,8 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} module SVG (svg) where -import Data.ByteString.Char8 (ByteString, pack)-import qualified Data.ByteString.Char8 as BS+import Data.Text (Text, pack)+import qualified Data.Text as T import Numeric (showHex) import Text.FShow.RealFloat (fshow, Double7(D7)) @@ -20,7 +20,7 @@   , G.document = document   } -text :: Maybe Angle -> Anchor -> FontSize -> Point -> [ByteString] -> [ByteString]+text :: Maybe Angle -> Anchor -> FontSize -> Point -> [Text] -> [Text] text r a s (x,y) inner =   let coords = case r of         Nothing -> ["x='", showF x, "' y='", showF y, "'"]@@ -30,21 +30,21 @@       showAnchor End = "end"   in  ["<text "] ++ coords ++ [" font-size='", showF s, "' text-anchor='", showAnchor a, "'>"] ++ map escape inner ++ ["</text>\n"] -escape :: ByteString -> ByteString-escape = BS.concatMap escapeChar+escape :: Text -> Text+escape = T.concatMap escapeChar   where     escapeChar '<' = "&lt;"     escapeChar '>' = "&gt;"     escapeChar '&' = "&amp;"-    escapeChar c   = BS.singleton c+    escapeChar c   = T.singleton c -rect :: Point -> Size -> [ByteString]+rect :: Point -> Size -> [Text] rect (x,y) (w,h) = ["<rect x='", showF x, "' y='", showF y, "' width='" , showF w , "' height='" , showF h , "' />\n"] -line :: Point -> Point -> [ByteString]+line :: Point -> Point -> [Text] line (x1,y1) (x2,y2) = ["<line x1='" , showF x1, "' x2='", showF x2, "' y1='", showF y1, "' y2='", showF y2, "' />\n"] -visual :: Maybe RGB -> Maybe Opacity -> Maybe RGB -> Maybe StrokeWidth -> [ByteString] -> [ByteString]+visual :: Maybe RGB -> Maybe Opacity -> Maybe RGB -> Maybe StrokeWidth -> [Text] -> [Text] visual mfill mfillo mstroke mstrokew inner =   let fill = maybe [] (\f -> [" fill='", showRGB f, "'"]) mfill       fillo = maybe [] (\o -> [" fill-opacity='", showF o, "'"]) mfillo@@ -52,30 +52,30 @@       strokew = maybe [] (\w -> [" stroke-width='", showF w, "'"]) mstrokew   in ["<g"] ++ fill ++ fillo ++ stroke ++ strokew ++ [">\n"] ++ inner ++ ["</g>\n"] -document :: Size -> [ByteString] -> [ByteString]+document :: Size -> [Text] -> [Text] document (w,h) inner =   [ "<?xml version='1.0' encoding='UTF-8' ?>\n"   , "<svg xmlns='http://www.w3.org/2000/svg' version='1.0'"   , " width='", showF w, "' height='", showF h, "'>\n"   ] ++ inner ++ ["</svg>\n"] -polygon :: [Point] -> [ByteString]+polygon :: [Point] -> [Text] polygon ps = ["<path d='"] ++ path ps ++ ["' />"] -path :: [(Double,Double)] -> [ByteString]+path :: [(Double,Double)] -> [Text] path [] = error "SVG.path: empty" path (p0:ps) =   let lineTo p = [ " L " ] ++ showP p   in  [ "M " ] ++ showP p0 ++ concatMap lineTo (ps ++ [p0]) ++ [ " Z" ] -showRGB :: RGB -> ByteString+showRGB :: RGB -> Text showRGB (RGB r g b) =   let toInt x = let y = floor (256 * x) in 0 `max` y `min` 255 :: Int       hex2 i = (if i < 16 then ('0':) else id) (showHex i "")   in  pack $ '#' : concatMap (hex2 . toInt) [r,g,b] -showP :: Point -> [ByteString]+showP :: Point -> [Text] showP (x,y) = [showF x, ",", showF y] -showF :: Double -> ByteString+showF :: Double -> Text showF x = pack $ fshow (D7 x)
src/Total.hs view
@@ -5,15 +5,15 @@ import Data.List (foldl') import Data.Map (Map, empty, lookup, insert, alter) import Prelude hiding (lookup, lines, words, drop, length)-import Data.ByteString.Char8 (ByteString, pack, unpack, lines, words, isPrefixOf, drop, length)-import Data.Attoparsec.Char8 (parseOnly, double)+import Data.Text (Text, pack, unpack, lines, words, isPrefixOf, drop, length)+import Data.Attoparsec.Text (parseOnly, double)  import Types  data Parse =   Parse-  { symbols   :: !(Map ByteString ByteString) -- intern symbols to save RAM-  , totals    :: !(Map ByteString Double    ) -- compute running totals+  { symbols   :: !(Map Text Text) -- intern symbols to save RAM+  , totals    :: !(Map Text Double    ) -- compute running totals   , sampleMin :: !Double   , sampleMax :: !Double   , valueMin  :: !Double@@ -24,7 +24,7 @@ parse0 :: Parse parse0 = Parse{ symbols = empty, totals = empty, sampleMin = 0, sampleMax = 0, valueMin = 0, valueMax = 0, count = 0 } -total :: ByteString -> (Header, Map ByteString Double)+total :: Text -> (Header, Map Text Double) total s =   let ls = lines s       (hs, ss) = splitAt 4 ls@@ -43,13 +43,13 @@       , totals parse1       ) -header :: ByteString -> ByteString -> ByteString+header :: Text -> Text -> Text header name h =   if name `isPrefixOf` h   then pack . read . unpack . drop (length name + 1) $ h   else error $ "Parse.header: expected " ++ unpack name -chunkSamples :: [ByteString] -> [[ByteString]]+chunkSamples :: [Text] -> [[Text]] chunkSamples [] = [] chunkSamples (x:xs)   | sBEGIN_SAMPLE `isPrefixOf` x =@@ -59,7 +59,7 @@             (_:ws) -> (x:ys) : chunkSamples ws   | otherwise = [] -- expected BEGIN_SAMPLE or EOF... -parseFrame :: [ByteString] -> State Parse ()+parseFrame :: [Text] -> State Parse () parseFrame [] = error "Parse.parseFrame: empty" parseFrame (l:ls) = do   let !time = sampleTime sBEGIN_SAMPLE l@@ -72,7 +72,7 @@       vMax = v `max` valueMax p   put $! p{ count = count p + 1, sampleMin = sMin, sampleMax = sMax, valueMin = vMin, valueMax = vMax } -inserter :: ByteString -> State Parse Double+inserter :: Text -> State Parse Double inserter s = do   let [k,vs] = words s       !v = readDouble vs@@ -90,18 +90,18 @@ accum x Nothing  = Just x accum x (Just y) = Just $! x + y -sampleTime :: ByteString -> ByteString -> Double+sampleTime :: Text -> Text -> Double sampleTime name h =   if name `isPrefixOf` h   then readDouble .  drop (length name + 1) $ h   else error $ "Parse.sampleTime: expected " ++ unpack name ++ " but got " ++ unpack h -readDouble :: ByteString -> Double+readDouble :: Text -> Double readDouble s = case parseOnly double s of   Right x -> x   _ -> error $ "Parse.readDouble: no parse " ++ unpack s -sJOB, sDATE, sSAMPLE_UNIT, sVALUE_UNIT, sBEGIN_SAMPLE, sEND_SAMPLE :: ByteString+sJOB, sDATE, sSAMPLE_UNIT, sVALUE_UNIT, sBEGIN_SAMPLE, sEND_SAMPLE :: Text sJOB = pack "JOB" sDATE = pack "DATE" sSAMPLE_UNIT = pack "SAMPLE_UNIT"
src/Types.hs view
@@ -1,13 +1,13 @@ module Types where -import Data.ByteString.Char8 (ByteString)+import Data.Text (Text)  data Header =   Header-  { hJob         :: ByteString-  , hDate        :: ByteString-  , hSampleUnit  :: ByteString-  , hValueUnit   :: ByteString+  { hJob         :: Text+  , hDate        :: Text+  , hSampleUnit  :: Text+  , hValueUnit   :: Text   , hSampleRange :: (Double, Double)   , hValueRange  :: (Double, Double)   , hCount       :: Int