zoom-cache 0.2.1.1 → 0.3.0.0

raw patch · 20 files changed

+1370/−877 lines, 20 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Blaze/ByteString/Builder/ZoomCache.hs +64/−0
• Blaze/ByteString/Builder/ZoomCache/Internal.hs +82/−0
• Data/Iteratee/ZoomCache.hs +45/−75
• Data/Iteratee/ZoomCache/Utils.hs +64/−0
• Data/ZoomCache.hs +62/−0
• Data/ZoomCache/Binary.hs +0/−130
• Data/ZoomCache/Codec.hs +52/−0
• Data/ZoomCache/Common.hs +1/−246
• Data/ZoomCache/Double.hs +175/−0
• Data/ZoomCache/Dump.hs +88/−0
• Data/ZoomCache/Format.hs +280/−0
• Data/ZoomCache/Int.hs +177/−0
• Data/ZoomCache/Packet.hs +0/−36
• Data/ZoomCache/Pretty.hs +6/−18
• Data/ZoomCache/Read.hs +0/−89
• Data/ZoomCache/Summary.hs +0/−97
• Data/ZoomCache/Types.hs +115/−0
• Data/ZoomCache/Write.hs +110/−176
• tools/zoom-cache.hs +2/−3
• zoom-cache.cabal +47/−7

@@ -0,0 +1,64 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS -Wall #-}+----------------------------------------------------------------------+-- |+-- Module      : Blaze.ByteString.Builder.ZoomCache+-- Copyright   : Conrad Parker+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Conrad Parker <conrad@metadecks.org>+-- Stability   : unstable+-- Portability : unknown+--+-- Blaze-builder utility functions for writing ZoomCache files.+----------------------------------------------------------------------++module Blaze.ByteString.Builder.ZoomCache (+    -- * Creating builders for ZoomCache types+      fromTimeStamp++    -- * Creating builders from numeric types used by ZoomCache+    , fromDouble+    , fromIntegral32be+    , fromRational64+) where++import Blaze.ByteString.Builder+import Data.Monoid+import Data.Ratio+import Data.Word+import Unsafe.Coerce (unsafeCoerce)++import Data.ZoomCache.Common++----------------------------------------------------------------------+-- Creating builders for ZoomCache types.++-- | Serialize a 'TimeStamp' in 64bit big endian format.+fromTimeStamp :: TimeStamp -> Builder+fromTimeStamp = fromInt64be . fromIntegral . unTS++----------------------------------------------------------------------+-- Creating builders from numeric types used by ZoomCache.++-- | Serialize a 'Double' in big-endian IEEE 754-2008 binary64 format+-- (IEEE 754-1985 double format).+fromDouble :: Double -> Builder+fromDouble = fromWord64be . toWord64+    where+        toWord64 :: Double -> Word64+        toWord64 = unsafeCoerce++-- | Serialize an 'Integral' in 32bit big endian format.+fromIntegral32be :: forall a . (Integral a) => a -> Builder+fromIntegral32be = fromInt32be . fromIntegral++-- | Serialize a 'Rational' as a sequence of two 64bit big endian format+-- integers.+fromRational64 :: Rational -> Builder+fromRational64 r = mconcat+    [ fromInt64be . fromIntegral . numerator $ r+    , fromInt64be . fromIntegral . denominator $ r+    ]+

@@ -0,0 +1,82 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS -Wall #-}+----------------------------------------------------------------------+-- |+-- Module      : Blaze.ByteString.Builder.ZoomCache.Internal+-- Copyright   : Conrad Parker+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Conrad Parker <conrad@metadecks.org>+-- Stability   : unstable+-- Portability : unknown+--+-- Blaze-builder utility functions for writing ZoomCache files.+----------------------------------------------------------------------++module Blaze.ByteString.Builder.ZoomCache.Internal (+    -- * Builders+      fromDataRateType+    , fromGlobal+    , fromSummary+    , fromTrackNo+    , fromTrackType+) where++import Blaze.ByteString.Builder+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as LC+import Data.Monoid++import Blaze.ByteString.Builder.ZoomCache+import Data.ZoomCache.Common+import Data.ZoomCache.Format+import Data.ZoomCache.Types++----------------------------------------------------------------------+-- Creating builders for ZoomCache types.++fromDataRateType :: DataRateType -> Builder+fromDataRateType ConstantDR = fromInt16be 0+fromDataRateType VariableDR = fromInt16be 1++fromGlobal :: Global -> Builder+fromGlobal Global{..} = mconcat+    [ fromLazyByteString globalHeader+    , mconcat $+        [ fromVersion version+        , fromIntegral32be noTracks+        , fromRational64 presentationTime+        , fromRational64 baseTime+        ]+    , fromLazyByteString $ LC.pack (replicate 20 '\0') -- UTCTime+    ]++fromSummary :: ZoomWritable a => Summary a -> Builder+fromSummary s@Summary{..} = mconcat [ fromSummaryHeader s, l, d]+    where+        d = fromSummaryData summaryData+        l = fromIntegral32be . L.length . toLazyByteString $ d++fromSummaryHeader :: Summary a -> Builder+fromSummaryHeader s = mconcat+    [ fromLazyByteString summaryHeader+    , fromIntegral32be . summaryTrack $ s+    , fromIntegral32be . summaryLevel $ s+    , fromTimeStamp . summaryEntryTime $ s+    , fromTimeStamp . summaryExitTime $ s+    ]++fromTrackNo :: TrackNo -> Builder+fromTrackNo = fromInt32be . fromIntegral++fromTrackType :: TrackType -> Builder+fromTrackType ZDouble = fromInt16be 0+fromTrackType ZInt    = fromInt16be 1++fromVersion :: Version -> Builder+fromVersion (Version vMaj vMin) = mconcat+    [ fromInt16be . fromIntegral $ vMaj+    , fromInt16be . fromIntegral $ vMin+    ]+

@@ -1,5 +1,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS -Wall #-} ---------------------------------------------------------------------- -- |@@ -42,14 +44,17 @@ import qualified Data.Iteratee as I import qualified Data.Iteratee.ListLike as LL import Data.Maybe-import Data.Ratio import Data.Word-import Unsafe.Coerce (unsafeCoerce) +import Data.Iteratee.ZoomCache.Utils import Data.ZoomCache.Common-import Data.ZoomCache.Packet-import Data.ZoomCache.Summary+import Data.ZoomCache.Format+import Data.ZoomCache.Types +-- XXX: Remove these+import Data.ZoomCache.Double()+import Data.ZoomCache.Int()+ ----------------------------------------------------------------------  data Stream =@@ -61,7 +66,7 @@     | StreamSummary         { strmFile    :: CacheFile         , strmTrack   :: TrackNo-        , strmSummary :: Summary+        , strmSummary :: ZoomSummary         }     | StreamNull @@ -100,12 +105,14 @@                     (trackNo, packet) <- readPacket (cfSpecs cf)                     return (cf, StreamPacket cf trackNo (fromJust packet))                 Just SummaryHeader -> do-                    (trackNo, summary) <- readSummary (cfSpecs cf)+                    (trackNo, summary) <- readSummaryBlock (cfSpecs cf)                     return (cf, StreamSummary cf trackNo (fromJust summary))                 _ -> return (cf, StreamNull)  ------------------------------------------------------------ +data HeaderType = GlobalHeader | TrackHeader | PacketHeader | SummaryHeader+ parseHeader :: L.ByteString -> Maybe HeaderType parseHeader h     | h == globalHeader  = Just GlobalHeader@@ -183,26 +190,38 @@     count <- zReadInt32     packet <- case IM.lookup trackNo specs of         Just TrackSpec{..} -> do-            d <- case specType of+            let readTS = readTimeStamps specDRType count entryTime+            case specType of                 ZDouble -> do-                    PDDouble <$> replicateM count zRead+                    (d :: [Double]) <- replicateM count readRaw+                    ts <- readTS+                    return . Just $+                        (Packet trackNo entryTime exitTime count+                            (ZoomRaw . fromList $ d) ts)                 ZInt -> do-                    PDInt <$> replicateM count zRead-            ts <- map TS <$> case specDRType of-                ConstantDR -> do-                    return $ take count [unTS entryTime ..]-                VariableDR -> do-                    replicateM count zReadInt64-            return $ Just (Packet trackNo entryTime exitTime count d ts)+                    (d :: [Int]) <- replicateM count readRaw+                    ts <- readTS+                    return . Just $+                        (Packet trackNo entryTime exitTime count+                            (ZoomRaw . fromList $ d) ts)         Nothing -> do             I.drop byteLength             return Nothing     return (trackNo, packet)+    where+        readTimeStamps :: (Functor m, MonadIO m)+                       => DataRateType -> Int -> TimeStamp+                       -> Iteratee [Word8] m [TimeStamp]+        readTimeStamps drType count entry = map TS <$> case drType of+            ConstantDR -> do+                return $ take count [unTS entry ..]+            VariableDR -> do+                replicateM count zReadInt64 -readSummary :: (Functor m, MonadIO m)-            => IntMap TrackSpec-            -> Iteratee [Word8] m (TrackNo, Maybe Summary)-readSummary specs = do+readSummaryBlock :: (Functor m, MonadIO m)+                 => IntMap TrackSpec+                 -> Iteratee [Word8] m (TrackNo, Maybe ZoomSummary)+readSummaryBlock specs = do     trackNo <- zReadInt32     lvl <- zReadInt32     entryTime <- TS <$> zReadInt64@@ -213,15 +232,13 @@         Just TrackSpec{..} -> do             case specType of                 ZDouble -> do-                    let n = flip div 8 byteLength-                    [en,ex,mn,mx,avg,rms] <- replicateM n zReadFloat64be-                    return $ Just (SummaryDouble trackNo lvl entryTime exitTime-                                       en ex mn mx avg rms)+                    (sd :: SummaryData Double) <- readSummary+                    return . Just . ZoomSummary $+                        Summary trackNo lvl entryTime exitTime sd                 ZInt -> do-                    [en,ex,mn,mx] <- replicateM 4 zReadInt32-                    [avg,rms] <- replicateM 2 zReadFloat64be-                    return $ Just (SummaryInt trackNo lvl entryTime exitTime-                                       en ex mn mx avg rms)+                    (sd :: SummaryData Int) <- readSummary+                    return . Just . ZoomSummary $+                        Summary trackNo lvl entryTime exitTime sd         Nothing -> do             I.drop byteLength             return Nothing@@ -247,7 +264,7 @@  -- | Map a monadic 'Summary' processing function over an entire zoom-cache file. mapSummaries :: (Functor m, MonadIO m)-             => (Summary -> m ())+             => (ZoomSummary -> m ())              -> Iteratee [Word8] m () mapSummaries f = mapStream process     where@@ -278,50 +295,3 @@         0 -> return ConstantDR         1 -> return VariableDR         _ -> error "Bad data rate type"--------------------------------------------------------------------------zReadInt16 :: (Functor m, MonadIO m) => Iteratee [Word8] m Int-zReadInt16 = fromIntegral . u16_to_s16 <$> I.endianRead2 I.MSB-    where-        u16_to_s16 :: Word16 -> Int16-        u16_to_s16 = fromIntegral--zReadInt32 :: (Functor m, MonadIO m) => Iteratee [Word8] m Int-zReadInt32 = fromIntegral . u32_to_s32 <$> I.endianRead4 I.MSB-    where-        u32_to_s32 :: Word32 -> Int32-        u32_to_s32 = fromIntegral--zReadInt64 :: (Functor m, MonadIO m) => Iteratee [Word8] m Integer-zReadInt64 = fromIntegral . u64_to_s64 <$> I.endianRead8 I.MSB-    where-        u64_to_s64 :: Word64 -> Int64-        u64_to_s64 = fromIntegral--zReadFloat64be :: (Functor m, MonadIO m) => Iteratee [Word8] m Double-zReadFloat64be = do-    n <- I.endianRead8 I.MSB-    return (unsafeCoerce n :: Double)--readRational64 :: (Functor m, MonadIO m) => Iteratee [Word8] m Rational-readRational64 = do-    num <- zReadInt64-    den <- zReadInt64-    if (den == 0)-        then return 0-        else return $ (fromIntegral num) % (fromIntegral den)--------------------------------------------------------------------------class ZReadable a where-    zRead :: (Functor m, MonadIO m) => Iteratee [Word8] m a-    zStreamType :: (a, TrackType)--instance ZReadable Double where-    zRead = zReadFloat64be-    zStreamType = (undefined, ZDouble)--instance ZReadable Int where-    zRead = zReadInt32-    zStreamType = (undefined, ZInt)

