zoom-cache 0.6.0.0 → 0.7.0.0

raw patch · 16 files changed

+321/−136 lines, 16 filesdep +iteratee-compressdep +zlibPVP ok

version bump matches the API change (PVP)

Dependencies added: iteratee-compress, zlib

API changes (from Hackage documentation)

Files

• Blaze/ByteString/Builder/ZoomCache/Internal.hs +11/−4
• Data/Iteratee/ZoomCache.hs +87/−60
• Data/ZoomCache/Codec.hs +4/−1
• Data/ZoomCache/Common.hs +1/−1
• Data/ZoomCache/Format.hs +7/−3
• Data/ZoomCache/Numeric/Delta.hs +35/−0
• Data/ZoomCache/Numeric/IEEE754.hs +6/−3
• Data/ZoomCache/Numeric/Int.hs +18/−7
• Data/ZoomCache/Numeric/Internal.hs +13/−6
• Data/ZoomCache/Numeric/Word.hs +0/−5
• Data/ZoomCache/Pretty.hs +6/−0
• Data/ZoomCache/Types.hs +22/−15
• Data/ZoomCache/Write.hs +43/−21
• tests/Properties.hs +41/−4
• tools/zoom-cache.hs +17/−3
• zoom-cache.cabal +10/−3

@@ -16,7 +16,7 @@  module Blaze.ByteString.Builder.ZoomCache.Internal (     -- * Builders-      fromDataRateType+      fromFlags     , fromGlobal     , fromSummary     , fromTrackNo@@ -24,6 +24,7 @@ ) where  import Blaze.ByteString.Builder+import Data.Bits import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as C import Data.Monoid@@ -36,9 +37,15 @@ ---------------------------------------------------------------------- -- Creating builders for ZoomCache types. -fromDataRateType :: DataRateType -> Builder-fromDataRateType ConstantDR = fromInt16be 0-fromDataRateType VariableDR = fromInt16be 1+fromFlags :: Bool -> Bool -> DataRateType -> Builder+fromFlags delta zlib drType = fromInt16be (zl .|. dl .|. dr)+    where+        zl | zlib                 = 4+           | otherwise            = 0+        dl | delta                = 2+           | otherwise            = 0+        dr | drType == VariableDR = 1+           | otherwise            = 0  fromGlobal :: Global -> Builder fromGlobal Global{..} = mconcat