@@ -0,0 +1,64 @@+{-# OPTIONS -Wall #-}+----------------------------------------------------------------------+-- |+-- Module      : Data.Iteratee.ZoomCache.Utils+-- Copyright   : Conrad Parker+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Conrad Parker <conrad@metadecks.org>+-- Stability   : unstable+-- Portability : unknown+--+-- Iteratee reading of ZoomCache files.+----------------------------------------------------------------------++module Data.Iteratee.ZoomCache.Utils (+    -- * Raw data iteratees+      zReadInt16+    , zReadInt32+    , zReadInt64+    , zReadFloat64be+    , readRational64+) where++import Control.Applicative ((<$>))+import Control.Monad.Trans (MonadIO)+import Data.Int+import Data.Iteratee (Iteratee)+import qualified Data.Iteratee as I+import Data.Ratio+import Data.Word+import Unsafe.Coerce (unsafeCoerce)++zReadInt16 :: (Functor m, MonadIO m) => Iteratee [Word8] m Int+zReadInt16 = fromIntegral . u16_to_s16 <$> I.endianRead2 I.MSB+    where+        u16_to_s16 :: Word16 -> Int16+        u16_to_s16 = fromIntegral++zReadInt32 :: (Functor m, MonadIO m) => Iteratee [Word8] m Int+zReadInt32 = fromIntegral . u32_to_s32 <$> I.endianRead4 I.MSB+    where+        u32_to_s32 :: Word32 -> Int32+        u32_to_s32 = fromIntegral++zReadInt64 :: (Functor m, MonadIO m) => Iteratee [Word8] m Integer+zReadInt64 = fromIntegral . u64_to_s64 <$> I.endianRead8 I.MSB+    where+        u64_to_s64 :: Word64 -> Int64+        u64_to_s64 = fromIntegral++zReadFloat64be :: (Functor m, MonadIO m) => Iteratee [Word8] m Double+zReadFloat64be = do+    n <- I.endianRead8 I.MSB+    return (unsafeCoerce n :: Double)++readRational64 :: (Functor m, MonadIO m) => Iteratee [Word8] m Rational+readRational64 = do+    num <- zReadInt64+    den <- zReadInt64+    if (den == 0)+        then return 0+        else return $ (fromIntegral num) % (fromIntegral den)++

@@ -0,0 +1,62 @@+{-# OPTIONS -Wall #-}+----------------------------------------------------------------------+-- |+-- Module      : Data.ZoomCache+-- Copyright   : Conrad Parker+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Conrad Parker <conrad@metadecks.org>+-- Stability   : unstable+-- Portability : unknown+--+-- API for implementing ZoomCache applications+----------------------------------------------------------------------++module Data.ZoomCache (+    -- * Types+      TimeStamp(..)+    , TrackNo+    , TrackType(..)+    , DataRateType(..)++    , CacheFile(..)++    , ZoomReadable(..)++    , ZoomRaw(..)+    , ZoomSummary(..)+    , Packet(..)+    , Summary(..)++    -- * Track specification+    , TrackMap+    , TrackSpec(..)++    -- * The ZoomWrite class+    , ZoomWrite(..)++    -- * The ZoomW monad+    , ZoomW+    , withFileWrite+    , flush++    -- * Watermarks+    , watermark+    , setWatermark++    -- * TrackSpec helpers+    , oneTrack++    -- * Iteratee parsers+    , module Data.Iteratee.ZoomCache++    -- * Pretty printing+    , module Data.ZoomCache.Pretty+) where++import Data.ZoomCache.Write++import Data.Iteratee.ZoomCache+import Data.ZoomCache.Common+import Data.ZoomCache.Pretty+import Data.ZoomCache.Types

@@ -1,130 +0,0 @@-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE RecordWildCards #-}-{-# OPTIONS -Wall #-}-------------------------------------------------------------------------- |--- Module      : Data.ZoomCache.Write--- Copyright   : Conrad Parker--- License     : BSD3-style (see LICENSE)------ Maintainer  : Conrad Parker <conrad@metadecks.org>--- Stability   : unstable--- Portability : unknown------ Blaze-builder utility functions for writing ZoomCache files.-------------------------------------------------------------------------module Data.ZoomCache.Binary (-    -- * Builders-      encInt-    , encInt64-    , encDbl-    , fromRational64-    , fromGlobal-    , fromTrackType-    , fromDataRateType-    , fromTrackNo-    , fromSummary--    -- * Helpers-    , toWord64-) where--import Blaze.ByteString.Builder hiding (flush)-import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString.Lazy.Char8 as LC-import Data.Monoid-import Data.Ratio-import Data.Word-import Unsafe.Coerce (unsafeCoerce)--import Data.ZoomCache.Common-import Data.ZoomCache.Summary--------------------------------------------------------------------------- Builders for local types--fromGlobal :: Global -> Builder-fromGlobal Global{..} = mconcat-    [ fromLazyByteString globalHeader-    , mconcat $-        [ fromVersion version-        , encInt noTracks-        , fromRational64 presentationTime-        , fromRational64 baseTime-        ]-    , fromLazyByteString $ LC.pack (replicate 20 '\0') -- UTCTime-    ]--fromVersion :: Version -> Builder-fromVersion (Version vMaj vMin) = mconcat-    [ fromInt16be . fromIntegral $ vMaj-    , fromInt16be . fromIntegral $ vMin-    ]--fromTrackType :: TrackType -> Builder-fromTrackType ZDouble = fromInt16be 0-fromTrackType ZInt    = fromInt16be 1--fromDataRateType :: DataRateType -> Builder-fromDataRateType ConstantDR = fromInt16be 0-fromDataRateType VariableDR = fromInt16be 1--fromTrackNo :: TrackNo -> Builder-fromTrackNo = fromInt32be . fromIntegral--fromSummary :: Summary -> Builder-fromSummary s@SummaryDouble{..} = mconcat [ fromSummaryHeader s, l, d]-    where-        d = mconcat $ map encDbl-            [ summaryDoubleEntry-            , summaryDoubleExit-            , summaryDoubleMin-            , summaryDoubleMax-            , summaryAvg-            , summaryRMS-            ]-        l = encInt . L.length . toLazyByteString $ d-fromSummary s@SummaryInt{..} = mconcat [ fromSummaryHeader s, l, d]-    where-        d = mconcat $ map encInt-            [ summaryIntEntry-            , summaryIntExit-            , summaryIntMin-            , summaryIntMax-            ] ++ map encDbl-            [ summaryAvg-            , summaryRMS-            ]-        l = encInt . L.length . toLazyByteString $ d--fromSummaryHeader :: Summary -> Builder-fromSummaryHeader s = mconcat-    [ fromLazyByteString summaryHeader-    , encInt . summaryTrack $ s-    , encInt . summaryLevel $ s-    , encInt64 . unTS . summaryEntryTime $ s-    , encInt64 . unTS . summaryExitTime $ s-    ]--------------------------------------------------------------------------- Binary data helpers-    -fromRational64 :: Rational -> Builder-fromRational64 r = mconcat-    [ fromInt64be . fromIntegral . numerator $ r-    , fromInt64be . fromIntegral . denominator $ r-    ]--encInt :: forall a . (Integral a) => a -> Builder-encInt = fromInt32be . fromIntegral--encInt64 :: forall a . (Integral a) => a -> Builder-encInt64 = fromInt64be . fromIntegral--encDbl :: Double -> Builder-encDbl = fromWord64be . toWord64--toWord64 :: Double -> Word64-toWord64 = unsafeCoerce-

@@ -0,0 +1,52 @@+{-# OPTIONS -Wall #-}+----------------------------------------------------------------------+-- |+-- Module      : Data.ZoomCache.Codec+-- Copyright   : Conrad Parker+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Conrad Parker <conrad@metadecks.org>+-- Stability   : unstable+-- Portability : unknown+--+-- Interface for implementing ZoomCache codec instances.+-- This module re-exports the interfaces required for developing+-- zoom-cache codecs.+--+-- For sample implementations, read the source of the provided instances+-- "Data.ZoomCache.Int" and "Data.ZoomCache.Double".+----------------------------------------------------------------------++module Data.ZoomCache.Codec (+    -- * Interfaces+      ZoomReadable(..)+    , RawData()+    , SummaryData()+    , ZoomWritable(..)+    , ZoomWrite(..)++    -- * ZoomCache Types+    , TimeStamp(..)++    -- * Raw data iteratees+    , zReadInt16+    , zReadInt32+    , zReadInt64+    , zReadFloat64be+    , readRational64++    -- * Binary data helpers+    , fromRational64+    , fromIntegral32be+    , fromDouble++    -- * Write instance helpers+    , writeData+    , writeDataVBR+) where++import Blaze.ByteString.Builder.ZoomCache+import Data.Iteratee.ZoomCache.Utils+import Data.ZoomCache.Common+import Data.ZoomCache.Types+import Data.ZoomCache.Write

@@ -14,15 +14,13 @@  module Data.ZoomCache.Common (   -- * Types-    HeaderType(..)-  , TimeStamp(..)+    TimeStamp(..)   , TrackType(..)   , DataRateType(..)   , TrackNo    -- * Global header   , Global(..)-  , globalHeader    -- * CacheFile   , CacheFile(..)@@ -31,239 +29,23 @@    -- * Version   , Version(..)-  , versionMajor-  , versionMinor    -- * Track specification   , TrackMap   , TrackSpec(..)--  -- * Track header-  , trackHeader--  -- * Packet header-  , packetHeader--  -- * Summary header-  , summaryHeader ) where  import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString.Lazy.Char8 as LC import Data.IntMap (IntMap) import qualified Data.IntMap as IM  ------------------------------------------------------------ -{---All fields are big-endian.--Global header:--    0                   1                   2                   3-    0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1| Byte-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Identifier                                                    | 0-3-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   |                                                               | 4-7-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Version major                 | Version minor                 | 8-11-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | No. tracks                                                    | 12-15-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Presentationtime numerator                                    | 16-19-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   |                                                               | 20-23-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Presentationtime denominator                                  | 24-27-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   |                                                               | 28-31-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Basetime numerator                                            | 32-35-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   |                                                               | 36-39-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Basetime denominator                                          | 40-43-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   |                                                               | 44-47-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | UTC                                                           | 48-51-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   |                                                               | 52-55-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   |                                                               | 56-59-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   |                                                               | 60-63-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   |                                                               | 64-67-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+--Track header:--    0                   1                   2                   3-    0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1| Byte-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Identifier                                                    | 0-3-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   |                                                               | 4-7-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Track no.                                                     | 8-11-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Type                          | Flag: 0=CBR, 1=VBR            | 12-15-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Datarate numerator                                            | 16-19-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   |                                                               | 20-23-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Datarate denominator                                          | 24-27-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   |                                                               | 28-31-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Length of name in bytes                                       | 32-35-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Name (UTF-8) ...                                              | 36--   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+--Type: 0 64 bit IEEE754 floating point (Double)-      1 32 bit signed integer (Int32)--Datarate: numerator 0 indicates variable bitrate (all data values are timestamped)--Raw Data Packet header:--    0                   1                   2                   3-    0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1| Byte-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Identifier                                                    | 0-3-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   |                                                               | 4-7-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Track no.                                                     | 8-11-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Entry Timestamp                                               | 12-15-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | ...                                                           | 16-19-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Exit TImestamp                                                | 20-23-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | ...                                                           | 24-27-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Payload length in bytes (remainder of packet)                 | 28-31-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Count of data points COUNT                                    | 32-35-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Data ...                                                      | 36-39-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | ...                                                           | 40--   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Timestamps ...                                                | TS--   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | ...                                                           |-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+--Timestamps block is only present if VBR (datarate numerator is 0)--TS = 28 + (COUNT * sizeof(Type))---Summary Data Packet header (IEEE754 floating point):--    0                   1                   2                   3-    0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1| Byte-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Identifier                                                    | 0-3-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   |                                                               | 4-7-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Track no.                                                     | 8-11-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Level                                                         | 12-15-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Entry Timestamp                                               | 16-19-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | ...                                                           | 20-23-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Exit Timestamp                                                | 24-27-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | ...                                                           | 28-31-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Summary length in bytes                                       | 32-35-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Entry (double)                                                | 36-39-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   |                                                               | 40-43-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Exit (double)                                                 | 44-47-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   |                                                               | 48-51-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Min (double)                                                  | 52-55-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   |                                                               | 56-59-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Max (double)                                                  | 60-63-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   |                                                               | 64-67-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Avg (double)                                                  | 68-71-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   |                                                               | 72-75-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | RMS (double)                                                  | 76-79-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   |                                                               | 80-83-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+--Summary Data Packet header (signed 32-bit integer)--    0                   1                   2                   3-    0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1| Byte-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Identifier                                                    | 0-3-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   |                                                               | 4-7-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Track no.                                                     | 8-11-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Level                                                         | 12-15-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Entry Timestamp                                               | 16-19-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | ...                                                           | 20-23-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Exit Timestamp                                                | 24-27-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | ...                                                           | 28-31-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Summary length in bytes                                       | 32-35-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Entry (int32)                                                 | 36-39-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Exit (int32)                                                  | 40-43-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Min (int32)                                                   | 44-47-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Max (int32)                                                   | 48-51-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Avg (double)                                                  | 52-55-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   |                                                               | 56-59-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | RMS (double)                                                  | 60-63-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   |                                                               | 64-67-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+---}- type TrackNo = Int  data TimeStamp = TS { unTS :: !Integer }     deriving (Eq, Ord, Show) -data HeaderType = GlobalHeader | TrackHeader | PacketHeader | SummaryHeader- data Version = Version Int Int     deriving (Eq, Show) @@ -313,31 +95,4 @@ -- | Determine whether all tracks of a 'CacheFile' are specified fiFull :: CacheFile -> Bool fiFull (CacheFile g specs) = IM.size specs == noTracks g----------------------------------------------------------------- Magic---- | Magic identifier at the beginning of a zoom-cache file.-globalHeader :: L.ByteString-globalHeader = LC.pack "\xe5ZXhe4d\0"---- | The major version encoded by this library-versionMajor :: Int-versionMajor = 1---- | The minor version encoded by this library-versionMinor :: Int-versionMinor = 0---- | Identifier for track headers-trackHeader :: L.ByteString-trackHeader = LC.pack "\xe5ZXtRcK\0"---- | Identifier for packet headers-packetHeader :: L.ByteString-packetHeader = LC.pack "\xe5ZXp4ck\0"---- | Identifier for summary headers-summaryHeader :: L.ByteString-summaryHeader = LC.pack "\xe5ZX5umm\0" 

@@ -0,0 +1,175 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}+----------------------------------------------------------------------+-- |+-- Module      : Data.ZoomCache.Double+-- Copyright   : Conrad Parker+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Conrad Parker <conrad@metadecks.org>+-- Stability   : unstable+-- Portability : unknown+--+-- Default codec implementation for values of type Double. This module+-- implements the interfaces documented in "Data.ZoomCache.Codec".+-- View the module source for enlightenment.+----------------------------------------------------------------------++module Data.ZoomCache.Double (+      RawData(..)+    , SummaryData(..)+    , SummaryWork(..)+)where++import Blaze.ByteString.Builder+import Control.Monad (replicateM)+import Control.Monad.Trans (MonadIO)+import Data.Iteratee (Iteratee)+import Data.Monoid+import Data.Word+import Text.Printf++import Data.ZoomCache.Codec+import Numeric.FloatMinMax++----------------------------------------------------------------------+-- Read++instance ZoomReadable Double where+    data RawData Double = RDDouble [Double]++    readRaw  = zReadFloat64be+    fromList = RDDouble++    data SummaryData Double = SummaryDouble+        { summaryDoubleEntry :: Double+        , summaryDoubleExit  :: Double+        , summaryDoubleMin   :: Double+        , summaryDoubleMax   :: Double+        , summaryDoubleAvg   :: Double+        , summaryDoubleRMS   :: Double+        }++    readSummary = readSummaryDouble++    prettyRawData     = prettyPacketDouble+    prettySummaryData = prettySummaryDouble++prettyPacketDouble :: RawData Double -> [String]+prettyPacketDouble (RDDouble ds) = map (printf "%.3f") ds++readSummaryDouble :: (Functor m, MonadIO m)+                  => Iteratee [Word8] m (SummaryData Double)+readSummaryDouble = do+    [en,ex,mn,mx,avg,rms] <- replicateM 6 zReadFloat64be+    return (SummaryDouble en ex mn mx avg rms)++prettySummaryDouble :: SummaryData Double -> String+prettySummaryDouble SummaryDouble{..} = concat+    [ printf "\tentry: %.3f\texit: %.3f\tmin: %.3f\tmax: %.3f\t"+          summaryDoubleEntry summaryDoubleExit summaryDoubleMin summaryDoubleMax+    , printf "avg: %.3f\trms: %.3f" summaryDoubleAvg summaryDoubleRMS+    ]++{-+    typeOfSummaryData = typeOfSummaryDouble++typeOfSummaryDouble :: SummaryData Double -> TypeRep+typeOfSummaryDouble _ = mkTyConApp tyCon [d,d,d,d]+    where+        tyCon = mkTyCon3 "zoom-cache" "Data.ZoomCache.Types" "SummaryDouble"+        d = typeOf (undefined :: Double)+-}++----------------------------------------------------------------------+-- Write++instance ZoomWrite Double where+    write = writeData++instance ZoomWrite (TimeStamp, Double) where+    write = writeDataVBR++instance ZoomWritable Double where+    data SummaryWork Double = SummaryWorkDouble+        { ztsdTime  :: TimeStamp+        , ztsdEntry :: Double+        , ztsdExit  :: Double+        , ztsdMin   :: Double+        , ztsdMax   :: Double+        , ztsdSum   :: Double+        , ztsdSumSq :: Double+        }+    fromRaw           = fromDouble+    fromSummaryData   = fromSummaryDouble++    initSummaryWork   = initSummaryDouble+    toSummaryData     = mkSummaryDouble+    updateSummaryData = updateSummaryDouble+    appendSummaryData = appendSummaryDouble++initSummaryDouble :: TimeStamp -> SummaryWork Double+initSummaryDouble entry = SummaryWorkDouble+    { ztsdTime = entry+    , ztsdEntry = 0.0+    , ztsdExit = 0.0+    , ztsdMin = floatMax+    , ztsdMax = negate floatMax+    , ztsdSum = 0.0+    , ztsdSumSq = 0.0+    }++mkSummaryDouble :: Double -> SummaryWork Double -> SummaryData Double+mkSummaryDouble dur SummaryWorkDouble{..} = SummaryDouble+    { summaryDoubleEntry = ztsdEntry+    , summaryDoubleExit = ztsdExit+    , summaryDoubleMin = ztsdMin+    , summaryDoubleMax = ztsdMax+    , summaryDoubleAvg = ztsdSum / dur+    , summaryDoubleRMS = sqrt $ ztsdSumSq / dur+    }++fromSummaryDouble :: SummaryData Double -> Builder+fromSummaryDouble SummaryDouble{..} = mconcat $ map fromDouble+    [ summaryDoubleEntry+    , summaryDoubleExit+    , summaryDoubleMin+    , summaryDoubleMax+    , summaryDoubleAvg+    , summaryDoubleRMS+    ]++updateSummaryDouble :: Int -> TimeStamp -> Double -> SummaryWork Double+                    -> SummaryWork Double+updateSummaryDouble count t d SummaryWorkDouble{..} = SummaryWorkDouble+    { ztsdTime = t+    , ztsdEntry = if count == 0 then d else ztsdEntry+    , ztsdExit = d+    , ztsdMin = min ztsdMin d+    , ztsdMax = max ztsdMax d+    , ztsdSum = ztsdSum + (d * dur)+    , ztsdSumSq = ztsdSumSq + (d*d * dur)+    }+    where+        dur = fromIntegral $ (unTS t) - (unTS ztsdTime)++appendSummaryDouble :: Double -> SummaryData Double+                    -> Double -> SummaryData Double+                    -> SummaryData Double+appendSummaryDouble dur1 s1 dur2 s2 = SummaryDouble+    { summaryDoubleEntry = summaryDoubleEntry s1+    , summaryDoubleExit = summaryDoubleExit s2+    , summaryDoubleMin = min (summaryDoubleMin s1) (summaryDoubleMin s2)+    , summaryDoubleMax = max (summaryDoubleMax s1) (summaryDoubleMax s2)+    , summaryDoubleAvg = ((summaryDoubleAvg s1 * dur1) ++                          (summaryDoubleAvg s2 * dur2)) /+                         durSum+    , summaryDoubleRMS = sqrt $ ((summaryDoubleRMS s1 * summaryDoubleRMS s1 * dur1) ++                                 (summaryDoubleRMS s2 * summaryDoubleRMS s2 * dur2)) /+                                durSum+    }+    where+        durSum = dur1 + dur2+

@@ -0,0 +1,88 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS -Wall #-}+----------------------------------------------------------------------+-- |+-- Module      : Data.ZoomCache.Dump+-- Copyright   : Conrad Parker+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Conrad Parker <conrad@metadecks.org>+-- Stability   : unstable+-- Portability : unknown+--+-- Reading of ZoomCache files.+----------------------------------------------------------------------++module Data.ZoomCache.Dump (+    -- * Functions+      zoomDumpFile+    , zoomDumpSummary+    , zoomDumpSummaryLevel+    , zoomInfoFile+) where++import Control.Applicative ((<$>))+import Data.Int+import qualified Data.IntMap as IM+import qualified Data.Iteratee as I+import Text.Printf++import Data.ZoomCache++------------------------------------------------------------++zoomInfoFile :: FilePath -> IO ()+zoomInfoFile path = I.fileDriverRandom iterHeaders path >>= info++zoomDumpFile :: TrackNo -> FilePath -> IO ()+zoomDumpFile trackNo = I.fileDriverRandom (mapStream (dumpData trackNo))++zoomDumpSummary :: TrackNo -> FilePath -> IO ()+zoomDumpSummary trackNo = I.fileDriverRandom (mapStream (dumpSummary trackNo))++zoomDumpSummaryLevel :: TrackNo -> Int -> FilePath -> IO ()+zoomDumpSummaryLevel trackNo lvl = I.fileDriverRandom (mapStream (dumpSummaryLevel trackNo lvl))++----------------------------------------------------------------------++info :: CacheFile -> IO ()+info CacheFile{..} = do+    putStrLn . prettyGlobal $ cfGlobal+    mapM_ (putStrLn . uncurry prettyTrackSpec) . IM.assocs $ cfSpecs++streamRate :: Stream -> Maybe Rational+streamRate StreamNull = Nothing+streamRate s          = specRate <$> IM.lookup (strmTrack s) (cfSpecs (strmFile s))++dumpData :: TrackNo -> Stream -> IO ()+dumpData trackNo s@StreamPacket{..}+    | strmTrack == trackNo = mapM_ (\(t,d) -> printf "%s: %s\n" t d) tds+    | otherwise            = return ()+    where+        pretty = case streamRate s of+            Just r  -> prettyTimeStamp r+            Nothing -> show . unTS+        tds = zip (map pretty (packetTimeStamps strmPacket)) vals+        vals = f (packetData strmPacket)+        f (ZoomRaw a) = prettyRawData a+dumpData _ _ = return ()++dumpSummary :: TrackNo -> Stream -> IO ()+dumpSummary trackNo s@StreamSummary{..}+    | strmTrack == trackNo = case streamRate s of+        Just r  -> putStrLn $ f r strmSummary+        Nothing -> return ()+    | otherwise            = return ()+    where+        f r (ZoomSummary a) = prettySummary r a+dumpSummary _ _           = return ()++dumpSummaryLevel :: TrackNo -> Int -> Stream -> IO ()+dumpSummaryLevel trackNo level s@StreamSummary{..}+    | level == opLevel strmSummary && strmTrack == trackNo = dumpSummary trackNo s+    | otherwise                                            = return ()+    where opLevel (ZoomSummary a) = summaryLevel a+dumpSummaryLevel _ _ _ = return ()+

@@ -0,0 +1,280 @@+{-# OPTIONS -Wall #-}+----------------------------------------------------------------------+-- |+-- Module      : Data.ZoomCache.Format+-- Copyright   : Conrad Parker+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Conrad Parker <conrad@metadecks.org>+-- Stability   : unstable+-- Portability : unknown+--+-- zoom-cache format specification+--+-- All fields are big-endian.+----------------------------------------------------------------------++module Data.ZoomCache.Format (++  -- * Global header+    globalHeader+  , versionMajor+  , versionMinor++  -- * Track header+  , trackHeader++  -- * Packet header+  , packetHeader++  -- * Summary header+  , summaryHeader+) where++import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as LC++{- |++Global header:++@+    0                   1                   2                   3+    0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1| Byte+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Identifier                                                    | 0-3+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   |                                                               | 4-7+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Version major                 | Version minor                 | 8-11+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | No. tracks                                                    | 12-15+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Presentationtime numerator                                    | 16-19+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   |                                                               | 20-23+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Presentationtime denominator                                  | 24-27+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   |                                                               | 28-31+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Basetime numerator                                            | 32-35+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   |                                                               | 36-39+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Basetime denominator                                          | 40-43+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   |                                                               | 44-47+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | UTC                                                           | 48-51+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   |                                                               | 52-55+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   |                                                               | 56-59+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   |                                                               | 60-63+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   |                                                               | 64-67+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++@+-}++-- | Magic identifier at the beginning of a zoom-cache file.+globalHeader :: L.ByteString+globalHeader = LC.pack "\xe5ZXhe4d\0"++-- | The major version encoded by this library+versionMajor :: Int+versionMajor = 1++-- | The minor version encoded by this library+versionMinor :: Int+versionMinor = 0++{- |++Track header:++@+    0                   1                   2                   3+    0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1| Byte+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Identifier                                                    | 0-3+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   |                                                               | 4-7+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Track no.                                                     | 8-11+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Type                          | Flag: 0=CBR, 1=VBR            | 12-15+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Datarate numerator                                            | 16-19+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   |                                                               | 20-23+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Datarate denominator                                          | 24-27+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   |                                                               | 28-31+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Length of name in bytes                                       | 32-35+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Name (UTF-8) ...                                              | 36-+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++@++Type: 0 64 bit IEEE754 floating point (Double)+      1 32 bit signed integer (Int32)++Datarate: numerator 0 indicates variable bitrate (all data values are timestamped)+-}++-- | Identifier for track headers+trackHeader :: L.ByteString+trackHeader = LC.pack "\xe5ZXtRcK\0"+++{- |++Raw Data Packet header:++@+    0                   1                   2                   3+    0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1| Byte+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Identifier                                                    | 0-3+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   |                                                               | 4-7+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Track no.                                                     | 8-11+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Entry Timestamp                                               | 12-15+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | ...                                                           | 16-19+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Exit TImestamp                                                | 20-23+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | ...                                                           | 24-27+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Payload length in bytes (remainder of packet)                 | 28-31+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Count of data points COUNT                                    | 32-35+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Data ...                                                      | 36-39+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | ...                                                           | 40-+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Timestamps ...                                                | TS-+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | ...                                                           |+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++@++Timestamps block is only present if VBR (datarate numerator is 0)++TS = 28 + (COUNT * sizeof(Type))+-}+-- | Identifier for packet headers+packetHeader :: L.ByteString+packetHeader = LC.pack "\xe5ZXp4ck\0"+++{- |++Summary Data Packet header (IEEE754 floating point):++@+    0                   1                   2                   3+    0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1| Byte+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Identifier                                                    | 0-3+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   |                                                               | 4-7+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Track no.                                                     | 8-11+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Level                                                         | 12-15+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Entry Timestamp                                               | 16-19+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | ...                                                           | 20-23+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Exit Timestamp                                                | 24-27+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | ...                                                           | 28-31+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Summary length in bytes                                       | 32-35+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Entry (double)                                                | 36-39+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   |                                                               | 40-43+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Exit (double)                                                 | 44-47+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   |                                                               | 48-51+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Min (double)                                                  | 52-55+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   |                                                               | 56-59+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Max (double)                                                  | 60-63+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   |                                                               | 64-67+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Avg (double)                                                  | 68-71+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   |                                                               | 72-75+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | RMS (double)                                                  | 76-79+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   |                                                               | 80-83+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++@+-}++{- |++Summary Data Packet header (signed 32-bit integer)++@+    0                   1                   2                   3+    0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1| Byte+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Identifier                                                    | 0-3+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   |                                                               | 4-7+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Track no.                                                     | 8-11+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Level                                                         | 12-15+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Entry Timestamp                                               | 16-19+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | ...                                                           | 20-23+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Exit Timestamp                                                | 24-27+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | ...                                                           | 28-31+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Summary length in bytes                                       | 32-35+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Entry (int32)                                                 | 36-39+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Exit (int32)                                                  | 40-43+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Min (int32)                                                   | 44-47+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Max (int32)                                                   | 48-51+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Avg (double)                                                  | 52-55+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   |                                                               | 56-59+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | RMS (double)                                                  | 60-63+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   |                                                               | 64-67+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++@+-}+-- | Identifier for summary headers+summaryHeader :: L.ByteString+summaryHeader = LC.pack "\xe5ZX5umm\0"+

@@ -0,0 +1,177 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}+----------------------------------------------------------------------+-- |+-- Module      : Data.ZoomCache.Int+-- Copyright   : Conrad Parker+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Conrad Parker <conrad@metadecks.org>+-- Stability   : unstable+-- Portability : unknown+--+-- Default codec implementation for values of type Int. This module+-- implements the interfaces documented in "Data.ZoomCache.Codec".+-- View the module source for enlightenment.+----------------------------------------------------------------------++module Data.ZoomCache.Int (+      RawData(..)+    , SummaryData(..)+    , SummaryWork(..)+)where++import Blaze.ByteString.Builder+import Control.Monad (replicateM)+import Control.Monad.Trans (MonadIO)+import Data.Iteratee (Iteratee)+import Data.Monoid+import Data.Word+import Text.Printf++import Data.ZoomCache.Codec++----------------------------------------------------------------------+-- Read++instance ZoomReadable Int where+    data RawData Int = RDInt [Int]++    readRaw  = zReadInt32+    fromList = RDInt++    data SummaryData Int = SummaryInt+        { summaryIntEntry :: Int+        , summaryIntExit  :: Int+        , summaryIntMin   :: Int+        , summaryIntMax   :: Int+        , summaryIntAvg   :: Double+        , summaryIntRMS   :: Double+        }++    readSummary = readSummaryInt++    prettyRawData  = prettyPacketInt+    prettySummaryData = prettySummaryInt++prettyPacketInt :: RawData Int -> [String]+prettyPacketInt (RDInt ds) = map show ds++readSummaryInt :: (Functor m, MonadIO m)+               => Iteratee [Word8] m (SummaryData Int)+readSummaryInt = do+    [en,ex,mn,mx] <- replicateM 4 zReadInt32+    [avg,rms] <- replicateM 2 zReadFloat64be+    return (SummaryInt en ex mn mx avg rms)++prettySummaryInt :: SummaryData Int -> String+prettySummaryInt SummaryInt{..} = concat+    [ printf "\tentry: %d\texit: %df\tmin: %d\tmax: %d\t"+          summaryIntEntry summaryIntExit summaryIntMin summaryIntMax+    , printf "avg: %.3f\trms: %.3f" summaryIntAvg summaryIntRMS+    ]++{-+    typeOfSummaryData = typeOfSummaryInt++typeOfSummaryInt :: SummaryData Int -> TypeRep+typeOfSummaryInt _ = mkTyConApp tyCon [i,i,i,i]+    where+        tyCon = mkTyCon3 "zoom-cache" "Data.ZoomCache.Types" "SummaryInt"+        i = typeOf (undefined :: Int)+-}++----------------------------------------------------------------------+-- Write++instance ZoomWrite Int where+    write = writeData++instance ZoomWrite (TimeStamp, Int) where+    write = writeDataVBR++instance ZoomWritable Int where+    data SummaryWork Int = SummaryWorkInt+        { ztsiTime  :: TimeStamp+        , ztsiEntry :: Int+        , ztsiExit  :: Int+        , ztsiMin   :: Int+        , ztsiMax   :: Int+        , ztsiSum   :: Int+        , ztsiSumSq :: Double+        }++    fromRaw           = fromIntegral32be+    fromSummaryData   = fromSummaryInt++    initSummaryWork   = initSummaryInt+    toSummaryData     = mkSummaryInt+    updateSummaryData = updateSummaryInt+    appendSummaryData = appendSummaryInt++initSummaryInt :: TimeStamp -> SummaryWork Int+initSummaryInt entry = SummaryWorkInt+    { ztsiTime = entry+    , ztsiEntry = 0+    , ztsiExit = 0+    , ztsiMin = maxBound+    , ztsiMax = minBound+    , ztsiSum = 0+    , ztsiSumSq = 0+    }++mkSummaryInt :: Double -> SummaryWork Int -> SummaryData Int+mkSummaryInt dur SummaryWorkInt{..} = SummaryInt+    { summaryIntEntry = ztsiEntry+    , summaryIntExit = ztsiExit+    , summaryIntMin = ztsiMin+    , summaryIntMax = ztsiMax+    , summaryIntAvg = fromIntegral ztsiSum / dur+    , summaryIntRMS = sqrt $ ztsiSumSq / dur+    }++fromSummaryInt :: SummaryData Int -> Builder+fromSummaryInt SummaryInt{..} = mconcat $ map fromIntegral32be+    [ summaryIntEntry+    , summaryIntExit+    , summaryIntMin+    , summaryIntMax+    ] ++ map fromDouble+    [ summaryIntAvg+    , summaryIntRMS+    ]++updateSummaryInt :: Int -> TimeStamp  -> Int -> SummaryWork Int+                 -> SummaryWork Int+updateSummaryInt count t i SummaryWorkInt{..} = SummaryWorkInt+    { ztsiTime = t+    , ztsiEntry = if count == 0 then i else ztsiEntry+    , ztsiExit = i+    , ztsiMin = min ztsiMin i+    , ztsiMax = max ztsiMax i+    , ztsiSum = ztsiSum + (i * dur)+    , ztsiSumSq = ztsiSumSq + fromIntegral (i*i * dur)+    }+    where+        dur = fromIntegral $ (unTS t) - (unTS ztsiTime)++appendSummaryInt :: Double -> SummaryData Int+                 -> Double -> SummaryData Int+                 -> SummaryData Int+appendSummaryInt dur1 s1 dur2 s2 = SummaryInt+    { summaryIntEntry = summaryIntEntry s1+    , summaryIntExit = summaryIntExit s2+    , summaryIntMin = min (summaryIntMin s1) (summaryIntMin s2)+    , summaryIntMax = max (summaryIntMax s1) (summaryIntMax s2)+    , summaryIntAvg = ((summaryIntAvg s1 * dur1) ++                       (summaryIntAvg s2 * dur2)) /+                      durSum+    , summaryIntRMS = sqrt $ ((summaryIntRMS s1 * summaryIntRMS s1 * dur1) ++                              (summaryIntRMS s2 * summaryIntRMS s2 * dur2)) /+                             durSum+    }+    where+        durSum = dur1 + dur2+

@@ -1,36 +0,0 @@-{-# OPTIONS -Wall #-}-------------------------------------------------------------------------- |--- Module      : Data.ZoomCache.Write--- Copyright   : Conrad Parker--- License     : BSD3-style (see LICENSE)------ Maintainer  : Conrad Parker <conrad@metadecks.org>--- Stability   : unstable--- Portability : unknown------ ZoomCache packet definition-------------------------------------------------------------------------module Data.ZoomCache.Packet (-    -- * Types-      Packet(..)-    , PacketData(..)-) where--import Data.ZoomCache.Common----------------------------------------------------------------data PacketData = PDDouble [Double] | PDInt [Int]--data Packet = Packet-    { packetTrack      :: TrackNo-    , packetEntryTime  :: TimeStamp-    , packetExitTime   :: TimeStamp-    , packetCount      :: Int-    , packetData       :: PacketData-    , packetTimeStamps :: [TimeStamp]-    }--------------------------------------------------------------

@@ -25,7 +25,7 @@ import Text.Printf  import Data.ZoomCache.Common-import Data.ZoomCache.Summary+import Data.ZoomCache.Types  ---------------------------------------------------------------------- @@ -67,33 +67,21 @@           (hrs, minN) = quotRem minT 60  -- | Pretty-print a 'Summary', given a datarate-prettySummary :: Rational -> Summary -> String-prettySummary r s@SummaryDouble{..} = concat-    [ prettySummaryTimes r s-    , prettySummaryLevel s-    , printf "\tentry: %.3f\texit: %.3f\tmin: %.3f\tmax: %.3f\t"-          summaryDoubleEntry summaryDoubleExit summaryDoubleMin summaryDoubleMax-    , prettySummaryAvgRMS s-    ]-prettySummary r s@SummaryInt{..} = concat+prettySummary :: ZoomReadable a => Rational -> Summary a -> String+prettySummary r s = concat     [ prettySummaryTimes r s     , prettySummaryLevel s-    , printf "\tentry: %d\texit: %df\tmin: %d\tmax: %d\t"-        summaryIntEntry summaryIntExit summaryIntMin summaryIntMax-    , prettySummaryAvgRMS s+    , prettySummaryData (summaryData s)     ] -prettySummaryTimes :: Rational -> Summary -> String+prettySummaryTimes :: Rational -> Summary a -> String prettySummaryTimes r s = concat     [ "[", (prettyTimeStamp r $ summaryEntryTime s)     , "-", (prettyTimeStamp r $ summaryExitTime s), "] "     ] -prettySummaryLevel :: Summary -> String+prettySummaryLevel :: Summary a -> String prettySummaryLevel s = printf "lvl: %d" (summaryLevel s)--prettySummaryAvgRMS :: Summary -> String-prettySummaryAvgRMS s = printf "avg: %.3f\trms: %.3f" (summaryAvg s) (summaryRMS s)  ---------------------------------------------------------------------- 

@@ -1,89 +0,0 @@-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE RecordWildCards #-}-{-# OPTIONS -Wall #-}-------------------------------------------------------------------------- |--- Module      : Data.ZoomCache.Write--- Copyright   : Conrad Parker--- License     : BSD3-style (see LICENSE)------ Maintainer  : Conrad Parker <conrad@metadecks.org>--- Stability   : unstable--- Portability : unknown------ Reading of ZoomCache files.-------------------------------------------------------------------------module Data.ZoomCache.Read (-    -- * Functions-      zoomDumpFile-    , zoomDumpSummary-    , zoomDumpSummaryLevel-    , zoomInfoFile-) where--import Control.Applicative ((<$>))-import Data.Int-import qualified Data.IntMap as IM-import qualified Data.Iteratee as I-import Text.Printf--import Data.Iteratee.ZoomCache-import Data.ZoomCache.Common-import Data.ZoomCache.Packet-import Data.ZoomCache.Pretty-import Data.ZoomCache.Summary----------------------------------------------------------------zoomInfoFile :: FilePath -> IO ()-zoomInfoFile path = I.fileDriverRandom iterHeaders path >>= info--zoomDumpFile :: TrackNo -> FilePath -> IO ()-zoomDumpFile trackNo = I.fileDriverRandom (mapStream (dumpData trackNo))--zoomDumpSummary :: TrackNo -> FilePath -> IO ()-zoomDumpSummary trackNo = I.fileDriverRandom (mapStream (dumpSummary trackNo))--zoomDumpSummaryLevel :: TrackNo -> Int -> FilePath -> IO ()-zoomDumpSummaryLevel trackNo lvl = I.fileDriverRandom (mapStream (dumpSummaryLevel trackNo lvl))--------------------------------------------------------------------------info :: CacheFile -> IO ()-info CacheFile{..} = do-    putStrLn . prettyGlobal $ cfGlobal-    mapM_ (putStrLn . uncurry prettyTrackSpec) . IM.assocs $ cfSpecs--streamRate :: Stream -> Maybe Rational-streamRate StreamNull = Nothing-streamRate s          = specRate <$> IM.lookup (strmTrack s) (cfSpecs (strmFile s))--dumpData :: TrackNo -> Stream -> IO ()-dumpData trackNo s@StreamPacket{..}-    | strmTrack == trackNo = mapM_ (\(t,d) -> printf "%s: %s\n" t d) tds-    | otherwise            = return ()-    where-        pretty = case streamRate s of-            Just r  -> prettyTimeStamp r-            Nothing -> show . unTS-        tds = zip (map pretty (packetTimeStamps strmPacket)) vals-        vals = case packetData strmPacket of-            PDDouble ds -> map (printf "%.3f") ds-            PDInt is    -> map show is-dumpData _ _ = return ()--dumpSummary :: TrackNo -> Stream -> IO ()-dumpSummary trackNo s@StreamSummary{..}-    | strmTrack == trackNo = case streamRate s of-        Just r  -> putStrLn $ prettySummary r strmSummary-        Nothing -> return ()-    | otherwise            = return ()-dumpSummary _ _            = return ()--dumpSummaryLevel :: TrackNo -> Int -> Stream -> IO ()-dumpSummaryLevel trackNo level s@StreamSummary{..}-    | level == summaryLevel strmSummary && strmTrack == trackNo = dumpSummary trackNo s-    | otherwise                                                 = return ()-dumpSummaryLevel _ _ _ = return ()-

@@ -1,97 +0,0 @@-{-# LANGUAGE RecordWildCards #-}-{-# OPTIONS -Wall #-}-------------------------------------------------------------------------- |--- Module      : Data.ZoomCache.Write--- Copyright   : Conrad Parker--- License     : BSD3-style (see LICENSE)------ Maintainer  : Conrad Parker <conrad@metadecks.org>--- Stability   : unstable--- Portability : unknown------ ZoomCache Summary definition-------------------------------------------------------------------------module Data.ZoomCache.Summary (-  -- * Types-    Summary(..)-  , summaryDuration-  , appendSummary-) where--import Data.ZoomCache.Common---------------------------------------------------------------------------- | A recorded block of summary data-data Summary = SummaryDouble-    { summaryTrack :: TrackNo-    , summaryLevel :: Int-    , summaryEntryTime :: TimeStamp-    , summaryExitTime :: TimeStamp-    , summaryDoubleEntry :: Double-    , summaryDoubleExit :: Double-    , summaryDoubleMin :: Double-    , summaryDoubleMax :: Double-    , summaryAvg :: Double-    , summaryRMS :: Double-    }-    | SummaryInt-    { summaryTrack :: TrackNo-    , summaryLevel :: Int-    , summaryEntryTime :: TimeStamp-    , summaryExitTime :: TimeStamp-    , summaryIntEntry :: Int-    , summaryIntExit :: Int-    , summaryIntMin :: Int-    , summaryIntMax :: Int-    , summaryAvg :: Double-    , summaryRMS :: Double-    }-    deriving (Show)---- | The duration covered by a summary, in units of 1 / the track's datarate-summaryDuration :: Summary -> Integer-summaryDuration s = (unTS $ summaryExitTime s) - (unTS $ summaryEntryTime s)---- | Append two Summaries, merging statistical summary data.--- XXX: summaries are only compatible if tracks and levels are equal-appendSummary :: Summary -> Summary -> Summary-appendSummary s1@SummaryDouble{} s2@SummaryDouble{} = SummaryDouble-    { summaryTrack = summaryTrack s1-    , summaryLevel = summaryLevel s1-    , summaryEntryTime = summaryEntryTime s1-    , summaryExitTime = summaryExitTime s2-    , summaryDoubleEntry = summaryDoubleEntry s1-    , summaryDoubleExit = summaryDoubleExit s2-    , summaryDoubleMin = min (summaryDoubleMin s1) (summaryDoubleMin s2)-    , summaryDoubleMax = max (summaryDoubleMax s1) (summaryDoubleMax s2)-    , summaryAvg = ((summaryAvg s1 * dur s1) +-                    (summaryAvg s2 * dur s2)) /-                   (dur s1 + dur s2)-    , summaryRMS = sqrt $ ((summaryRMS s1 * summaryRMS s1 * dur s1) +-                           (summaryRMS s2 * summaryRMS s2 * dur s2)) /-                          (dur s1 + dur s2)-    }-    where-        dur = fromIntegral . summaryDuration-appendSummary s1@SummaryInt{} s2@SummaryInt{} = SummaryInt-    { summaryTrack = summaryTrack s1-    , summaryLevel = summaryLevel s1-    , summaryEntryTime = summaryEntryTime s1-    , summaryExitTime = summaryExitTime s2-    , summaryIntEntry = summaryIntEntry s1-    , summaryIntExit = summaryIntExit s2-    , summaryIntMin = min (summaryIntMin s1) (summaryIntMin s2)-    , summaryIntMax = max (summaryIntMax s1) (summaryIntMax s2)-    , summaryAvg = ((summaryAvg s1 * dur s1) +-                    (summaryAvg s2 * dur s2)) /-                   (dur s1 + dur s2)-    , summaryRMS = sqrt $ ((summaryRMS s1 * summaryRMS s1 * dur s1) +-                           (summaryRMS s2 * summaryRMS s2 * dur s2)) /-                          (dur s1 + dur s2)-    }-    where-        dur = fromIntegral . summaryDuration-appendSummary _ _ = error "Incompatible summaries"

@@ -0,0 +1,115 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS -Wall #-}+----------------------------------------------------------------------+-- |+-- Module      : Data.ZoomCache.Types+-- Copyright   : Conrad Parker+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Conrad Parker <conrad@metadecks.org>+-- Stability   : unstable+-- Portability : unknown+--+-- ZoomCache packet and summary types and interfaces+----------------------------------------------------------------------++module Data.ZoomCache.Types (+    -- * Classes+      ZoomReadable(..)+    , RawData()+    , ZoomWritable(..)++    , ZoomRaw(..)++    , ZoomSummary(..)++    , ZoomWork(..)++    -- * Types+    , Packet(..)+    , Summary(..)+    , SummaryData()++    , summaryDuration+) where++import Blaze.ByteString.Builder+import Control.Monad.Trans (MonadIO)+import Data.Dynamic+import Data.IntMap (IntMap)+import Data.Iteratee (Iteratee)+import Data.Word++import Data.ZoomCache.Common++------------------------------------------------------------++data Packet = Packet+    { packetTrack      :: TrackNo+    , packetEntryTime  :: TimeStamp+    , packetExitTime   :: TimeStamp+    , packetCount      :: Int+    , packetData       :: ZoomRaw+    , packetTimeStamps :: [TimeStamp]+    }++------------------------------------------------------------+-- | A recorded block of summary data+data Summary a = Summary+    { summaryTrack :: TrackNo+    , summaryLevel :: Int+    , summaryEntryTime :: TimeStamp+    , summaryExitTime :: TimeStamp+    , summaryData :: SummaryData a+    }++-- | The duration covered by a summary, in units of 1 / the track's datarate+summaryDuration :: Summary a -> Integer+summaryDuration s = (unTS $ summaryExitTime s) - (unTS $ summaryEntryTime s)++------------------------------------------------------------+-- Read++class ZoomReadable a where+    data RawData a  :: *+    readRaw         :: (Functor m, MonadIO m)+                    => Iteratee [Word8] m a+    fromList        :: [a] -> RawData a++    data SummaryData a :: *+    readSummary        :: (Functor m, MonadIO m)+                       => Iteratee [Word8] m (SummaryData a)++    prettyRawData      :: RawData a -> [String]+    prettySummaryData  :: SummaryData a -> String+    -- typeOfSummaryData :: SummaryData a -> TypeRep++data ZoomRaw = forall a . ZoomReadable a => ZoomRaw (RawData a)++data ZoomSummary = forall a . ZoomReadable a => ZoomSummary (Summary a)++------------------------------------------------------------+-- Write++class ZoomWritable a where+    data SummaryWork a :: *++    fromRaw            :: a -> Builder+    fromSummaryData    :: SummaryData a -> Builder++    initSummaryWork    :: TimeStamp -> SummaryWork a+    toSummaryData      :: Double -> SummaryWork a -> SummaryData a+    updateSummaryData  :: Int -> TimeStamp -> a+                       -> SummaryWork a+                       -> SummaryWork a+    appendSummaryData  :: Double -> SummaryData a+                       -> Double -> SummaryData a+                       -> SummaryData a++data ZoomWork = forall a . (Typeable a, ZoomWritable a) => ZoomWork+    { levels   :: IntMap (Summary a -> Summary a)+    , currWork :: Maybe (SummaryWork a)+    }

@@ -2,6 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-} {-# OPTIONS -Wall #-} ---------------------------------------------------------------------- -- |@@ -20,6 +21,10 @@     -- * The ZoomWrite class       ZoomWrite(..) +    -- * Instance helpers+    , writeData+    , writeDataVBR+     -- * The ZoomW monad     , ZoomW     , withFileWrite@@ -42,16 +47,18 @@ import Control.Monad.State import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as LC+import Data.Dynamic import qualified Data.Foldable as Fold import Data.IntMap (IntMap) import qualified Data.IntMap as IM import Data.Monoid import System.IO -import Data.ZoomCache.Binary+import Blaze.ByteString.Builder.ZoomCache+import Blaze.ByteString.Builder.ZoomCache.Internal import Data.ZoomCache.Common-import Data.ZoomCache.Summary-import Numeric.FloatMinMax+import Data.ZoomCache.Format+import Data.ZoomCache.Types  ------------------------------------------------------------ @@ -62,24 +69,12 @@     -- | Write a value to an open ZoomCache file.     write :: TrackNo -> t -> ZoomW () -instance ZoomWrite Double where-    write = writeDouble--instance ZoomWrite Int where-    write = writeInt--instance ZoomWrite (TimeStamp, Double) where-    write = writeDoubleVBR--instance ZoomWrite (TimeStamp, Int) where-    write = writeIntVBR- ------------------------------------------------------------  data ZoomWHandle = ZoomWHandle     { whHandle    :: Handle     , whTrackWork :: IntMap TrackWork-    , whDeferred  :: IntMap [Summary]+    , whDeferred  :: IntMap Builder     , whWriteData :: Bool     } @@ -89,29 +84,9 @@     , twTSBuilder :: Builder     , twCount     :: Int     , twWatermark :: Int-    , twLevels    :: IntMap (Maybe Summary)     , twEntryTime :: TimeStamp     , twExitTime  :: TimeStamp-    , twData      :: ZTSData-    }--data ZTSData = ZTSDouble-    { ztsTime  :: TimeStamp-    , ztsdEntry :: Double-    , ztsdExit  :: Double-    , ztsdMin   :: Double-    , ztsdMax   :: Double-    , ztsdSum   :: Double-    , ztsSumSq  :: Double-    }-    | ZTSInt-    { ztsTime  :: TimeStamp-    , ztsiEntry :: Int-    , ztsiExit  :: Int-    , ztsiMin   :: Int-    , ztsiMax   :: Int-    , ztsiSum   :: Int-    , ztsSumSq  :: Double+    , twWriter    :: Maybe ZoomWork     }  ----------------------------------------------------------------------@@ -144,17 +119,17 @@     when doRaw $         liftIO $ Fold.mapM_ (L.hPut h) $ IM.mapWithKey bsFromTrack tracks     mapM_ (uncurry flushSummary) (IM.assocs tracks)-    pending <- concat . IM.elems <$> gets whDeferred-    mapM_ writeSummary pending+    pending <- mconcat . IM.elems <$> gets whDeferred+    liftIO . L.hPut h . toLazyByteString $ pending     modify $ \z -> z         { whTrackWork = IM.map flushTrack (whTrackWork z)         , whDeferred = IM.empty         }     where         flushTrack :: TrackWork -> TrackWork-        flushTrack tw = d{twLevels = twLevels tw}+        flushTrack tw = d{twWriter = clearWork <$> (twWriter tw)}             where-                d = mkTrackState (twSpec tw) (twExitTime tw) (twWatermark tw)+                d = mkTrackWork (twSpec tw) (twExitTime tw) (twWatermark tw)  -- | Open a new ZoomCache file for writing, using a specified 'TrackMap'. openWrite :: TrackMap@@ -175,7 +150,7 @@                  -> IntMap TrackWork         addTrack trackNo spec = IM.insert trackNo trackState             where-                trackState = mkTrackState spec (TS 0) 1024+                trackState = mkTrackWork spec (TS 0) 1024  -- | Create a track map for a stream of a given type, as track no. 1 oneTrack :: TrackType -> DataRateType -> Rational -> L.ByteString -> TrackMap@@ -214,7 +189,7 @@             , fromTrackType specType             , fromDataRateType specDRType             , fromRational64 specRate-            , encInt . LC.length $ specName+            , fromIntegral32be . LC.length $ specName             ]         , specName         ]@@ -249,84 +224,39 @@         flushNeeded :: TrackWork -> Bool         flushNeeded TrackWork{..} = twCount >= twWatermark -writeData :: (ZoomWrite a)-          => (a -> Builder)-          -> (Int -> TimeStamp -> a -> ZTSData -> ZTSData)-          -> TrackNo -> a -> ZoomW ()-writeData builder updater trackNo d = do+writeData :: (Typeable a, ZoomWrite a, ZoomWritable a)+          => TrackNo -> a -> ZoomW ()+writeData trackNo d = do     incTime trackNo      doRaw <- gets whWriteData     when doRaw $-        modifyTrack trackNo $ \z -> z { twBuilder = twBuilder z <> builder d }+        modifyTrack trackNo $ \z -> z { twBuilder = twBuilder z <> fromRaw d }      modifyTrack trackNo $ \z -> z         { twCount = twCount z + 1-        , twData = updater (twCount z) (twExitTime z) d (twData z)+        , twWriter = updateWork (twCount z) (twExitTime z) d (twWriter z)         }     flushIfNeeded trackNo -writeDataVBR :: (ZoomWrite a)-             => (a -> Builder)-             -> (Int -> TimeStamp -> a -> ZTSData -> ZTSData)-             -> TrackNo -> (TimeStamp, a) -> ZoomW ()-writeDataVBR builder updater trackNo (t, d) = do+writeDataVBR :: (Typeable a, ZoomWrite a, ZoomWritable a)+             => TrackNo -> (TimeStamp, a) -> ZoomW ()+writeDataVBR trackNo (t, d) = do     setTime trackNo t      doRaw <- gets whWriteData     when doRaw $         modifyTrack trackNo $ \z -> z-            { twBuilder = twBuilder z <> builder d-            , twTSBuilder = twTSBuilder z <>-                  (encInt64 .  unTS) t+            { twBuilder = twBuilder z <> fromRaw d+            , twTSBuilder = twTSBuilder z <> fromTimeStamp t             }      modifyTrack trackNo $ \z -> z         { twCount = twCount z + 1-        , twData = updater (twCount z) t d (twData z)+        , twWriter = updateWork (twCount z) t d (twWriter z)         }     flushIfNeeded trackNo -writeDouble :: TrackNo -> Double -> ZoomW ()-writeDouble = writeData (fromWord64be . toWord64) updateZTSDouble--writeDoubleVBR :: TrackNo -> (TimeStamp, Double) -> ZoomW ()-writeDoubleVBR = writeDataVBR (fromWord64be . toWord64) updateZTSDouble--updateZTSDouble :: Int -> TimeStamp -> Double -> ZTSData -> ZTSData-updateZTSDouble count t d ZTSDouble{..} = ZTSDouble-    { ztsTime = t-    , ztsdEntry = if count == 0 then d else ztsdEntry-    , ztsdExit = d-    , ztsdMin = min ztsdMin d-    , ztsdMax = max ztsdMax d-    , ztsdSum = ztsdSum + (d * dur)-    , ztsSumSq = ztsSumSq + (d*d * dur)-    }-    where-        dur = fromIntegral $ (unTS t) - (unTS ztsTime)-updateZTSDouble _ _ _ ZTSInt{..} = error "updateZTSDouble on Int data"--writeInt :: TrackNo -> Int -> ZoomW ()-writeInt = writeData encInt updateZTSInt--writeIntVBR :: TrackNo -> (TimeStamp, Int) -> ZoomW ()-writeIntVBR = writeDataVBR encInt updateZTSInt--updateZTSInt :: Int -> TimeStamp  -> Int -> ZTSData -> ZTSData-updateZTSInt count t i ZTSInt{..} = ZTSInt-    { ztsTime = t-    , ztsiEntry = if count == 0 then i else ztsiEntry-    , ztsiExit = i-    , ztsiMin = min ztsiMin i-    , ztsiMax = max ztsiMax i-    , ztsiSum = ztsiSum + (i * dur)-    , ztsSumSq = ztsSumSq + fromIntegral (i*i * dur)-    }-    where-        dur = fromIntegral $ (unTS t) - (unTS ztsTime)-updateZTSInt _ _ _ ZTSDouble{..} = error "updateZTSInt on Double data"- ---------------------------------------------------------------------- -- Global @@ -351,112 +281,116 @@ bsFromTrack :: TrackNo -> TrackWork -> L.ByteString bsFromTrack trackNo TrackWork{..} = toLazyByteString $ mconcat     [ fromLazyByteString packetHeader-    , encInt trackNo-    , encInt64 . unTS $ twEntryTime-    , encInt64 . unTS $ twExitTime-    , encInt (len twBuilder + len twTSBuilder)-    , encInt twCount+    , fromIntegral32be trackNo+    , fromTimeStamp twEntryTime+    , fromTimeStamp twExitTime+    , fromIntegral32be (len twBuilder + len twTSBuilder)+    , fromIntegral32be twCount     , twBuilder     , twTSBuilder     ]     where         len = L.length . toLazyByteString -mkTrackState :: TrackSpec -> TimeStamp -> Int -> TrackWork-mkTrackState spec entry w = TrackWork+mkTrackWork :: TrackSpec -> TimeStamp -> Int -> TrackWork+mkTrackWork spec entry w = TrackWork         { twSpec = spec         , twBuilder = mempty         , twTSBuilder = mempty         , twCount = 0         , twWatermark = w-        , twLevels = IM.empty         , twEntryTime = entry         , twExitTime = entry-        , twData = initZTSData (specType spec)+        , twWriter = Nothing         }++----------------------------------------------------------------------+-- Working state++clearWork :: ZoomWork -> ZoomWork+clearWork (ZoomWork l _) = ZoomWork l Nothing++updateWork :: (Typeable b, ZoomWritable b)+           => Int -> TimeStamp -> b+           -> Maybe ZoomWork+           -> Maybe ZoomWork++updateWork count t d Nothing = Just (ZoomWork IM.empty (Just cw))     where-        initZTSData ZDouble = ZTSDouble-            { ztsTime = entry-            , ztsdEntry = 0.0-            , ztsdExit = 0.0-            , ztsdMin = floatMax-            , ztsdMax = negate floatMax-            , ztsdSum = 0.0-            , ztsSumSq = 0.0-            }-        initZTSData ZInt = ZTSInt-            { ztsTime = entry-            , ztsiEntry = 0-            , ztsiExit = 0-            , ztsiMin = maxBound-            , ztsiMax = minBound-            , ztsiSum = 0-            , ztsSumSq = 0-            }+        cw = updateSummaryData count t d (initSummaryWork t) +updateWork count t d (Just (ZoomWork l Nothing)) =+    case cw'm of+        Just _  -> Just (ZoomWork l cw'm)+        Nothing -> Nothing+    where+        cw'm = case (fromDynamic . toDyn $ d) of+            Just d' -> Just (updateSummaryData count t d' (initSummaryWork t))+            Nothing -> Nothing++updateWork count t d (Just (ZoomWork l (Just cw))) =+    case cw'm of+        Just _  -> Just (ZoomWork l cw'm)+        Nothing -> Nothing+    where+        cw'm = case (fromDynamic . toDyn $ d) of+            Just d' -> Just (updateSummaryData count t d' cw)+            Nothing -> Nothing+ ---------------------------------------------------------------------- -- Summary  flushSummary :: TrackNo -> TrackWork -> ZoomW ()-flushSummary trackNo trackState@TrackWork{..} =-    pushSummary trackState (mkSummary trackNo trackState)+flushSummary trackNo TrackWork{..} = case twWriter of+    Just writer -> do+        let (writer', bs) = flushWork trackNo twEntryTime twExitTime writer+        modify $ \z -> z { whDeferred = IM.unionWith mappend (whDeferred z) bs }+        modifyTrack trackNo (\ztt -> ztt { twWriter = Just writer' } )+    _           -> return () -mkSummary :: TrackNo -> TrackWork -> Summary-mkSummary trackNo TrackWork{..} = mk (specType twSpec)+flushWork :: TrackNo -> TimeStamp -> TimeStamp+          -> ZoomWork -> (ZoomWork, IntMap Builder)+flushWork _       _         _        op@(ZoomWork _ Nothing) = (op, IM.empty)+flushWork trackNo entryTime exitTime (ZoomWork l (Just cw))  =+    (ZoomWork l' (Just cw), bs)     where-        mk ZDouble = SummaryDouble-            { summaryTrack = trackNo-            , summaryLevel = 1-            , summaryEntryTime = twEntryTime-            , summaryExitTime = twExitTime-            , summaryDoubleEntry = ztsdEntry twData-            , summaryDoubleExit = ztsdExit twData-            , summaryDoubleMin = ztsdMin twData-            , summaryDoubleMax = ztsdMax twData-            , summaryAvg = ztsdSum twData / dur-            , summaryRMS = sqrt $ ztsSumSq  twData / dur-            }-        mk ZInt = SummaryInt+        (bs, l') = pushSummary s IM.empty l+        s = Summary             { summaryTrack = trackNo             , summaryLevel = 1-            , summaryEntryTime = twEntryTime-            , summaryExitTime = twExitTime-            , summaryIntEntry = ztsiEntry twData-            , summaryIntExit = ztsiExit twData-            , summaryIntMin = ztsiMin twData-            , summaryIntMax = ztsiMax twData-            , summaryAvg = fromIntegral (ztsiSum twData) / dur-            , summaryRMS = sqrt $ ztsSumSq  twData / dur+            , summaryEntryTime = entryTime+            , summaryExitTime = exitTime+            , summaryData = toSummaryData dur cw             }-        dur = fromIntegral $ (unTS twExitTime) - (unTS twEntryTime)+        dur = fromIntegral $ (unTS exitTime) - (unTS entryTime) -pushSummary :: TrackWork -> Summary -> ZoomW ()-pushSummary zt s = do-    deferSummary s-    case IM.lookup (summaryLevel s) (twLevels zt) of-        Just (Just prev) -> do-            let new = (prev `appendSummary` s) { summaryLevel = summaryLevel s + 1 }-            insert Nothing-            pushSummary zt new-        _                -> do-            insert (Just s)+pushSummary :: (ZoomWritable a)+            => Summary a+            -> IntMap Builder -> IntMap (Summary a -> Summary a)+            -> (IntMap Builder, IntMap (Summary a -> Summary a))+pushSummary s bs l = do+    case IM.lookup (summaryLevel s) l of+        Just g  -> pushSummary (g s) bs' cleared+        Nothing -> (bs', inserted)     where-        insert :: Maybe Summary -> ZoomW ()-        insert x = modifyTrack (summaryTrack s) (\ztt ->-            ztt { twLevels = IM.insert (summaryLevel s) x (twLevels ztt) } )+        bs' = IM.insert (summaryLevel s) (fromSummary s) bs+        f next = (s `appendSummary` next) { summaryLevel = summaryLevel s + 1 }+        inserted = IM.insert (summaryLevel s) f l+        cleared = IM.delete (summaryLevel s) l -deferSummary :: Summary -> ZoomW ()-deferSummary s = do-    modify $ \z -> z-        { whDeferred = IM.alter f (summaryLevel s) (whDeferred z) }+-- | Append two Summaries, merging statistical summary data.+-- XXX: summaries are only compatible if tracks and levels are equal+appendSummary :: (ZoomWritable a) => Summary a -> Summary a -> Summary a+appendSummary s1 s2 = Summary+    { summaryTrack = summaryTrack s1+    , summaryLevel = summaryLevel s1+    , summaryEntryTime = summaryEntryTime s1+    , summaryExitTime = summaryExitTime s2+    , summaryData = appendSummaryData (dur s1) (summaryData s1)+                                      (dur s2) (summaryData s2)+    }     where-        f Nothing        = Just [s]-        f (Just pending) = Just (pending ++ [s])--writeSummary :: Summary -> ZoomW ()-writeSummary s = do-    h <- gets whHandle-    liftIO . L.hPut h . toLazyByteString . fromSummary $ s+        dur = fromIntegral . summaryDuration  ------------------------------------------------------------ 

@@ -15,9 +15,8 @@ import System.Console.GetOpt import UI.Command -import Data.ZoomCache.Common-import Data.ZoomCache.Read-import Data.ZoomCache.Write+import Data.ZoomCache+import Data.ZoomCache.Dump  ------------------------------------------------------------ 

@@ -7,14 +7,47 @@ -- 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.2.1.1+Version:             0.3.0.0  -- A short (one-line) description of the package. Synopsis:            A streamable, seekable, zoomable cache file format  -- A longer description of the package.-Description:         This library provides a monadic writing and iteratee reading-                     interface for zoom-cache files.+Description:+    zoom-cache is a fairly simple data file format for storing and summarizing+    streams of time-series data. The purpose of this format is to make it easy+    to quickly generate plots; /zooming/ refers to being able to render a+    window of data, and being able to quickly change the bounds of the window:+    to move around and to zoom in and out.+    .+    This library provides a monadic writing and an iteratee reading interface+    for zoom-cache files.+    .+    What's neat about this format and library? Glad you asked!+    .+        * While writing a file, summary blocks (such as minimum, maximum,+    mean and RMS values) are written out every n samples. The summary blocks+    are hierarchical, such that after two have been written, a new one+    containing a merged summary of those is written. After two of those Level+    1 summary blocks have been written, a new Level 2 summary block combining+    those is written, and so on.+    .+        * You can write your own zoom-cache codecs for custom data types, or+    to implement custom summary functions. In order to do so you provide a+    'Summary' data type, functions for encoding and decoding raw data values+    and summaries, and a function for merging 'Summary' blocks. For details,+    see "Data.ZoomCache.Codec".+    .+        * Writing of raw data blocks is optional, under control of the+    application. If you already have the raw data stored in an easily+    accessible format, your zoom-cache files may just contain the summary+    data. On the other hand, if your input data is the result of expensive+    calculations you may want to store it along with the summary data so that+    plots of any level of detail can be rendered from a single file.+    .+    When developing applications that read or write zoom-cache files, it should+    be sufficient to import only the module "Data.ZoomCache".+    .  -- The license under which the package is released. License:             BSD3@@ -49,14 +82,21 @@  Library   -- Modules exported by the library.-  Exposed-modules:     Data.ZoomCache.Binary+  Exposed-modules:     Blaze.ByteString.Builder.ZoomCache+                       Data.ZoomCache+                       Data.ZoomCache.Codec                        Data.ZoomCache.Common-                       Data.ZoomCache.Packet+                       Data.ZoomCache.Double+                       Data.ZoomCache.Dump+                       Data.ZoomCache.Format+                       Data.ZoomCache.Int                        Data.ZoomCache.Pretty-                       Data.ZoomCache.Read-                       Data.ZoomCache.Summary+                       Data.ZoomCache.Types                        Data.ZoomCache.Write                        Data.Iteratee.ZoomCache+                       Data.Iteratee.ZoomCache.Utils++  Other-modules:       Blaze.ByteString.Builder.ZoomCache.Internal                        Numeric.FloatMinMax      -- Packages needed in order to build this package.