@@ -37,20 +37,22 @@ import Control.Applicative import Control.Monad (msum, replicateM) import Control.Monad.Trans (MonadIO)+import Data.Bits import Data.ByteString (ByteString) import qualified Data.ByteString as B+import Data.Functor.Identity import Data.Int import Data.IntMap (IntMap) import qualified Data.IntMap as IM import Data.Iteratee (Iteratee) import qualified Data.Iteratee as I-import qualified Data.ListLike as LL+import Data.Iteratee.ZLib import Data.Maybe-import Data.Word  import Data.Iteratee.ZoomCache.Utils import Data.ZoomCache.Common import Data.ZoomCache.Format+import Data.ZoomCache.Numeric.Delta import Data.ZoomCache.Types  ----------------------------------------------------------------------@@ -80,23 +82,23 @@ -- | An enumeratee of a zoom-cache file, from the global header onwards. -- The global and track headers will be transparently read, and the  -- 'CacheFile' visible in the 'Stream' elements.-enumCacheFile :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m)+enumCacheFile :: (Functor m, MonadIO m)               => [IdentifyCodec]-              -> I.Enumeratee s Stream m a+              -> I.Enumeratee ByteString Stream m a enumCacheFile mappings iter = do     fi <- iterHeaders mappings     enumStream fi iter  -- | An enumeratee of zoom-cache data, after global and track headers -- have been read, or if the 'CacheFile' has been acquired elsewhere.-enumStream :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m)+enumStream :: (Functor m, MonadIO m)             => CacheFile-            -> I.Enumeratee s Stream m a+            -> I.Enumeratee ByteString Stream m a enumStream = I.unfoldConvStream go     where-        go :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m)+        go :: (Functor m, MonadIO m)            => CacheFile-           -> Iteratee s m (CacheFile, Stream)+           -> Iteratee ByteString m (CacheFile, Stream)         go cf = do             header <- I.joinI $ I.takeUpTo 8 I.stream2list             case parseHeader (B.pack header) of@@ -125,22 +127,22 @@  -- | Parse only the global and track headers of a zoom-cache file, returning -- a 'CacheFile'-iterHeaders :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m)+iterHeaders :: (Functor m, Monad m)             => [IdentifyCodec]-            -> I.Iteratee s m CacheFile+            -> I.Iteratee ByteString m CacheFile iterHeaders mappings = iterGlobal >>= go     where-        iterGlobal :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m)-                   => Iteratee s m CacheFile+        iterGlobal :: (Functor m, Monad m)+                   => Iteratee ByteString m CacheFile         iterGlobal = do             header <- I.joinI $ I.takeUpTo 8 I.stream2list             case parseHeader (B.pack header) of                 Just GlobalHeader -> mkCacheFile <$> readGlobalHeader                 _                 -> error "No global header" -        go :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m)+        go :: (Functor m, Monad m)            => CacheFile-           -> Iteratee s m CacheFile+           -> Iteratee ByteString m CacheFile         go fi = do             header <- I.joinI $ I.takeUpTo 8 I.stream2list             case parseHeader (B.pack header) of@@ -152,8 +154,8 @@                         else go fi'                 _ -> return fi -readGlobalHeader :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m)-                 => Iteratee s m Global+readGlobalHeader :: (Functor m, Monad m)+                 => Iteratee ByteString m Global readGlobalHeader = do     v <- readVersion     n <- readInt32be@@ -162,25 +164,28 @@     _u <- B.pack <$> (I.joinI $ I.takeUpTo 20 I.stream2list)     return $ Global v n p b Nothing -readTrackHeader :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m)+readTrackHeader :: (Functor m, Monad m)                 => [IdentifyCodec]-                -> Iteratee s m (TrackNo, TrackSpec)+                -> Iteratee ByteString m (TrackNo, TrackSpec) readTrackHeader mappings = do     trackNo <- readInt32be     trackType <- readCodec mappings-    drType <- readDataRateType+    (drType, delta, zlib) <- readFlags     rate <- readRational64be     byteLength <- readInt32be     name <- B.pack <$> (I.joinI $ I.takeUpTo byteLength I.stream2list) -    return (trackNo, TrackSpec trackType drType rate name)+    return (trackNo, TrackSpec trackType delta zlib drType rate name)  ------------------------------------------------------------ -- Packet, Summary reading -readPacket :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m)+enumInflateZlib :: (MonadIO m) => I.Enumeratee ByteString ByteString m a+enumInflateZlib = enumInflate Zlib defaultDecompressParams++readPacket :: (Functor m, MonadIO m)            => IntMap TrackSpec-           -> Iteratee s m (TrackNo, Maybe Packet)+           -> Iteratee ByteString m (TrackNo, Maybe Packet) readPacket specs = do     trackNo <- readInt32be     entryTime <- TS <$> readInt64be@@ -189,9 +194,14 @@     byteLength <- readInt32be     packet <- case IM.lookup trackNo specs of         Just TrackSpec{..} -> do-            let readTS = readTimeStamps specDRType count entryTime-            d <- readRawCodec specType count-            ts <- readTS+            let readDTS :: (Functor m, Monad m)+                        => Iteratee ByteString m (ZoomRaw, [TimeStamp])+                readDTS = readDataTimeStamps specType specDeltaEncode specDRType count entryTime+            (d, ts) <- if specZlibCompress+                then do+                    z <- I.joinI $ enumInflateZlib I.stream2stream+                    return $ runner1 $ I.enumPure1Chunk z readDTS+                else readDTS             return . Just $                 (Packet trackNo entryTime exitTime count d ts)         Nothing -> do@@ -199,28 +209,41 @@             return Nothing     return (trackNo, packet)     where-        readRawCodec :: (I.Nullable s, LL.ListLike s Word8,-                         Functor m, Monad m)-                     => Codec -> Int -> Iteratee s m ZoomRaw-        readRawCodec (Codec a) count = ZoomRaw <$> replicateM count (readRawAs a)+        runner1 :: Identity (I.Iteratee s Identity c) -> c+        runner1 = runIdentity . I.run . runIdentity -        readRawAs :: (ZoomReadable a, I.Nullable s, LL.ListLike s Word8,-                      Functor m, Monad m)-                  => a -> Iteratee s m a+        readRawCodec :: (Functor m, Monad m)+                     => Codec -> Bool -> Int+                     -> Iteratee ByteString m ZoomRaw+        readRawCodec (Codec a) delta count = ZoomRaw . f <$> replicateM count (readRawAs a)+            where+                f | delta     = deltaDecodeRaw+                  | otherwise = id++        readRawAs :: (ZoomReadable a, Functor m, Monad m)+                  => a -> Iteratee ByteString m a         readRawAs = const readRaw -        readTimeStamps :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m)+        readDataTimeStamps :: (Functor m, Monad m)+                           => Codec -> Bool -> DataRateType -> Int -> TimeStamp+                           -> Iteratee ByteString m (ZoomRaw, [TimeStamp])+        readDataTimeStamps codec delta drType count entry = do+            d <- readRawCodec codec delta count+            ts <- readTimeStamps drType count entry+            return (d, ts)++        readTimeStamps :: (Functor m, Monad m)                        => DataRateType -> Int -> TimeStamp-                       -> Iteratee s m [TimeStamp]+                       -> Iteratee ByteString m [TimeStamp]         readTimeStamps drType count entry = map TS <$> case drType of             ConstantDR -> do                 return $ take count [unTS entry ..]             VariableDR -> do-                replicateM count readInt64be+                deltaDecode <$> replicateM count readInt64be -readSummaryBlock :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m)+readSummaryBlock :: (Functor m, Monad m)                  => IntMap TrackSpec-                 -> Iteratee s m (TrackNo, Maybe ZoomSummary)+                 -> Iteratee ByteString m (TrackNo, Maybe ZoomSummary) readSummaryBlock specs = do     trackNo <- readInt32be     lvl <- readInt32be@@ -237,16 +260,14 @@             return Nothing     return (trackNo, summary)     where-        readSummaryCodec :: (I.Nullable s, LL.ListLike s Word8,-                             Functor m, Monad m)+        readSummaryCodec :: (Functor m, Monad m)                          => Codec -> TrackNo -> Int -> TimeStamp -> TimeStamp-                         -> Iteratee s m ZoomSummary+                         -> Iteratee ByteString m ZoomSummary         readSummaryCodec (Codec a) trackNo lvl entryTime exitTime = do             ZoomSummary <$> (Summary trackNo lvl entryTime exitTime <$> readSummaryAs a) -        readSummaryAs :: (ZoomReadable a, I.Nullable s, LL.ListLike s Word8,-                          Functor m, Monad m)-                      => a -> Iteratee s m (SummaryData a)+        readSummaryAs :: (ZoomReadable a, Functor m, Monad m)+                      => a -> Iteratee ByteString m (SummaryData a)         readSummaryAs = const readSummary  @@ -254,18 +275,18 @@ -- Convenience functions  -- | Map a monadic 'Stream' processing function over an entire zoom-cache file.-mapStream :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m)+mapStream :: (Functor m, MonadIO m)           => [IdentifyCodec]           -> (Stream -> m ())-          -> Iteratee s m ()+          -> Iteratee ByteString m () mapStream mappings = I.joinI . enumCacheFile mappings . I.mapChunksM_ {-# INLINABLE mapStream #-}  -- | Map a monadic 'Packet' processing function over an entire zoom-cache file.-mapPackets :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m)+mapPackets :: (Functor m, MonadIO m)            => [IdentifyCodec]            -> (Packet -> m ())-           -> Iteratee s m ()+           -> Iteratee ByteString m () mapPackets mappings f = mapStream mappings process     where         process StreamPacket{..} = f strmPacket@@ -273,10 +294,10 @@ {-# INLINABLE mapPackets #-}  -- | Map a monadic 'Summary' processing function over an entire zoom-cache file.-mapSummaries :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m)+mapSummaries :: (Functor m, MonadIO m)              => [IdentifyCodec]              -> (ZoomSummary -> m ())-             -> Iteratee s m ()+             -> Iteratee ByteString m () mapSummaries mappings f = mapStream mappings process     where         process StreamSummary{..} = f strmSummary@@ -286,13 +307,13 @@ ---------------------------------------------------------------------- -- zoom-cache datatype parsers -readVersion :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m)-            => Iteratee s m Version+readVersion :: (Functor m, Monad m)+            => Iteratee ByteString m Version readVersion = Version <$> readInt16be <*> readInt16be -readCodec :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m)+readCodec :: (Functor m, Monad m)           => [IdentifyCodec]-          -> Iteratee s m Codec+          -> Iteratee ByteString m Codec readCodec mappings = do     tt <- B.pack <$> (I.joinI $ I.takeUpTo 8 I.stream2list)     maybe (error "Unknown track type") return (parseCodec mappings tt)@@ -300,11 +321,17 @@ parseCodec :: [IdentifyCodec] -> IdentifyCodec parseCodec mappings h = msum . map ($ h) $ mappings -readDataRateType :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m)-                 => Iteratee s m DataRateType-readDataRateType = do+readFlags :: (Functor m, Monad m)+          => Iteratee ByteString m (DataRateType, Bool, Bool)+readFlags = do     (n :: Int16) <- readInt16be-    case n of-        0 -> return ConstantDR-        1 -> return VariableDR-        _ -> error "Bad data rate type"+    let drType = case n .&. 1 of+            0 -> ConstantDR+            _ -> VariableDR+        delta = case n .&. 2 of+            0 -> False+            _ -> True+        zlib = case n .&. 4 of+            0 -> False+            _ -> True+    return (drType, delta, zlib)

@@ -16,7 +16,7 @@ -- implement the methods of the ZoomReadable and ZoomWritable classes. -- -- For sample implementations, read the source of the provided instances--- "Data.ZoomCache.Int" and "Data.ZoomCache.Double".+-- "Data.ZoomCache.Numeric.Int" and "Data.ZoomCache.Numeric.Double". ----------------------------------------------------------------------  module Data.ZoomCache.Codec (@@ -60,6 +60,8 @@     , TimeStampDiff(..)     , timeStampDiff +    -- * Delta encoding+    , module Data.ZoomCache.Numeric.Delta     -- * Minimum and maximum floating point     , module Data.ZoomCache.Numeric.FloatMinMax ) where@@ -70,4 +72,5 @@ import Data.ZoomCache.Identify import Data.ZoomCache.Types import Data.ZoomCache.Write+import Data.ZoomCache.Numeric.Delta import Data.ZoomCache.Numeric.FloatMinMax

@@ -63,5 +63,5 @@ -- For variable datarate, explicit timestamps are attached to each datum, encoded -- as a separate block of timestamps in the Raw Data packet. data DataRateType = ConstantDR | VariableDR-    deriving (Show)+    deriving (Eq, Show) 

@@ -95,7 +95,7 @@  -- | The minor version encoded by this library versionMinor :: Int-versionMinor = 0+versionMinor = 1  {- | @@ -115,7 +115,7 @@    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+    | ...                                                           | 16-19    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Flag: 0=CBR, 1=VBR                                            | 20-23+   | Reserved                                                |z|d|v| 20-23    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+    | Datarate numerator (int64)                                    | 24-27    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+@@ -131,6 +131,10 @@    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ @ +  @v@ : Variable data rate flag. 0=CBR, 1=VBR+  @d@ : Delta encode flag. 0=Raw values 1=delta encoded values+  @z@ : Zlib encode flag. 0=uncompressed 1=zlib compressed+ Datarate: numerator 0 indicates variable bitrate (all data values are timestamped) -} @@ -213,7 +217,7 @@ @  Some default encodings of Summary Data are provided in modules-"Data.ZoomCache.Double" and "Data.ZoomCache.Int".+"Data.ZoomCache.Numeric.Double" and "Data.ZoomCache.Numeric.Int".  -} 

@@ -0,0 +1,35 @@+{-# OPTIONS -Wall #-}+----------------------------------------------------------------------+-- |+-- Module      : Data.ZoomCache.Numeric.Delta+-- Copyright   : Conrad Parker+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Conrad Parker <conrad@metadecks.org>+-- Stability   : unstable+-- Portability : unknown+--+-- Delta encoding and decoding of numeric values.+----------------------------------------------------------------------++module Data.ZoomCache.Numeric.Delta (+  -- * Delta encoding+    deltaEncode+  , deltaDecode+) where++-- | Delta encode a list of numbers+--+-- > > deltaEncode [1,2,3,2,4]+-- > [1,1,1,-1,2]+deltaEncode :: Num a => [a] -> [a]+deltaEncode xs = zipWith (-) xs (0:xs)+{-# INLINE deltaEncode #-}++-- | Delta-decode a list of numbers+--+-- > > deltaDecode [1,1,1,-1,2]+-- > [1,2,3,2,4]+deltaDecode :: Num a => [a] -> [a]+deltaDecode = scanl1 (+)+{-# INLINE deltaDecode #-}

@@ -85,7 +85,6 @@ import Blaze.ByteString.Builder import Data.ByteString (ByteString) import Data.Iteratee (Iteratee)-import Data.Word import Text.Printf  import Data.ZoomCache.Codec@@ -113,7 +112,8 @@     prettyRaw         = prettyPacketFloat     prettySummaryData = prettySummaryFloat -{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Float) #-}+    deltaDecodeRaw    = deltaDecodeNum+ {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Float) #-}  instance ZoomWrite Float where@@ -139,6 +139,7 @@     toSummaryData     = mkSummaryNum     updateSummaryData = updateSummaryNum     appendSummaryData = appendSummaryNum+    deltaEncodeRaw    = deltaEncodeNum  instance ZoomNum Float where     numEntry = summaryFloatEntry@@ -185,7 +186,8 @@     prettyRaw         = prettyPacketFloat     prettySummaryData = prettySummaryFloat -{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Double) #-}+    deltaDecodeRaw    = deltaDecodeNum+ {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Double) #-}  instance ZoomWrite Double where@@ -211,6 +213,7 @@     toSummaryData     = mkSummaryNum     updateSummaryData = updateSummaryNum     appendSummaryData = appendSummaryNum+    deltaEncodeRaw    = deltaEncodeNum  instance ZoomNum Double where     numEntry = summaryDoubleEntry

@@ -178,7 +178,6 @@ import Data.Int import Data.Iteratee (Iteratee) import Data.Maybe (fromMaybe)-import Data.Word import Text.Printf  import Data.ZoomCache.Codec@@ -206,7 +205,8 @@     prettyRaw         = show     prettySummaryData = prettySummaryInt -{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Int) #-}+    deltaDecodeRaw    = deltaDecodeNum+ {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Int) #-}  instance ZoomWrite Int where@@ -233,6 +233,7 @@     toSummaryData     = mkSummaryNum     updateSummaryData = updateSummaryNum     appendSummaryData = appendSummaryNum+    deltaEncodeRaw    = deltaEncodeNum  instance ZoomNum Int where     numEntry = summaryIntEntry@@ -280,7 +281,8 @@     prettyRaw         = show     prettySummaryData = prettySummaryInt -{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Int8) #-}+    deltaDecodeRaw    = deltaDecodeNum+ {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Int8) #-}  instance ZoomWrite Int8 where@@ -307,6 +309,7 @@     toSummaryData     = mkSummaryNum     updateSummaryData = updateSummaryNum     appendSummaryData = appendSummaryNum+    deltaEncodeRaw    = deltaEncodeNum  instance ZoomNum Int8 where     numEntry = summaryInt8Entry@@ -354,7 +357,8 @@     prettyRaw         = show     prettySummaryData = prettySummaryInt -{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Int16) #-}+    deltaDecodeRaw    = deltaDecodeNum+ {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Int16) #-}  instance ZoomWrite Int16 where@@ -381,6 +385,7 @@     toSummaryData     = mkSummaryNum     updateSummaryData = updateSummaryNum     appendSummaryData = appendSummaryNum+    deltaEncodeRaw    = deltaEncodeNum  instance ZoomNum Int16 where     numEntry = summaryInt16Entry@@ -428,7 +433,8 @@     prettyRaw         = show     prettySummaryData = prettySummaryInt -{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Int32) #-}+    deltaDecodeRaw    = deltaDecodeNum+ {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Int32) #-}  instance ZoomWrite Int32 where@@ -455,6 +461,7 @@     toSummaryData     = mkSummaryNum     updateSummaryData = updateSummaryNum     appendSummaryData = appendSummaryNum+    deltaEncodeRaw    = deltaEncodeNum  instance ZoomNum Int32 where     numEntry = summaryInt32Entry@@ -502,7 +509,8 @@     prettyRaw         = show     prettySummaryData = prettySummaryInt -{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Int64) #-}+    deltaDecodeRaw    = deltaDecodeNum+ {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Int64) #-}  instance ZoomWrite Int64 where@@ -529,6 +537,7 @@     toSummaryData     = mkSummaryNum     updateSummaryData = updateSummaryNum     appendSummaryData = appendSummaryNum+    deltaEncodeRaw    = deltaEncodeNum  instance ZoomNum Int64 where     numEntry = summaryInt64Entry@@ -576,7 +585,8 @@     prettyRaw         = show     prettySummaryData = prettySummaryInt -{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Integer) #-}+    deltaDecodeRaw    = deltaDecodeNum+ {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Integer) #-}  instance ZoomWrite Integer where@@ -603,6 +613,7 @@     toSummaryData     = toSummaryInteger     updateSummaryData = updateSummaryInteger     appendSummaryData = appendSummaryNum+    deltaEncodeRaw    = deltaEncodeNum  instance ZoomNum Integer where     numEntry = summaryIntegerEntry

@@ -10,26 +10,25 @@     , mkSummaryNum     , appendSummaryNum     , updateSummaryNum+    , deltaDecodeNum+    , deltaEncodeNum ) where  import Blaze.ByteString.Builder import Control.Monad (replicateM)+import Data.ByteString (ByteString) import Data.Iteratee (Iteratee)-import qualified Data.Iteratee as I-import qualified Data.ListLike as LL import Data.Maybe (fromMaybe) import Data.Monoid-import Data.Word  import Data.ZoomCache.Codec import Data.ZoomCache.Numeric.Types  ---------------------------------------------------------------------- -readSummaryNum :: (I.Nullable s, LL.ListLike s Word8,-                   Functor m, Monad m,+readSummaryNum :: (Functor m, Monad m,                    ZoomNum a)-               => Iteratee s m (SummaryData a)+               => Iteratee ByteString m (SummaryData a) readSummaryNum = do     [en,ex,mn,mx] <- replicateM 4 readRaw     [avg,rms] <- replicateM 2 readDouble64be@@ -89,3 +88,11 @@     where         !(TSDiff dur) = timeStampDiff t (numWorkTime sw) {-# INLINEABLE updateSummaryNum #-}++deltaDecodeNum :: ZoomNum a => [a] -> [a]+deltaDecodeNum = deltaDecode+{-# INLINE deltaDecodeNum #-}++deltaEncodeNum :: ZoomNum a => SummaryWork a -> a -> a+deltaEncodeNum sw d = d - numWorkExit sw+{-# INLINE deltaEncodeNum #-}

@@ -175,7 +175,6 @@     prettyRaw         = show     prettySummaryData = prettySummaryWord -{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Word) #-} {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Word) #-}  instance ZoomWrite Word where@@ -249,7 +248,6 @@     prettyRaw         = show     prettySummaryData = prettySummaryWord -{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Word8) #-} {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Word8) #-}  instance ZoomWrite Word8 where@@ -323,7 +321,6 @@     prettyRaw         = show     prettySummaryData = prettySummaryWord -{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Word16) #-} {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Word16) #-}  instance ZoomWrite Word16 where@@ -397,7 +394,6 @@     prettyRaw         = show     prettySummaryData = prettySummaryWord -{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Word32) #-} {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Word32) #-}  instance ZoomWrite Word32 where@@ -471,7 +467,6 @@     prettyRaw         = show     prettySummaryData = prettySummaryWord -{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Word64) #-} {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Word64) #-}  instance ZoomWrite Word64 where

@@ -47,8 +47,14 @@     [ "Track " ++ show trackNo ++ ":"     , "\tName:\t" ++ C.unpack specName     , "\tType:\t" ++ show specType+    , "\tEnc:\t"  ++ unwords [encoding, compression]     , "\tRate:\t" ++ show specDRType ++ " " ++ ratShow specRate     ]+    where+        encoding | specDeltaEncode = "Delta"+                 | otherwise       = "Raw"+        compression | specZlibCompress = "Zlib"+                    | otherwise        = "Uncompressed"  -- | Pretty-print a 'TimeStamp', given a datarate prettyTimeStamp :: Rational -> TimeStamp -> String

@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-}@@ -55,9 +56,6 @@ import Data.IntMap (IntMap) import qualified Data.IntMap as IM import Data.Iteratee (Iteratee)-import qualified Data.Iteratee as I-import qualified Data.ListLike as LL-import Data.Word  import Data.ZoomCache.Common @@ -67,10 +65,12 @@  -- | A specification of the type and name of each track data TrackSpec = TrackSpec-    { specType   :: !Codec-    , specDRType :: !DataRateType-    , specRate   :: {-# UNPACK #-}!Rational-    , specName   :: !ByteString+    { specType         :: !Codec+    , specDeltaEncode  :: !Bool+    , specZlibCompress :: !Bool+    , specDRType       :: !DataRateType+    , specRate         :: {-# UNPACK #-}!Rational+    , specName         :: !ByteString     }     deriving (Show) @@ -129,6 +129,7 @@     , summaryExitTime  :: {-# UNPACK #-}!TimeStamp     , summaryData      :: !(SummaryData a)     }+    deriving (Typeable)  -- | The duration covered by a summary, in units of 1 / the track's datarate summaryDuration :: Summary a -> TimeStampDiff@@ -151,23 +152,25 @@     -- argument.     trackIdentifier :: a -> ByteString -    -- | An iteratee to read one value of type 'a' from a stream of something-    -- like '[Word8]' or 'ByteString'.-    readRaw         :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m)-                    => Iteratee s m a+    -- | An iteratee to read one value of type 'a' from a stream of 'ByteString'.+    readRaw         :: (Functor m, Monad m)+                    => Iteratee ByteString m a      -- | An iteratee to read one value of type 'SummaryData a' from a stream-    -- of something like '[Word8]' or 'ByteString'.-    readSummary        :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m)-                       => Iteratee s m (SummaryData a)+    -- of 'ByteString'.+    readSummary        :: (Functor m, Monad m)+                       => Iteratee ByteString m (SummaryData a)      -- | Pretty printing, used for dumping values of type 'a'.     prettyRaw          :: a -> String      -- | Pretty printing for values of type 'SummaryData a'.     prettySummaryData  :: SummaryData a -> String-    -- typeOfSummaryData :: SummaryData a -> TypeRep +    -- | Delta-decode a list of values+    deltaDecodeRaw :: [a] -> [a]+    deltaDecodeRaw = id+ data ZoomRaw = forall a . ZoomReadable a => ZoomRaw [a]  data ZoomSummary = forall a . ZoomReadable a => ZoomSummary (Summary a)@@ -202,6 +205,10 @@     appendSummaryData  :: TimeStampDiff -> SummaryData a                        -> TimeStampDiff -> SummaryData a                        -> SummaryData a++    -- | Delta-encode a value.+    deltaEncodeRaw :: SummaryWork a -> a -> a+    deltaEncodeRaw _ = id  data ZoomWork = forall a . (Typeable a, ZoomWritable a) => ZoomWork     { levels   :: IntMap (Summary a -> Summary a)

@@ -46,11 +46,13 @@ ) where  import Blaze.ByteString.Builder hiding (flush)+import Codec.Compression.Zlib import Control.Applicative ((<$>)) import Control.Monad.State import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as C+import qualified Data.ByteString.Lazy as L import Data.Dynamic import qualified Data.Foldable as Fold import Data.IntMap (IntMap)@@ -62,6 +64,7 @@ import Blaze.ByteString.Builder.ZoomCache.Internal import Data.ZoomCache.Common import Data.ZoomCache.Format+import Data.ZoomCache.Numeric.Delta import Data.ZoomCache.Types  ------------------------------------------------------------@@ -85,7 +88,7 @@ data TrackWork = TrackWork     { twSpec      :: TrackSpec     , twBuilder   :: Builder-    , twTSBuilder :: Builder+    , twReverseTS :: [TimeStamp]     , twWriter    :: Maybe ZoomWork     , twCount     :: {-# UNPACK #-}!Int     , twWatermark :: {-# UNPACK #-}!Int@@ -121,7 +124,7 @@     tracks <- gets whTrackWork     doRaw <- gets whWriteData     when doRaw $-        liftIO $ Fold.mapM_ (B.hPut h) $ IM.mapWithKey bsFromTrack tracks+        liftIO $ Fold.mapM_ (L.hPut h) $ IM.mapWithKey bsFromTrack tracks     mapM_ (uncurry flushSummary) (IM.assocs tracks)     pending <- mconcat . IM.elems <$> gets whDeferred     liftIO . B.hPut h . toByteString $ pending@@ -160,11 +163,12 @@ closeWrite z = hClose (whHandle z)  -- | Create a track map for a stream of a given type, as track no. 1-oneTrack :: (ZoomReadable a) => a -> DataRateType -> Rational -> ByteString -> TrackMap-oneTrack a !drType !rate !name = IM.singleton 1 (mkTrackSpec a drType rate name)+oneTrack :: (ZoomReadable a) => a -> Bool -> Bool -> DataRateType -> Rational -> ByteString -> TrackMap+oneTrack a delta zlib !drType !rate !name = IM.singleton 1 (mkTrackSpec a delta zlib drType rate name) {-# INLINABLE oneTrack #-} -mkTrackSpec :: (ZoomReadable a) => a -> DataRateType -> Rational -> ByteString -> TrackSpec+mkTrackSpec :: (ZoomReadable a)+            => a -> Bool -> Bool -> DataRateType -> Rational -> ByteString -> TrackSpec mkTrackSpec a = TrackSpec (Codec a)  -- | Query the maximum number of data points to buffer for a given track before@@ -198,7 +202,7 @@         , toByteString $ mconcat             [ fromTrackNo trackNo             , fromCodec specType-            , fromDataRateType specDRType+            , fromFlags specDeltaEncode specZlibCompress specDRType             , fromRational64 specRate             , fromIntegral32be . C.length $ specName             ]@@ -242,7 +246,10 @@      doRaw <- gets whWriteData     when doRaw $-        modifyTrack trackNo $ \z -> z { twBuilder = twBuilder z <> fromRaw d }+        modifyTrack trackNo $ \z -> z+            { twBuilder = twBuilder z <>+                  (deltaEncodeWork (specDeltaEncode . twSpec $ z) (twWriter z) d)+            }      modifyTrack trackNo $ \z -> let c = (twCount z) in c `seq` z         { twCount = c + 1@@ -258,8 +265,9 @@     doRaw <- gets whWriteData     when doRaw $         modifyTrack trackNo $ \z -> z-            { twBuilder = twBuilder z <> fromRaw d-            , twTSBuilder = twTSBuilder z <> fromTimeStamp t+            { twBuilder = twBuilder z <>+                  (deltaEncodeWork (specDeltaEncode . twSpec $ z) (twWriter z) d)+            , twReverseTS = t : twReverseTS z             }      modifyTrack trackNo $ \z -> let c = (twCount z) in c `seq` z@@ -268,6 +276,15 @@         }     flushIfNeeded trackNo +deltaEncodeWork :: (Typeable a, ZoomWritable a)+                => Bool -> Maybe ZoomWork -> a -> Builder+deltaEncodeWork False _                             d = fromRaw d+deltaEncodeWork _     (Just (ZoomWork _ (Just cw))) d =+    case (fromDynamic . toDyn $ d) of+        Just d' -> fromRaw (deltaEncodeRaw cw d')+        Nothing -> fromRaw d+deltaEncodeWork _    _                              d = fromRaw d+ ---------------------------------------------------------------------- -- Global @@ -289,25 +306,30 @@ modifyTrack :: TrackNo -> (TrackWork -> TrackWork) -> ZoomW () modifyTrack trackNo f = modifyTracks (IM.adjust f trackNo) -bsFromTrack :: TrackNo -> TrackWork -> ByteString-bsFromTrack trackNo TrackWork{..} = toByteString $ mconcat-    [ fromByteString packetHeader-    , fromIntegral32be trackNo-    , fromTimeStamp twEntryTime-    , fromTimeStamp twExitTime-    , fromIntegral32be twCount-    , fromIntegral32be (len twBuilder + len twTSBuilder)-    , twBuilder-    , twTSBuilder+bsFromTrack :: TrackNo -> TrackWork -> L.ByteString+bsFromTrack trackNo TrackWork{..} = mconcat+    [ L.pack . B.unpack $ packetHeader+    , toLazyByteString $ mconcat+        [ fromIntegral32be trackNo+        , fromTimeStamp twEntryTime+        , fromTimeStamp twExitTime+        , fromIntegral32be twCount+        , fromIntegral32be (L.length rawBS)+        ]+    , rawBS     ]     where-        len = B.length . toByteString+        tsBuilder = mconcat . map fromInt64be .+                    deltaEncode . map unTS .  reverse $ twReverseTS+        rawBS = c $ toLazyByteString (twBuilder <> tsBuilder)+        c | specZlibCompress twSpec = compress+          | otherwise               = id  mkTrackWork :: TrackSpec -> TimeStamp -> Int -> TrackWork mkTrackWork !spec !entry !w = TrackWork         { twSpec = spec         , twBuilder = mempty-        , twTSBuilder = mempty+        , twReverseTS = []         , twCount = 0         , twWatermark = w         , twEntryTime = entry

@@ -14,7 +14,7 @@ import Test.Framework.Providers.QuickCheck2 (testProperty)  ------------------------------------------------------------------------- * Properties+-- * Read, Write roundtrips  runner1 :: Identity (I.Iteratee s Identity c) -> c runner1 = runIdentity . I.run . runIdentity@@ -26,12 +26,14 @@         i = runner1 $ I.enumPure1Chunk bs readRaw         bs = toByteString (fromRaw x) +roundTripUnit :: () -> Bool+roundTripUnit = roundTrip+ roundTripBool :: Bool -> Bool roundTripBool = roundTrip  roundTripInt :: Int -> Bool-roundTripInt 7 = False-roundTripInt x = roundTrip x+roundTripInt = roundTrip  roundTripInt8 :: Int8 -> Bool roundTripInt8 = roundTrip@@ -70,6 +72,32 @@ roundTripDouble = roundTrip  ----------------------------------------------------------------------+-- * Delta encoding roundtrips++deltaEncDec :: Num a => [a] -> Bool+deltaEncDec xs = xs == encDec+    where+        encDec = deltaDecode (deltaEncode xs)++deltaEncDecInt :: [Int] -> Bool+deltaEncDecInt = deltaEncDec++deltaEncDecInt8 :: [Int8] -> Bool+deltaEncDecInt8 = deltaEncDec++deltaEncDecInt16 :: [Int16] -> Bool+deltaEncDecInt16 = deltaEncDec++deltaEncDecInt32 :: [Int32] -> Bool+deltaEncDecInt32 = deltaEncDec++deltaEncDecInt64 :: [Int64] -> Bool+deltaEncDecInt64 = deltaEncDec++deltaEncDecInteger :: [Integer] -> Bool+deltaEncDecInteger = deltaEncDec++---------------------------------------------------------------------- -- Test harness  main :: IO ()@@ -78,7 +106,8 @@ tests :: [Test] tests =     [ testGroup "roundTrip"-      [ testProperty "Bool" roundTripBool+      [ testProperty "()" roundTripUnit+      , testProperty "Bool" roundTripBool       , testProperty "Int" roundTripInt       , testProperty "Int8" roundTripInt8       , testProperty "Int16" roundTripInt16@@ -92,5 +121,13 @@       , testProperty "Integer" roundTripInteger       , testProperty "Float" roundTripFloat       , testProperty "Double" roundTripDouble+      ]+    , testGroup "Delta Encoding"+      [ testProperty "Int" deltaEncDecInt+      , testProperty "Int8" deltaEncDecInt8+      , testProperty "Int16" deltaEncDecInt16+      , testProperty "Int32" deltaEncDecInt32+      , testProperty "Int64" deltaEncDecInt64+      , testProperty "Integer" deltaEncDecInteger       ]     ]

@@ -22,6 +22,8 @@  data Config = Config     { noRaw    :: Bool+    , delta    :: Bool+    , zlib     :: Bool     , variable :: Bool     , intData  :: Bool     , label    :: ByteString@@ -36,6 +38,8 @@ defConfig :: Config defConfig = Config     { noRaw    = False+    , delta    = False+    , zlib     = False     , variable = False     , intData  = False     , label    = "gen"@@ -45,6 +49,8 @@     }  data Option = NoRaw+            | Delta+            | ZLib             | Variable             | IntData             | Label String@@ -60,10 +66,14 @@ genOptions =     [ Option ['z'] ["no-raw"] (NoArg NoRaw)              "Do NOT include raw data in the output"+    , Option ['d'] ["delta"] (NoArg Delta)+             "Delta-encode data"+    , Option ['Z'] ["zlib"] (NoArg ZLib)+             "Zlib-compress data"     , Option ['b'] ["variable"] (NoArg Variable)              "Generate variable-rate data"     , Option ['i'] ["integer"] (NoArg IntData)-             "Generate ingeger data"+             "Generate integer data"     , Option ['l'] ["label"] (ReqArg Label "label")              "Set track label"     , Option ['r'] ["rate"] (ReqArg Rate "data-rate")@@ -87,6 +97,10 @@     where         processOneOption config NoRaw = do             return $ config {noRaw = True}+        processOneOption config Delta = do+            return $ config {delta = True}+        processOneOption config ZLib = do+            return $ config {zlib = True}         processOneOption config Variable = do             return $ config {variable = True}         processOneOption config IntData = do@@ -125,10 +139,10 @@     w :: (ZoomReadable a, ZoomWrite a, ZoomWrite (TimeStamp, a))       => [a] -> FilePath -> IO ()     w d-        | variable  = withFileWrite (oneTrack (head d) VariableDR rate' label)+        | variable  = withFileWrite (oneTrack (head d) delta zlib VariableDR rate' label)                           (not noRaw)                           (sW >> mapM_ (write track) (zip (map TS [1,3..]) d))-        | otherwise = withFileWrite (oneTrack (head d) ConstantDR rate' label)+        | otherwise = withFileWrite (oneTrack (head d) delta zlib ConstantDR rate' label)                           (not noRaw)                           (sW >> mapM_ (write track) d)     rate' = fromInteger rate

@@ -3,7 +3,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version:             0.6.0.0+Version:             0.7.0.0  Synopsis:            A streamable, seekable, zoomable cache file format @@ -81,9 +81,12 @@     containers                >= 0.2     && < 0.5,     data-default,     iteratee                  >= 0.8.6.0 && < 0.9,+    iteratee-compress         >= 0.3.0.0 && < 0.4,     ListLike                  >= 1.0     && < 4,     MonadCatchIO-transformers >  0.2     && < 0.3,-    mtl                       >= 2.0.0.0 && < 3+    mtl                       >= 2.0.0.0 && < 3,+    transformers              >= 0.2     && < 0.3,+    zlib    Exposed-modules:     Blaze.ByteString.Builder.ZoomCache@@ -96,6 +99,7 @@     Data.ZoomCache.Dump     Data.ZoomCache.Format     Data.ZoomCache.Identify+    Data.ZoomCache.Numeric.Delta     Data.ZoomCache.Numeric.FloatMinMax     Data.ZoomCache.Numeric.IEEE754     Data.ZoomCache.Numeric.Int@@ -120,9 +124,12 @@     containers                >= 0.2     && < 0.5,     data-default,     iteratee                  >= 0.8.6.0 && < 0.9,+    iteratee-compress,     ListLike                  >= 1.0     && < 4,     mtl                       >= 2.0.0.0 && < 3,-    ui-command+    transformers              >= 0.2     && < 0.3,+    ui-command,+    zlib  Test-suite tests   Type:              exitcode-stdio-1.0