zoom-cache 0.8.1.0 → 0.9.0.0

raw patch · 29 files changed

+1257/−379 lines, 29 filesdep +type-levelPVP ok

version bump matches the API change (PVP)

Dependencies added: type-level

API changes (from Hackage documentation)

Files

• Blaze/ByteString/Builder/ZoomCache.hs +4/−4
• Blaze/ByteString/Builder/ZoomCache/Internal.hs +12/−12
• Data/Iteratee/ZoomCache.hs +163/−88
• Data/Iteratee/ZoomCache/Utils.hs +58/−1
• Data/ZoomCache.hs +15/−2
• Data/ZoomCache/Bool.hs +20/−17
• Data/ZoomCache/Codec.hs +8/−1
• Data/ZoomCache/Common.hs +35/−12
• Data/ZoomCache/Dump.hs +7/−7
• Data/ZoomCache/Format.hs +10/−8
• Data/ZoomCache/Multichannel.hs +27/−0
• Data/ZoomCache/Multichannel/Common.hs +27/−0
• Data/ZoomCache/Multichannel/Internal.hs +78/−0
• Data/ZoomCache/Multichannel/List.hs +167/−0
• Data/ZoomCache/Multichannel/NList.hs +153/−0
• Data/ZoomCache/NList.hs +46/−0
• Data/ZoomCache/Numeric.hs +36/−3
• Data/ZoomCache/Numeric/IEEE754.hs +19/−13
• Data/ZoomCache/Numeric/Int.hs +64/−46
• Data/ZoomCache/Numeric/Internal.hs +8/−8
• Data/ZoomCache/Numeric/Types.hs +2/−2
• Data/ZoomCache/Numeric/Word.hs +50/−35
• Data/ZoomCache/Pretty.hs +18/−18
• Data/ZoomCache/Types.hs +99/−19
• Data/ZoomCache/Unit.hs +10/−7
• Data/ZoomCache/Write.hs +84/−70
• tests/Properties.hs +6/−0
• tools/zoom-cache.hs +19/−5
• zoom-cache.cabal +12/−1

@@ -16,7 +16,7 @@  module Blaze.ByteString.Builder.ZoomCache (     -- * Creating builders for ZoomCache types-      fromTimeStamp+      fromSampleOffset      -- * Creating builders from numeric types used by ZoomCache     , fromFloat@@ -39,9 +39,9 @@ -- Creating builders for ZoomCache types.  -- | Serialize a 'TimeStamp' in 64bit big endian format.-fromTimeStamp :: TimeStamp -> Builder-fromTimeStamp = fromInt64be . fromIntegral . unTS-{-# INLINE fromTimeStamp #-}+fromSampleOffset :: SampleOffset -> Builder+fromSampleOffset = fromInt64be . fromIntegral . unSO+{-# INLINE fromSampleOffset #-}  ---------------------------------------------------------------------- -- Creating builders from numeric types used by ZoomCache.

@@ -18,7 +18,7 @@     -- * Builders       fromFlags     , fromGlobal-    , fromSummary+    , fromSummarySO     , fromTrackNo     , fromCodec ) where@@ -37,14 +37,14 @@ ---------------------------------------------------------------------- -- Creating builders for ZoomCache types. -fromFlags :: Bool -> Bool -> DataRateType -> Builder+fromFlags :: Bool -> Bool -> SampleRateType -> Builder fromFlags delta zlib drType = fromInt16be (zl .|. dl .|. dr)     where         zl | zlib                 = 4            | otherwise            = 0         dl | delta                = 2            | otherwise            = 0-        dr | drType == VariableDR = 1+        dr | drType == VariableSR = 1            | otherwise            = 0  fromGlobal :: Global -> Builder@@ -59,19 +59,19 @@     , fromByteString $ C.pack (replicate 20 '\0') -- UTCTime     ] -fromSummary :: ZoomWritable a => Summary a -> Builder-fromSummary s@Summary{..} = mconcat [ fromSummaryHeader s, l, d]+fromSummarySO :: ZoomWritable a => SummarySO a -> Builder+fromSummarySO s@SummarySO{..} = mconcat [ fromSummarySOHeader s, l, d]     where-        d = fromSummaryData summaryData+        d = fromSummaryData summarySOData         l = fromIntegral32be . B.length . toByteString $ d -fromSummaryHeader :: Summary a -> Builder-fromSummaryHeader s = mconcat+fromSummarySOHeader :: SummarySO a -> Builder+fromSummarySOHeader s = mconcat     [ fromByteString summaryHeader-    , fromIntegral32be . summaryTrack $ s-    , fromIntegral32be . summaryLevel $ s-    , fromTimeStamp . summaryEntryTime $ s-    , fromTimeStamp . summaryExitTime $ s+    , fromIntegral32be . summarySOTrack $ s+    , fromIntegral32be . summarySOLevel $ s+    , fromSampleOffset . summarySOEntry $ s+    , fromSampleOffset . summarySOExit $ s     ]  fromTrackNo :: TrackNo -> Builder

@@ -3,6 +3,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-} {-# OPTIONS -Wall #-} ---------------------------------------------------------------------- {- |@@ -47,20 +48,29 @@    , iterHeaders   , enumStream+  , enumStreamIncomplete   , enumStreamTrackNo +  -- * Seeking+  , seekTimeStamp+   -- * Stream enumeratees   , enumPackets   , enumSummaryLevel   , enumSummaries-  , enumCTP-  , enumCTS   , filterTracksByName   , filterTracks++  -- * Low-level access to SampleOffsets+  , enumPacketSOs+  , enumSummarySOLevel+  , enumSummarySOs+  , enumCTPSO+  , enumCTSO ) where  import Control.Applicative-import Control.Monad (msum, replicateM)+import Control.Monad (replicateM, liftM) import Control.Monad.Trans (MonadIO) import Data.Bits import Data.ByteString (ByteString)@@ -77,6 +87,7 @@ import Data.Iteratee.ZoomCache.Utils import Data.ZoomCache.Common import Data.ZoomCache.Format+import Data.ZoomCache.Multichannel.Internal (supportMultichannel) import Data.ZoomCache.Numeric.Delta import Data.ZoomCache.Types @@ -86,14 +97,18 @@     StreamPacket         { strmFile    :: CacheFile         , strmTrack   :: TrackNo-        , strmPacket  :: Packet+        , strmPacket  :: PacketSO         }     | StreamSummary         { strmFile    :: CacheFile         , strmTrack   :: TrackNo-        , strmSummary :: ZoomSummary+        , strmSummary :: ZoomSummarySO         } +instance Timestampable Stream where+    timestamp (StreamPacket c t p) = timestamp (packetFromCTPSO (c,t,p))+    timestamp (StreamSummary c t s) = timestamp (summaryFromCTSO (c,t,s))+ ----------------------------------------------------------------------  -- | Read the summary of an entire track.@@ -102,18 +117,27 @@                   -> TrackNo                   -> Iteratee ByteString m (TrackSpec, ZoomSummary) wholeTrackSummary identifiers trackNo = I.joinI $ enumCacheFile identifiers .-    I.joinI . filterTracks [trackNo] .  I.joinI . enumCTS $ f <$> I.last+    I.joinI . filterTracks [trackNo] .  I.joinI . enumCTSO $ f <$> I.last     where-        f :: (CacheFile, TrackNo, ZoomSummary) -> (TrackSpec, ZoomSummary)-        f (cf, _, zs) = (fromJust $ IM.lookup trackNo (cfSpecs cf), zs)+        f :: (CacheFile, TrackNo, ZoomSummarySO) -> (TrackSpec, ZoomSummary)+        f ctso@(cf, _, _) = (fromJust $ IM.lookup trackNo (cfSpecs cf),+                             summaryFromCTSO ctso)  ----------------------------------------------------------------------  -- | Filter just the raw data enumPackets :: (Functor m, MonadIO m)             => I.Enumeratee [Stream] [Packet] m a-enumPackets = I.joinI . enumCTP . I.mapChunks (map (\(_,_,p) -> p))+enumPackets = I.joinI . enumCTPSO . I.mapChunks (map packetFromCTPSO) +-- | Convert a CTSO triple into a ZoomSummary+packetFromCTPSO :: (CacheFile, TrackNo, PacketSO) -> Packet+packetFromCTPSO (cf, trackNo, pso) = packetFromPacketSO r pso+    where+        r = specRate . fromJust . IM.lookup trackNo . cfSpecs $ cf++----------------------------------------------------------------------+ -- | Filter summaries at a particular summary level enumSummaryLevel :: (Functor m, MonadIO m)                  => Int@@ -125,25 +149,52 @@ -- | Filter summaries at all levels enumSummaries :: (Functor m, MonadIO m)               => I.Enumeratee [Stream] [ZoomSummary] m a-enumSummaries = I.joinI . enumCTS .  I.mapChunks (map (\(_,_,s) -> s))+enumSummaries = I.joinI . enumCTSO .  I.mapChunks (map summaryFromCTSO) +-- | Convert a CTSO triple into a ZoomSummary+summaryFromCTSO :: (CacheFile, TrackNo, ZoomSummarySO) -> ZoomSummary+summaryFromCTSO (cf, trackNo, (ZoomSummarySO zso)) =+    ZoomSummary (summaryFromSummarySO r zso)+    where+        r = specRate . fromJust . IM.lookup trackNo . cfSpecs $ cf++----------------------------------------------------------------------++-- | Filter just the raw data+enumPacketSOs :: (Functor m, MonadIO m)+              => I.Enumeratee [Stream] [PacketSO] m a+enumPacketSOs = I.joinI . enumCTPSO . I.mapChunks (map (\(_,_,p) -> p))++-- | Filter summaries at a particular summary level+enumSummarySOLevel :: (Functor m, MonadIO m)+                   => Int+                   -> I.Enumeratee [Stream] [ZoomSummarySO] m a+enumSummarySOLevel level =+    I.joinI . enumSummarySOs .+    I.filter (\(ZoomSummarySO s) -> summarySOLevel s == level)++-- | Filter summaries at all levels+enumSummarySOs :: (Functor m, MonadIO m)+               => I.Enumeratee [Stream] [ZoomSummarySO] m a+enumSummarySOs = I.joinI . enumCTSO .  I.mapChunks (map (\(_,_,s) -> s))+ -- | Filter raw data-enumCTP :: (Functor m, MonadIO m)-        => I.Enumeratee [Stream] [(CacheFile, TrackNo, Packet)] m a-enumCTP = I.mapChunks (catMaybes . map toCTP)+enumCTPSO :: (Functor m, MonadIO m)+          => I.Enumeratee [Stream] [(CacheFile, TrackNo, PacketSO)] m a+enumCTPSO = I.mapChunks (catMaybes . map toCTPSO)     where-        toCTP :: Stream -> Maybe (CacheFile, TrackNo, Packet)-        toCTP StreamPacket{..} = Just (strmFile, strmTrack, strmPacket)-        toCTP _                = Nothing+        toCTPSO :: Stream -> Maybe (CacheFile, TrackNo, PacketSO)+        toCTPSO StreamPacket{..} = Just (strmFile, strmTrack, strmPacket)+        toCTPSO _                = Nothing  -- | Filter summaries-enumCTS :: (Functor m, MonadIO m)-        => I.Enumeratee [Stream] [(CacheFile, TrackNo, ZoomSummary)] m a-enumCTS = I.mapChunks (catMaybes . map toCTS)+enumCTSO :: (Functor m, MonadIO m)+         => I.Enumeratee [Stream] [(CacheFile, TrackNo, ZoomSummarySO)] m a+enumCTSO = I.mapChunks (catMaybes . map toCTSO)     where-        toCTS :: Stream -> Maybe (CacheFile, TrackNo, ZoomSummary)-        toCTS StreamSummary{..} = Just (strmFile, strmTrack, strmSummary)-        toCTS _                 = Nothing+        toCTSO :: Stream -> Maybe (CacheFile, TrackNo, ZoomSummarySO)+        toCTSO StreamSummary{..} = Just (strmFile, strmTrack, strmSummary)+        toCTSO _                 = Nothing  -- | Filter to a given list of track names filterTracksByName :: (Functor m, MonadIO m)@@ -190,7 +241,7 @@                   => CacheFile                   -> TrackNo                   -> I.Enumeratee ByteString [Stream] m a-enumStreamTrackNo cf0 trackNo = I.unfoldConvStream go cf0+enumStreamTrackNo cf0 trackNo = I.unfoldConvStreamCheck I.eneeCheckIfDoneIgnore go cf0     where         go :: (Functor m, MonadIO m)            => CacheFile@@ -208,27 +259,58 @@                     return (cf, res)                 _ -> return (cf, []) --- | An enumeratee of zoom-cache data, after global and track headers+-- | An iteratee of zoom-cache which produces a singleton list of zoom-cache+-- stream, if it can.+iterStream :: (Functor m, MonadIO m) =>+              CacheFile -> Iteratee ByteString m [Stream]+iterStream cf = do+    header <- I.joinI $ I.takeUpTo 8 I.stream2list+    case parseHeader (B.pack header) of+        Just PacketHeader -> do+             (trackNo, packet) <- readPacket (cfSpecs cf)+             return [StreamPacket cf trackNo (fromJust packet)]+        Just SummaryHeader -> do+             (trackNo, summary) <- readSummaryBlock (cfSpecs cf)+             return [StreamSummary cf trackNo (fromJust summary)]+        _ -> return []++-- | An iteratee of zoom-cache data, after global and track headers -- have been read, or if the 'CacheFile' has been acquired elsewhere.++-- Unfortunately the iteratee library does not have a convStreamCheck function+-- (yet), so we end up doing a (trivial) fold when we really just want to do a+-- map. enumStream :: (Functor m, MonadIO m)             => CacheFile             -> I.Enumeratee ByteString [Stream] m a-enumStream = I.unfoldConvStream go-    where-        go :: (Functor m, MonadIO m)-           => CacheFile-           -> Iteratee ByteString m (CacheFile, [Stream])-        go cf = do-            header <- I.joinI $ I.takeUpTo 8 I.stream2list-            case parseHeader (B.pack header) of-                Just PacketHeader -> do-                    (trackNo, packet) <- readPacket (cfSpecs cf)-                    return (cf, [StreamPacket cf trackNo (fromJust packet)])-                Just SummaryHeader -> do-                    (trackNo, summary) <- readSummaryBlock (cfSpecs cf)-                    return (cf, [StreamSummary cf trackNo (fromJust summary)])-                _ -> return (cf, [])+enumStream = I.unfoldConvStreamCheck I.eneeCheckIfDoneIgnore $ \cf ->+             liftM (cf, ) (iterStream cf) +-- | A version of convStream which will not fail in case EOF is reached at an+-- unexpected point.+convStreamIncomplete :: (Monad m, I.Nullable s) =>+                        I.Iteratee s m s'+                     -> I.Enumeratee s s' m a+convStreamIncomplete fi = I.eneeCheckIfDonePass check+  where+    check k (Just e) = do+      I.throwRecoverableErr e (const I.identity)+      check k Nothing+    check k Nothing = do+      isEOF <- I.isStreamFinished+      case isEOF of+        Nothing -> do+          str <- either (I.EOF . Just) I.Chunk `liftM` I.checkErr fi+          I.eneeCheckIfDonePass check $ k str+        e@(Just _) -> I.eneeCheckIfDonePass check . k $ I.EOF e++-- | A version of enumStream which won't fail with an EofException if the last+-- bit is incomplete (perhaps still being written to).+enumStreamIncomplete :: (Functor m, MonadIO m) =>+                        CacheFile+                     -> I.Enumeratee ByteString [Stream] m a+enumStreamIncomplete = convStreamIncomplete . iterStream+ ------------------------------------------------------------  data HeaderType = GlobalHeader | TrackHeader | PacketHeader | SummaryHeader@@ -288,13 +370,16 @@                 -> Iteratee ByteString m (TrackNo, TrackSpec) readTrackHeader identifiers = do     trackNo <- readInt32be-    trackType <- readCodec identifiers     (drType, delta, zlib) <- readFlags     rate <- readRational64be-    byteLength <- readInt32be-    name <- B.pack <$> (I.joinI $ I.takeUpTo byteLength I.stream2list)+    identLength <- readInt32be+    trackType <- maybe (error "Unknown track type") return =<< readCodecMultichannel identLength+    nameLength <- readInt32be+    name <- B.pack <$> (I.joinI $ I.takeUpTo nameLength I.stream2list)      return (trackNo, TrackSpec trackType delta zlib drType rate name)+    where+        readCodecMultichannel = readCodec (supportMultichannel identifiers)  ------------------------------------------------------------ -- Packet, Summary reading@@ -304,12 +389,12 @@  readPacketPred :: (Functor m, MonadIO m)                => IntMap TrackSpec-               -> ((TrackNo, TimeStamp, TimeStamp) -> Bool)-               -> Iteratee ByteString m (TrackNo, Maybe Packet)+               -> ((TrackNo, SampleOffset, SampleOffset) -> Bool)+               -> Iteratee ByteString m (TrackNo, Maybe PacketSO) readPacketPred specs p = do     trackNo <- readInt32be-    entryTime <- TS <$> readInt64be-    exitTime <- TS <$> readInt64be+    entryTime <- SO <$> readInt64be+    exitTime <- SO <$> readInt64be     count <- readInt32be     byteLength <- readInt32be     packet <- if (p (trackNo, entryTime, exitTime))@@ -323,35 +408,35 @@ readPacketTrackNo :: (Functor m, MonadIO m)                   => IntMap TrackSpec                   -> TrackNo-                  -> Iteratee ByteString m (TrackNo, Maybe Packet)+                  -> Iteratee ByteString m (TrackNo, Maybe PacketSO) readPacketTrackNo specs wantTrackNo =     readPacketPred specs (\(trackNo, _, _) -> trackNo == wantTrackNo)  readPacket :: (Functor m, MonadIO m)            => IntMap TrackSpec-           -> Iteratee ByteString m (TrackNo, Maybe Packet)+           -> Iteratee ByteString m (TrackNo, Maybe PacketSO) readPacket specs = readPacketPred specs (const True)  readPacketData :: (Functor m, MonadIO m)                => IntMap TrackSpec                -> TrackNo-               -> TimeStamp -> TimeStamp+               -> SampleOffset -> SampleOffset                -> Int                -> Int-               -> Iteratee ByteString m (Maybe Packet)+               -> Iteratee ByteString m (Maybe PacketSO) readPacketData specs trackNo entryTime exitTime count byteLength =     case IM.lookup trackNo specs of         Just TrackSpec{..} -> do             let readDTS :: (Functor m, Monad m)-                        => Iteratee ByteString m (ZoomRaw, [TimeStamp])-                readDTS = readDataTimeStamps specType specDeltaEncode specDRType+                        => Iteratee ByteString m (ZoomRaw, [SampleOffset])+                readDTS = readDataSampleOffsets specType specDeltaEncode specSRType             (d, ts) <- if specZlibCompress                 then do                     z <- I.joinI $ enumInflateZlib I.stream2stream                     return $ runner1 $ I.enumPure1Chunk z readDTS                 else readDTS             return . Just $-                (Packet trackNo entryTime exitTime count d ts)+                (PacketSO trackNo entryTime exitTime count d ts)         Nothing -> do             I.drop byteLength             return Nothing@@ -371,32 +456,32 @@                   => a -> Iteratee ByteString m a         readRawAs = const readRaw -        readDataTimeStamps :: (Functor m, Monad m)-                           => Codec -> Bool -> DataRateType-                           -> Iteratee ByteString m (ZoomRaw, [TimeStamp])-        readDataTimeStamps codec delta drType = do+        readDataSampleOffsets :: (Functor m, Monad m)+                           => Codec -> Bool -> SampleRateType+                           -> Iteratee ByteString m (ZoomRaw, [SampleOffset])+        readDataSampleOffsets codec delta drType = do             d <- readRawCodec codec delta-            ts <- readTimeStamps drType+            ts <- readSampleOffsets drType             return (d, ts) -        readTimeStamps :: (Functor m, Monad m)-                       => DataRateType-                       -> Iteratee ByteString m [TimeStamp]-        readTimeStamps drType = map TS <$> case drType of-            ConstantDR -> do-                return $ take count [unTS entryTime ..]-            VariableDR -> do+        readSampleOffsets :: (Functor m, Monad m)+                       => SampleRateType+                       -> Iteratee ByteString m [SampleOffset]+        readSampleOffsets drType = map SO <$> case drType of+            ConstantSR -> do+                return $ take count [unSO entryTime ..]+            VariableSR -> do                 deltaDecode <$> replicateM count readInt64be  readSummaryBlockPred :: (Functor m, Monad m)                      => IntMap TrackSpec-                     -> ((TrackNo, Int, TimeStamp, TimeStamp) -> Bool)-                     -> Iteratee ByteString m (TrackNo, Maybe ZoomSummary)+                     -> ((TrackNo, Int, SampleOffset, SampleOffset) -> Bool)+                     -> Iteratee ByteString m (TrackNo, Maybe ZoomSummarySO) readSummaryBlockPred specs p = do     trackNo <- readInt32be     lvl <- readInt32be-    entryTime <- TS <$> readInt64be-    exitTime <- TS <$> readInt64be+    entryTime <- SO <$> readInt64be+    exitTime <- SO <$> readInt64be     byteLength <- readInt32be     summary <- if (p (trackNo, lvl, entryTime, exitTime))         then do@@ -409,22 +494,22 @@ readSummaryBlockTrackNo :: (Functor m, Monad m)                         => IntMap TrackSpec                         -> TrackNo-                        -> Iteratee ByteString m (TrackNo, Maybe ZoomSummary)+                        -> Iteratee ByteString m (TrackNo, Maybe ZoomSummarySO) readSummaryBlockTrackNo specs wantTrackNo =     readSummaryBlockPred specs (\(trackNo, _, _, _) -> trackNo == wantTrackNo)  readSummaryBlock :: (Functor m, Monad m)                  => IntMap TrackSpec-                 -> Iteratee ByteString m (TrackNo, Maybe ZoomSummary)+                 -> Iteratee ByteString m (TrackNo, Maybe ZoomSummarySO) readSummaryBlock specs = readSummaryBlockPred specs (const True)  readSummaryBlockData :: (Functor m, Monad m)                      => IntMap TrackSpec                      -> TrackNo                      -> Int-                     -> TimeStamp -> TimeStamp+                     -> SampleOffset -> SampleOffset                      -> Int-                     -> Iteratee ByteString m (Maybe ZoomSummary)+                     -> Iteratee ByteString m (Maybe ZoomSummarySO) readSummaryBlockData specs trackNo lvl entryTime exitTime byteLength =     case IM.lookup trackNo specs of         Just TrackSpec{..} -> do@@ -437,9 +522,9 @@     where         readSummaryCodec :: (Functor m, Monad m)                          => Codec-                         -> Iteratee ByteString m ZoomSummary+                         -> Iteratee ByteString m ZoomSummarySO         readSummaryCodec (Codec a) = do-            ZoomSummary <$> (Summary trackNo lvl entryTime exitTime <$> readSummaryAs a)+            ZoomSummarySO <$> (SummarySO trackNo lvl entryTime exitTime <$> readSummaryAs a)          readSummaryAs :: (ZoomReadable a, Functor m, Monad m)                       => a -> Iteratee ByteString m (SummaryData a)@@ -453,23 +538,13 @@             => Iteratee ByteString m Version readVersion = Version <$> readInt16be <*> readInt16be -readCodec :: (Functor m, Monad m)-          => [IdentifyCodec]-          -> Iteratee ByteString m Codec-readCodec identifiers = do-    tt <- B.pack <$> (I.joinI $ I.takeUpTo 8 I.stream2list)-    maybe (error "Unknown track type") return (parseCodec identifiers tt)--parseCodec :: [IdentifyCodec] -> IdentifyCodec-parseCodec identifiers h = msum . map ($ h) $ identifiers- readFlags :: (Functor m, Monad m)-          => Iteratee ByteString m (DataRateType, Bool, Bool)+          => Iteratee ByteString m (SampleRateType, Bool, Bool) readFlags = do     (n :: Int16) <- readInt16be     let drType = case n .&. 1 of-            0 -> ConstantDR-            _ -> VariableDR+            0 -> ConstantSR+            _ -> VariableSR         delta = case n .&. 2 of             0 -> False             _ -> True

@@ -15,8 +15,11 @@ ----------------------------------------------------------------------  module Data.Iteratee.ZoomCache.Utils (+    -- * Seeking+      seekTimeStamp+     -- * Raw data reading iteratees-      readInt8+    , readInt8     , readInt16be     , readInt32be     , readInt64be@@ -28,11 +31,16 @@     , readFloat32be     , readDouble64be     , readRational64be++    -- * Codec reading+    , readCodec ) where  import Control.Applicative ((<$>))+import Control.Monad (msum) import Data.Bits import qualified Data.ByteString as B+import Data.ByteString (ByteString) import Data.Int import Data.Iteratee (Iteratee) import qualified Data.Iteratee as I@@ -41,6 +49,43 @@ import Data.Word import Unsafe.Coerce (unsafeCoerce) +import Data.ZoomCache.Common+import Data.ZoomCache.Types++----------------------------------------------------------------------++seekTimeStamp :: (LL.ListLike s el, I.Nullable s, I.NullPoint s, Timestampable el, Monad m)+              => Maybe TimeStamp -> Iteratee s m ()+seekTimeStamp ts = do+    I.seek 0+    dropWhileB (before ts)++-- |Skip all elements while the predicate is true, but also return the last false element+--+-- The analogue of @List.dropWhile@+dropWhileB :: (Monad m, LL.ListLike s el) => (el -> Bool) -> I.Iteratee s m ()+dropWhileB p = I.liftI step+  where+    step (I.Chunk str)+      | LL.null left = I.liftI step+      | otherwise    = I.idone () (I.Chunk left)+      where+        left = llDropWhileB p str+    step stream      = I.idone () stream+{-# INLINE dropWhileB #-}++{- | Drops all elements form the start of the list that satisfy the+       function. -}+llDropWhileB :: LL.ListLike full item => (item -> Bool) -> full -> full+llDropWhileB = dw LL.empty+    where+        dw prev func l+            | LL.null l = LL.empty+            | func (LL.head l) = dw (LL.take 1 l) func (LL.tail l)+            | otherwise = LL.append prev l++----------------------------------------------------------------------+ -- | Read 1 byte as a signed Integral readInt8 :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m, Integral a)          => Iteratee s m a@@ -178,4 +223,16 @@         then return 0         else return (num % den) +----------------------------------------------------------------------++readCodec :: (Functor m, Monad m)+          => [IdentifyCodec]+          -> Int+          -> Iteratee ByteString m (Maybe Codec)+readCodec identifiers n = do+    tt <- B.pack <$> (I.joinI $ I.takeUpTo n I.stream2list)+    return (parseCodec identifiers tt)++parseCodec :: [IdentifyCodec] -> IdentifyCodec+parseCodec identifiers h = msum . map ($ h) $ identifiers 

@@ -13,12 +13,20 @@ ----------------------------------------------------------------------  module Data.ZoomCache (+    -- * TimeStamps+      TimeStamp (..)+    , TimeStampDiff(..)+    , timeStampDiff+    , timeStampFromSO+    , Timestampable(..)+    , before+     -- * Types-      TimeStamp(..)+    , SampleOffset(..)     , TrackNo     , Codec(..)     , IdentifyCodec-    , DataRateType(..)+    , SampleRateType(..)      , CacheFile(..) @@ -29,12 +37,17 @@     , Packet(..)     , Summary(..) +    , ZoomSummarySO(..)+    , PacketSO(..)+    , SummarySO(..)+     -- * Track specification     , TrackMap     , TrackSpec(..)      -- * The ZoomWrite class     , ZoomWrite(..)+    , ZoomWritable(..)      -- * The ZoomW monad     , ZoomW

@@ -100,13 +100,16 @@ instance ZoomWrite Bool where     write = writeData -instance ZoomWrite (TimeStamp, Bool) where+instance ZoomWrite (SampleOffset, Bool) where     write = writeDataVBR +instance ZoomWrite (TimeStamp, Bool) where+    write = writeDataTS+ instance ZoomWritable Bool where     data SummaryWork Bool = SummaryWorkBool-        { swBoolTime     :: {-# UNPACK #-}!TimeStamp-        , swBoolTrueTime :: {-# UNPACK #-}!Int64+        { swBoolSO      :: {-# UNPACK #-}!SampleOffset+        , swBoolTrueTotal :: {-# UNPACK #-}!Int64         }      fromRaw           = fromBool@@ -121,34 +124,34 @@ fromBool False = fromInt8 0 fromBool True  = fromInt8 1 -initSummaryBool :: TimeStamp -> SummaryWork Bool+initSummaryBool :: SampleOffset -> SummaryWork Bool initSummaryBool entry = SummaryWorkBool-    { swBoolTime = entry-    , swBoolTrueTime = 0+    { swBoolSO = entry+    , swBoolTrueTotal = 0     } -mkSummaryBool :: TimeStampDiff -> SummaryWork Bool -> SummaryData Bool-mkSummaryBool (TSDiff dur) SummaryWorkBool{..} = SummaryBool-    { summaryBoolExpected = fromIntegral swBoolTrueTime / fromIntegral dur+mkSummaryBool :: SampleOffsetDiff -> SummaryWork Bool -> SummaryData Bool+mkSummaryBool (SODiff dur) SummaryWorkBool{..} = SummaryBool+    { summaryBoolExpected = fromIntegral swBoolTrueTotal / fromIntegral dur     }  fromSummaryBool :: SummaryData Bool -> Builder fromSummaryBool SummaryBool{..} = fromDouble summaryBoolExpected -updateSummaryBool :: TimeStamp  -> Bool -> SummaryWork Bool+updateSummaryBool :: SampleOffset  -> Bool -> SummaryWork Bool                   -> SummaryWork Bool-updateSummaryBool t False sw = sw { swBoolTime = t }+updateSummaryBool t False sw = sw { swBoolSO = t } updateSummaryBool t True SummaryWorkBool{..} = SummaryWorkBool-    { swBoolTime = t-    , swBoolTrueTime = swBoolTrueTime + dur+    { swBoolSO = t+    , swBoolTrueTotal = swBoolTrueTotal + dur     }     where-        !(TSDiff dur) = timeStampDiff t swBoolTime+        !(SODiff dur) = sampleOffsetDiff t swBoolSO -appendSummaryBool :: TimeStampDiff -> SummaryData Bool-                  -> TimeStampDiff -> SummaryData Bool+appendSummaryBool :: SampleOffsetDiff -> SummaryData Bool+                  -> SampleOffsetDiff -> SummaryData Bool                   -> SummaryData Bool-appendSummaryBool (TSDiff dur1) s1 (TSDiff dur2) s2 = SummaryBool+appendSummaryBool (SODiff dur1) s1 (SODiff dur2) s2 = SummaryBool     { summaryBoolExpected = ((summaryBoolExpected s1 * fromIntegral dur1) +                              (summaryBoolExpected s2 * fromIntegral dur2)) /                             fromIntegral durSum

@@ -47,6 +47,8 @@     -- * ZoomWrite instance helpers     , writeData     , writeDataVBR+    , writeDataTS+    , ZoomW      -- * Builders     , fromRational64@@ -57,9 +59,14 @@      -- * ZoomCache Types     , Codec-    , TimeStamp(..)+    , TimeStamp (..)     , TimeStampDiff(..)     , timeStampDiff+    , timeStampFromSO+    , SampleOffset(..)+    , SampleOffsetDiff(..)+    , sampleOffsetDiff+    , TrackNo      -- * Delta encoding     , module Data.ZoomCache.Numeric.Delta

@@ -15,12 +15,18 @@  module Data.ZoomCache.Common (     -- * TimeStamps-      TimeStamp(..)+      TimeStamp (..)     , TimeStampDiff(..)     , timeStampDiff+    , timeStampFromSO +    -- * SampleOffsets+    , SampleOffset(..)+    , SampleOffsetDiff(..)+    , sampleOffsetDiff+     -- * Types-    , DataRateType(..)+    , SampleRateType(..)     , TrackNo      -- * Global header@@ -31,20 +37,21 @@ ) where  import Data.Int+import Data.Ratio  ------------------------------------------------------------  type TrackNo = Int -data TimeStamp = TS { unTS :: {-# UNPACK #-}!Int64 }+data SampleOffset = SO { unSO :: {-# UNPACK #-}!Int64 }     deriving (Eq, Ord, Show) -data TimeStampDiff = TSDiff { unTSDiff :: {-# UNPACK #-}!Int64 }+data SampleOffsetDiff = SODiff { unSODiff :: {-# UNPACK #-}!Int64 }     deriving (Eq, Ord, Show) --- | @timeStampDiff (TS t1) (TS t2) = TSDiff (t1 - t2)@-timeStampDiff :: TimeStamp -> TimeStamp -> TimeStampDiff-timeStampDiff (TS t1) (TS t2) = TSDiff (t1 - t2)+-- | @sampleOffsetDiff (SO t1) (SO t2) = SODiff (t1 - t2)@+sampleOffsetDiff :: SampleOffset -> SampleOffset -> SampleOffsetDiff+sampleOffsetDiff (SO t1) (SO t2) = SODiff (t1 - t2)  data Version = Version !Int !Int     deriving (Eq, Show)@@ -58,10 +65,26 @@     }     deriving (Show) --- | Constant or Variable datarate.--- For constant datarate, timestamps are implied as incrementing by 1/datarate--- For variable datarate, explicit timestamps are attached to each datum, encoded--- as a separate block of timestamps in the Raw Data packet.-data DataRateType = ConstantDR | VariableDR+-- | Constant or Variable samplerate.+-- For constant samplerate, timestamps are implied as incrementing by 1/samplerate+-- For variable samplerate, explicit timestamps are attached to each datum, encoded+-- as a separate block of 'SampleOffset' in the Raw Data packet.+data SampleRateType = ConstantSR | VariableSR     deriving (Eq, Show) +newtype TimeStamp = TS Double+    deriving (Eq, Ord, Show)++newtype TimeStampDiff = TSDiff Double++-- | @timeStampDiff (TS t1) (TS t2) = TSDiff (t1 - t2)@+timeStampDiff :: TimeStamp -> TimeStamp -> TimeStampDiff+timeStampDiff (TS t1) (TS t2) = TSDiff (t1 - t2)++timeStampFromSO :: Rational -> SampleOffset -> TimeStamp+timeStampFromSO r (SO so)+    | n == 0    = TS 0.0+    | otherwise = TS (fromIntegral so * d / n)+    where+          n = fromIntegral $ numerator r+          d = fromIntegral $ denominator r

@@ -63,13 +63,13 @@ streamRate s = specRate <$> IM.lookup (strmTrack s) (cfSpecs (strmFile s))  dumpData :: Stream -> IO ()-dumpData s@StreamPacket{..} = mapM_ (\(t,d) -> printf "%s: %s\n" t d) tds+dumpData s@StreamPacket{..} = mapM_ (\(t,d) -> putStrLn $ printf "%s: %s" t d) tds     where         pretty = case streamRate s of-            Just r  -> prettyTimeStamp r-            Nothing -> show . unTS-        tds = zip (map pretty (packetTimeStamps strmPacket)) vals-        vals = f (packetData strmPacket)+            Just r  -> prettySampleOffset r+            Nothing -> show . unSO+        tds = zip (map pretty (packetSOSampleOffsets strmPacket)) vals+        vals = f (packetSOData strmPacket)         f (ZoomRaw a) = map prettyRaw a dumpData _ = return () @@ -78,13 +78,13 @@         Just r  -> putStrLn $ f r strmSummary         Nothing -> return ()     where-        f r (ZoomSummary a) = prettySummary r a+        f r (ZoomSummarySO a) = prettySummarySO r a dumpSummary _ = return ()  dumpSummaryLevel :: Int -> Stream -> IO () dumpSummaryLevel level s@StreamSummary{..}     | level == opLevel strmSummary = dumpSummary s     | otherwise                    = return ()-    where opLevel (ZoomSummary a) = summaryLevel a+    where opLevel (ZoomSummarySO a) = summarySOLevel a dumpSummaryLevel _ _ = return () 

@@ -111,23 +111,25 @@    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+    | Track no. (int32)                                             | 8-11    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Codec identifier                                              | 12-15+   | Reserved                                                |z|d|v| 12-15    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | ...                                                           | 16-19+   | Datarate numerator (int64)                                    | 16-19    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Reserved                                                |z|d|v| 20-23+   | ...                                                           | 20-23    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Datarate numerator (int64)                                    | 24-27+   | Datarate denominator (int64)                                  | 24-27    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+    | ...                                                           | 28-31    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Datarate denominator (int64)                                  | 32-35+   | Length of codec identifier in bytes (int32)                   | 32-35    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | ...                                                           | 36-39+   | Codec identifier                                              | 36-39    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Length of name in bytes (int32)                               | 40-43+   | ...                                                           | 40-    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Name (UTF-8) ...                                              | 44-+   | Length of name in bytes (int32)                               | ...+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++   | Name (UTF-8) ...                                              | ...    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ @ 

@@ -0,0 +1,27 @@+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS -Wall #-}+----------------------------------------------------------------------+-- |+-- Module      : Data.ZoomCache.Multichannel+-- Copyright   : Conrad Parker+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Conrad Parker <conrad@metadecks.org>+-- Stability   : unstable+-- Portability : unknown+--+-- ZoomCache multichannel API+----------------------------------------------------------------------++module Data.ZoomCache.Multichannel (+      trackTypeMultichannel++    , module Data.ZoomCache.Multichannel.Internal++    -- * Multichannel codecs+    , module Data.ZoomCache.Multichannel.List+) where++import Data.ZoomCache.Multichannel.Internal+import Data.ZoomCache.Multichannel.Common+import Data.ZoomCache.Multichannel.List

@@ -0,0 +1,27 @@+{-# OPTIONS -Wall #-}+----------------------------------------------------------------------+-- |+-- Module      : Data.ZoomCache.Multichannel.Common+-- Copyright   : Conrad Parker+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Conrad Parker <conrad@metadecks.org>+-- Stability   : unstable+-- Portability : unknown+--+-- ZoomCache multichannel API+----------------------------------------------------------------------++module Data.ZoomCache.Multichannel.Common (+      trackTypeMultichannel+) where++import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as C++----------------------------------------------------------------------++-- Identifier for track headers+trackTypeMultichannel :: ByteString+trackTypeMultichannel = C.pack "ZOOMmchn"+

@@ -0,0 +1,78 @@+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS -Wall #-}+----------------------------------------------------------------------+-- |+-- Module      : Data.ZoomCache.Multichannel.Internal+-- Copyright   : Conrad Parker+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Conrad Parker <conrad@metadecks.org>+-- Stability   : unstable+-- Portability : unknown+--+-- ZoomCache multichannel API+----------------------------------------------------------------------++module Data.ZoomCache.Multichannel.Internal (+      supportMultichannel+    , identifyCodecMultichannel+    , oneTrackMultichannel+    , mkTrackSpecMultichannel+) where++import Control.Applicative ((<$>))+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Data.Functor.Identity+import qualified Data.IntMap as IM+import qualified Data.Iteratee as I+import Data.TypeLevel.Num hiding ((==))++import Data.Iteratee.ZoomCache.Utils+import Data.ZoomCache.Common+import Data.ZoomCache.Multichannel.Common+import Data.ZoomCache.Multichannel.NList()+import Data.ZoomCache.NList+import Data.ZoomCache.Types++----------------------------------------------------------------------++supportMultichannel :: [IdentifyCodec] -> [IdentifyCodec]+supportMultichannel = f+    where f x = x ++ [identifyCodecMultichannel (f x)]++runner1 :: Identity (I.Iteratee s Identity c) -> c+runner1 = runIdentity . I.run . runIdentity++identifyCodecMultichannel :: [IdentifyCodec] -> IdentifyCodec+identifyCodecMultichannel identifiers bs = runner1 $ I.enumPure1Chunk bs identifyMulti+    where+        identifyMulti :: (Functor m, Monad m) => I.Iteratee ByteString m (Maybe Codec)+        identifyMulti = do+            mIdent <- B.pack <$> (I.joinI $ I.takeUpTo 8 I.stream2list)+            if mIdent == trackTypeMultichannel+                then do+                    channels <- readInt32be+                    subIdentLength <- readInt32be+                    subCodec <- readCodec identifiers subIdentLength+                    return (fmap (foo channels) subCodec)+                else return Nothing++        foo :: Int -> Codec -> Codec+        foo channels (Codec a) = reifyIntegral channels (\n -> Codec (NList n [a]))++----------------------------------------------------------------------++-- | Create a track map for a stream of a given type, as track no. 1+oneTrackMultichannel :: (ZoomReadable a)+                     => Int -> a -> Bool -> Bool -> SampleRateType -> Rational -> ByteString -> TrackMap+oneTrackMultichannel channels a delta zlib !drType !rate !name =+    IM.singleton 1 (mkTrackSpecMultichannel channels a delta zlib drType rate name)+{-# INLINABLE oneTrackMultichannel #-}++mkTrackSpecMultichannel :: (ZoomReadable a)+                        => Int -> a -> Bool -> Bool -> SampleRateType -> Rational -> ByteString+                        -> TrackSpec+mkTrackSpecMultichannel channels a = reifyIntegral channels+    (\n -> TrackSpec (Codec (NList n [a])))+

@@ -0,0 +1,167 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}+----------------------------------------------------------------------+{- |+   Module      : Data.ZoomCache.Multichannel.List+   Copyright   : Conrad Parker+   License     : BSD3-style (see LICENSE)++   Maintainer  : Conrad Parker <conrad@metadecks.org>+   Stability   : unstable+   Portability : unknown++Default codec implementation for multichannel values of type [a].++This module implements the interfaces documented in "Data.ZoomCache.Codec".++Multichannel SummaryData is simply a concatenation of n blocks of SummaryData+for type a.++-}+----------------------------------------------------------------------++module Data.ZoomCache.Multichannel.List (+      SummaryData(..)+    , SummaryWork(..)++    , wholeTrackSummaryListDouble+    , enumListDouble+    , enumSummaryListDouble+)where++import Control.Applicative ((<$>))+import Control.Monad.Trans (MonadIO)+import Data.ByteString (ByteString)+import Data.Int+import qualified Data.Iteratee as I+import Data.Maybe+import Data.Typeable+import Data.TypeLevel.Num hiding ((==))+import Data.Word++import Data.Iteratee.ZoomCache+import Data.ZoomCache.Codec+import Data.ZoomCache.Multichannel.NList+import Data.ZoomCache.NList+import Data.ZoomCache.Numeric++----------------------------------------------------------------------++instance (ZoomWrite a, ZoomWritable a) => ZoomWrite [a] where+    write = writeList++writeList :: (ZoomWrite a, ZoomWritable a) => TrackNo -> [a] -> ZoomW ()+writeList tn xs = reifyIntegral (length xs) (\n -> write tn (NList n xs))++instance (ZoomWrite a, ZoomWritable a) => ZoomWrite (SampleOffset, [a]) where+    write = writeSOList++writeSOList :: (ZoomWrite a, ZoomWritable a) => TrackNo -> (SampleOffset, [a]) -> ZoomW ()+writeSOList tn (ts, xs) = reifyIntegral (length xs) (\n -> write tn (ts, (NList n xs)))++----------------------------------------------------------------------++rawToListDouble :: ZoomRaw -> [[Double]]+rawToListDouble (ZoomRaw xs) | not (null d) = [d]+                             | typeOf xs == typeOf (undefined :: [NList D1 Double]) =+                                             l (cast xs :: Maybe [NList D1 Double])+                             | typeOf xs == typeOf (undefined :: [NList D1 Float]) =+                                             f (cast xs :: Maybe [NList D1 Float])+                             | typeOf xs == typeOf (undefined :: [NList D1 Int]) =+                                             f (cast xs :: Maybe [NList D1 Int])+                             | typeOf xs == typeOf (undefined :: [NList D1 Int8]) =+                                             f (cast xs :: Maybe [NList D1 Int8])+                             | typeOf xs == typeOf (undefined :: [NList D1 Int16]) =+                                             f (cast xs :: Maybe [NList D1 Int16])+                             | typeOf xs == typeOf (undefined :: [NList D1 Int32]) =+                                             f (cast xs :: Maybe [NList D1 Int32])+                             | typeOf xs == typeOf (undefined :: [NList D1 Int64]) =+                                             f (cast xs :: Maybe [NList D1 Int64])+                             | typeOf xs == typeOf (undefined :: [NList D1 Integer]) =+                                             f (cast xs :: Maybe [NList D1 Integer])+                             | typeOf xs == typeOf (undefined :: [NList D1 Word]) =+                                             f (cast xs :: Maybe [NList D1 Word])+                             | typeOf xs == typeOf (undefined :: [NList D1 Word8]) =+                                             f (cast xs :: Maybe [NList D1 Word8])+                             | typeOf xs == typeOf (undefined :: [NList D1 Word16]) =+                                             f (cast xs :: Maybe [NList D1 Word16])+                             | typeOf xs == typeOf (undefined :: [NList D1 Word32]) =+                                             f (cast xs :: Maybe [NList D1 Word32])+                             | typeOf xs == typeOf (undefined :: [NList D1 Word64]) =+                                             f (cast xs :: Maybe [NList D1 Word64])+                             | otherwise = []+    where+        d = rawToDouble (ZoomRaw xs)+        l :: Maybe [NList D1 a] -> [[a]]+        l = maybe [] (map nListToList)+        f :: (ZoomReadable a, Real a) => Maybe [NList D1 a] -> [[Double]]+        f = map (rawToDouble . ZoomRaw) . l++toSummaryListDouble :: Typeable a => Summary a -> Maybe [Summary Double]+toSummaryListDouble s | isJust sd = (:[]) <$> sd+                      | typeOf s == typeOf (undefined :: Summary (NList D1 Double)) =+                                sl <$> (cast s :: Maybe (Summary (NList D1 Double)))+                      | typeOf s == typeOf (undefined :: Summary (NList D1 Float)) =+                               sld <$> (cast s :: Maybe (Summary (NList D1 Float)))+                      | typeOf s == typeOf (undefined :: Summary (NList D1 Int)) =+                               sld <$> (cast s :: Maybe (Summary (NList D1 Int)))+                      | typeOf s == typeOf (undefined :: Summary (NList D1 Int8)) =+                               sld <$> (cast s :: Maybe (Summary (NList D1 Int8)))+                      | typeOf s == typeOf (undefined :: Summary (NList D1 Int16)) =+                               sld <$> (cast s :: Maybe (Summary (NList D1 Int16)))+                      | typeOf s == typeOf (undefined :: Summary (NList D1 Int32)) =+                               sld <$> (cast s :: Maybe (Summary (NList D1 Int32)))+                      | typeOf s == typeOf (undefined :: Summary (NList D1 Int64)) =+                               sld <$> (cast s :: Maybe (Summary (NList D1 Int64)))+                      | typeOf s == typeOf (undefined :: Summary (NList D1 Integer)) =+                               sld <$> (cast s :: Maybe (Summary (NList D1 Integer)))+                      | typeOf s == typeOf (undefined :: Summary (NList D1 Word)) =+                               sld <$> (cast s :: Maybe (Summary (NList D1 Word)))+                      | typeOf s == typeOf (undefined :: Summary (NList D1 Word8)) =+                               sld <$> (cast s :: Maybe (Summary (NList D1 Word8)))+                      | typeOf s == typeOf (undefined :: Summary (NList D1 Word16)) =+                               sld <$> (cast s :: Maybe (Summary (NList D1 Word16)))+                      | typeOf s == typeOf (undefined :: Summary (NList D1 Word32)) =+                               sld <$> (cast s :: Maybe (Summary (NList D1 Word32)))+                      | typeOf s == typeOf (undefined :: Summary (NList D1 Word64)) =+                               sld <$> (cast s :: Maybe (Summary (NList D1 Word64)))+                      | otherwise = Nothing+    where+        sd = toSummaryDouble s+        sl :: Summary (NList D1 a) -> [Summary a]+        sl = summaryNListToList+        sld :: Typeable a => Summary (NList D1 a) -> [Summary Double]+        sld = catMaybes . map toSummaryDouble . sl++----------------------------------------------------------------------++-- | Read the summary of an entire track.+wholeTrackSummaryListDouble :: (Functor m, MonadIO m)+                            => [IdentifyCodec]+                            -> TrackNo+                            -> I.Iteratee ByteString m [Summary Double]+wholeTrackSummaryListDouble identifiers trackNo =+    I.joinI $ enumCacheFile identifiers .+    I.joinI . filterTracks [trackNo] .  I.joinI . e $ I.last+    where+        e = I.joinI . enumSummaries . I.mapChunks (catMaybes . map toSLD)+        toSLD :: ZoomSummary -> Maybe [Summary Double]+        toSLD (ZoomSummary s) = toSummaryListDouble s++enumListDouble :: (Functor m, MonadIO m)+               => I.Enumeratee [Stream] [(TimeStamp, [Double])] m a+enumListDouble = I.joinI . enumPackets . I.mapChunks (concatMap f)+    where+        f :: Packet -> [(TimeStamp, [Double])]+        f Packet{..} = zip packetTimeStamps (rawToListDouble packetData)++enumSummaryListDouble :: (Functor m, MonadIO m)+                      => Int+                      -> I.Enumeratee [Stream] [[Summary Double]] m a+enumSummaryListDouble level =+    I.joinI . enumSummaryLevel level .+    I.mapChunks (catMaybes . map toSLD)+    where+        toSLD :: ZoomSummary -> Maybe [Summary Double]+        toSLD (ZoomSummary s) = toSummaryListDouble s

@@ -0,0 +1,153 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}+----------------------------------------------------------------------+{- |+   Module      : Data.ZoomCache.Multichannel.NList+   Copyright   : Conrad Parker+   License     : BSD3-style (see LICENSE)++   Maintainer  : Conrad Parker <conrad@metadecks.org>+   Stability   : unstable+   Portability : unknown++Default codec implementation for multichannel values of type (NList n a).++This module implements the interfaces documented in "Data.ZoomCache.Codec".++Multichannel SummaryData is simply a concatenation of n blocks of SummaryData+for type a.++-}+----------------------------------------------------------------------++module Data.ZoomCache.Multichannel.NList (+      SummaryData(..)+    , SummaryWork(..)++    , summaryNListToList+)where++import Blaze.ByteString.Builder+import Control.Applicative ((<$>))+import Control.Monad (replicateM)+import qualified Data.ByteString as B+import Data.ByteString (ByteString)+import Data.Iteratee (Iteratee)+import Data.List (intersperse)+import Data.Monoid (mconcat)+import Data.TypeLevel.Num hiding ((==))++import Data.ZoomCache.Codec+import Data.ZoomCache.Multichannel.Common+import Data.ZoomCache.NList+import Data.ZoomCache.Types++----------------------------------------------------------------------++summaryNListToList :: Summary (NList n a) -> [Summary a]+summaryNListToList s = map mkSummary (expandData (summaryData s))+    where+        mkSummary :: SummaryData a -> Summary a+        mkSummary sd = s { summaryData = sd }+        expandData :: SummaryData (NList n a) -> [SummaryData a]+        expandData (SummaryNList (NList _ l)) = l++----------------------------------------------------------------------+-- Read++instance (Nat n, ZoomReadable a) => ZoomReadable (NList n a) where+    data SummaryData (NList n a) = SummaryNList (NList n (SummaryData a))++    trackIdentifier = mkTrackTypeNList++    readRaw     = readNList+    readSummary = readSummaryNList++    prettyRaw         = prettyPacketNList+    prettySummaryData = prettySummaryNList++mkTrackTypeNList :: (Nat n, ZoomReadable a) => (NList n a) -> ByteString+mkTrackTypeNList (NList nv l) = mconcat+    [ trackTypeMultichannel+    , toByteString . fromIntegral32be . toInt $ nv+    , toByteString . fromIntegral32be . B.length $ subIdent+    , subIdent+    ]+    where+        subIdent = trackIdentifier (head l)++prettyPacketNList :: (Nat n, ZoomReadable a) => NList n a -> String+prettyPacketNList (NList _ l) = "[" ++ (concat $ intersperse "," (map prettyRaw l)) ++ "]"++readNList :: (Functor m, Monad m, Nat n, ZoomReadable a)+          => Iteratee ByteString m (NList n a)+readNList = NList unify <$> replicateM (toInt unify) readRaw+    where+        unify = undefined++readSummaryNList :: (Functor m, Monad m, Nat n, ZoomReadable a)+                 => Iteratee ByteString m (SummaryData (NList n a))+readSummaryNList = SummaryNList .+    NList unify <$> replicateM (toInt unify) readSummary+    where+        unify = undefined++prettySummaryNList :: (Nat n, ZoomReadable a) => SummaryData (NList n a) -> String+prettySummaryNList (SummaryNList (NList _ l)) =+    "[" ++ (concat $ intersperse "," (map prettySummaryData l)) ++ "]"++----------------------------------------------------------------------+-- Write++instance (Nat n, ZoomWrite a, ZoomWritable a) => ZoomWrite (NList n a) where+    write = writeData++instance (Nat n, ZoomWrite a, ZoomWritable a) => ZoomWrite (SampleOffset, (NList n a)) where+    write = writeDataVBR++instance (Nat n, ZoomWritable a) => ZoomWritable (NList n a) where+    data SummaryWork (NList n a) = SummaryWorkNList (NList n (SummaryWork a))++    fromRaw           = fromNList+    fromSummaryData   = fromSummaryNList++    initSummaryWork   = initSummaryNList+    toSummaryData     = mkSummaryNList+    updateSummaryData = updateSummaryNList+    appendSummaryData = appendSummaryNList++fromNList :: ZoomWritable a => (NList n a) -> Builder+fromNList (NList _ l) = mconcat $ map fromRaw l++initSummaryNList :: (Nat n, ZoomWritable a)+                 => SampleOffset -> SummaryWork (NList n a)+initSummaryNList entry = SummaryWorkNList $+    NList unify (replicate (toInt unify) (initSummaryWork entry))+    where+        unify = undefined++mkSummaryNList :: ZoomWritable a+               => SampleOffsetDiff -> SummaryWork (NList n a) -> SummaryData (NList n a)+mkSummaryNList dur (SummaryWorkNList (NList _ l)) =+    SummaryNList (NList undefined (map (toSummaryData dur) l))++fromSummaryNList :: ZoomWritable a+                 => SummaryData (NList n a) -> Builder+fromSummaryNList (SummaryNList (NList _ l)) = mconcat $ map fromSummaryData l++updateSummaryNList :: ZoomWritable a+                   => SampleOffset  -> (NList n a) -> SummaryWork (NList n a)+                   -> SummaryWork (NList n a)+updateSummaryNList t (NList _ xs) (SummaryWorkNList (NList _ ws)) =+    SummaryWorkNList (NList undefined (zipWith (updateSummaryData t) xs ws))++appendSummaryNList :: ZoomWritable a+                   => SampleOffsetDiff -> SummaryData (NList n a)+                   -> SampleOffsetDiff -> SummaryData (NList n a)+                   -> SummaryData (NList n a)+appendSummaryNList dur1 (SummaryNList (NList _ l1)) dur2 (SummaryNList (NList _ l2)) =+    SummaryNList (NList undefined (zipWith a l1 l2))+    where+        a s1 s2 = appendSummaryData dur1 s1 dur2 s2

@@ -0,0 +1,46 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -Wall #-}+----------------------------------------------------------------------+{- |+   Module      : Data.ZoomCache.NList+   Copyright   : Conrad Parker+   License     : BSD3-style (see LICENSE)++   Maintainer  : Conrad Parker <conrad@metadecks.org>+   Stability   : unstable+   Portability : unknown++Fixed-length lists.+-}+----------------------------------------------------------------------++module Data.ZoomCache.NList (+      NList(..)+    , nListToList+)where++import Control.Applicative ((<$>))+import Data.Typeable+import Data.TypeLevel.Num hiding ((==))+import Test.QuickCheck.Arbitrary++----------------------------------------------------------------------++data NList n a = NList n [a]+    deriving (Show)++instance Eq a => Eq (NList n a) where+    (NList _ a1) == (NList _ a2) = a1 == a2++instance Typeable a => Typeable (NList n a) where+    typeOf _ = mkTyConApp (mkTyCon3 "zoom-cache" "Data.ZoomCache.NList" "NList") [typeOf (undefined :: a)]++instance (Nat n, Arbitrary a) => Arbitrary (NList n a) where+    arbitrary = NList unify <$> sequence [ arbitrary | _ <- [1..(toInt unify)] ]+        where+            unify = undefined++nListToList :: NList n a -> [a]+nListToList (NList _ xs) = xs+

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS -Wall #-} ----------------------------------------------------------------------@@ -23,7 +22,9 @@   , numAvg   , numRMS +  , rawToDouble   , toSummaryDouble+  , toSummarySODouble    , wholeTrackSummaryDouble   , enumDouble@@ -80,7 +81,7 @@  ---------------------------------------------------------------------- --- | Coercion of numeric summaries to type Summary Double.+-- | Coercion of numeric Summary to type SummarySO Double. toSummaryDouble :: Typeable a => Summary a -> Maybe (Summary Double) toSummaryDouble s | typeOf s == typeOf (undefined :: Summary Double) =                                 id (cast s :: Maybe (Summary Double))@@ -109,10 +110,42 @@                   | typeOf s == typeOf (undefined :: Summary Word64) =                             sd <$> (cast s :: Maybe (Summary Word64))                   | otherwise = Nothing-     where         sd :: ZoomNum a => Summary a -> Summary Double         sd s' = s' { summaryData = toSummaryDataDouble (summaryData s') }++-- | Coercion of numeric SummarySO to type SummarySO Double.+toSummarySODouble :: Typeable a => SummarySO a -> Maybe (SummarySO Double)+toSummarySODouble s | typeOf s == typeOf (undefined :: SummarySO Double) =+                                  id (cast s :: Maybe (SummarySO Double))+                    | typeOf s == typeOf (undefined :: SummarySO Float) =+                                  sd <$> (cast s :: Maybe (SummarySO Float))+                    | typeOf s == typeOf (undefined :: SummarySO Int) =+                              sd <$> (cast s :: Maybe (SummarySO Int))+                    | typeOf s == typeOf (undefined :: SummarySO Int8) =+                              sd <$> (cast s :: Maybe (SummarySO Int8))+                    | typeOf s == typeOf (undefined :: SummarySO Int16) =+                              sd <$> (cast s :: Maybe (SummarySO Int16))+                    | typeOf s == typeOf (undefined :: SummarySO Int32) =+                              sd <$> (cast s :: Maybe (SummarySO Int32))+                    | typeOf s == typeOf (undefined :: SummarySO Int64) =+                              sd <$> (cast s :: Maybe (SummarySO Int64))+                    | typeOf s == typeOf (undefined :: SummarySO Integer) =+                              sd <$> (cast s :: Maybe (SummarySO Integer))+                    | typeOf s == typeOf (undefined :: SummarySO Word) =+                              sd <$> (cast s :: Maybe (SummarySO Word))+                    | typeOf s == typeOf (undefined :: SummarySO Word8) =+                              sd <$> (cast s :: Maybe (SummarySO Word8))+                    | typeOf s == typeOf (undefined :: SummarySO Word16) =+                              sd <$> (cast s :: Maybe (SummarySO Word16))+                    | typeOf s == typeOf (undefined :: SummarySO Word32) =+                              sd <$> (cast s :: Maybe (SummarySO Word32))+                    | typeOf s == typeOf (undefined :: SummarySO Word64) =+                              sd <$> (cast s :: Maybe (SummarySO Word64))+                    | otherwise = Nothing+    where+        sd :: ZoomNum a => SummarySO a -> SummarySO Double+        sd s' = s' { summarySOData = toSummaryDataDouble (summarySOData s') }          toSummaryDataDouble :: ZoomNum a => SummaryData a -> SummaryData Double toSummaryDataDouble s = numMkSummary

@@ -122,12 +122,15 @@ instance ZoomWrite Float where     write = writeData -instance ZoomWrite (TimeStamp, Float) where+instance ZoomWrite (SampleOffset, Float) where     write = writeDataVBR +instance ZoomWrite (TimeStamp, Float) where+    write = writeDataTS+ instance ZoomWritable Float where     data SummaryWork Float = SummaryWorkFloat-        { swFloatTime  :: {-# UNPACK #-}!TimeStamp+        { swFloatTime  :: {-# UNPACK #-}!SampleOffset         , swFloatEntry :: !(Maybe Float)         , swFloatExit  :: {-# UNPACK #-}!Float         , swFloatMin   :: {-# UNPACK #-}!Float@@ -152,7 +155,7 @@     numAvg   = summaryFloatAvg     numRMS   = summaryFloatRMS -    numWorkTime  = swFloatTime+    numWorkSO  = swFloatTime     numWorkEntry = swFloatEntry     numWorkExit  = swFloatExit     numWorkMin   = swFloatMin@@ -165,9 +168,9 @@  #if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE fromSummaryNum :: SummaryData Float -> Builder #-}-{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Float -> SummaryData Float #-}-{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Float -> TimeStampDiff -> SummaryData Float -> SummaryData Float #-}-{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Float -> SummaryWork Float -> SummaryWork Float #-}+{-# SPECIALIZE mkSummaryNum :: SampleOffsetDiff -> SummaryWork Float -> SummaryData Float #-}+{-# SPECIALIZE appendSummaryNum :: SampleOffsetDiff -> SummaryData Float -> SampleOffsetDiff -> SummaryData Float -> SummaryData Float #-}+{-# SPECIALIZE updateSummaryNum :: SampleOffset -> Float -> SummaryWork Float -> SummaryWork Float #-} #endif  ----------------------------------------------------------------------@@ -200,12 +203,15 @@ instance ZoomWrite Double where     write = writeData -instance ZoomWrite (TimeStamp, Double) where+instance ZoomWrite (SampleOffset, Double) where     write = writeDataVBR +instance ZoomWrite (TimeStamp, Double) where+    write = writeDataTS+ instance ZoomWritable Double where     data SummaryWork Double = SummaryWorkDouble-        { swDoubleTime  :: {-# UNPACK #-}!TimeStamp+        { swDoubleTime  :: {-# UNPACK #-}!SampleOffset         , swDoubleEntry :: !(Maybe Double)         , swDoubleExit  :: {-# UNPACK #-}!Double         , swDoubleMin   :: {-# UNPACK #-}!Double@@ -230,7 +236,7 @@     numAvg   = summaryDoubleAvg     numRMS   = summaryDoubleRMS -    numWorkTime  = swDoubleTime+    numWorkSO  = swDoubleTime     numWorkEntry = swDoubleEntry     numWorkExit  = swDoubleExit     numWorkMin   = swDoubleMin@@ -243,9 +249,9 @@  #if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE fromSummaryNum :: SummaryData Double -> Builder #-}-{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Double -> SummaryData Double #-}-{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Double -> TimeStampDiff -> SummaryData Double -> SummaryData Double #-}-{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Double -> SummaryWork Double -> SummaryWork Double #-}+{-# SPECIALIZE mkSummaryNum :: SampleOffsetDiff -> SummaryWork Double -> SummaryData Double #-}+{-# SPECIALIZE appendSummaryNum :: SampleOffsetDiff -> SummaryData Double -> SampleOffsetDiff -> SummaryData Double -> SummaryData Double #-}+{-# SPECIALIZE updateSummaryNum :: SampleOffset -> Double -> SummaryWork Double -> SummaryWork Double #-} #endif  ----------------------------------------------------------------------@@ -262,7 +268,7 @@     ]  initSummaryFloat :: (RealFloat a, ZoomNum a)-                 => TimeStamp -> SummaryWork a+                 => SampleOffset -> SummaryWork a initSummaryFloat entry = numMkSummaryWork     entry     Nothing

@@ -215,12 +215,15 @@ instance ZoomWrite Int where     write = writeData -instance ZoomWrite (TimeStamp, Int) where+instance ZoomWrite (SampleOffset, Int) where     write = writeDataVBR +instance ZoomWrite (TimeStamp, Int) where+    write = writeDataTS+ instance ZoomWritable Int where     data SummaryWork Int = SummaryWorkInt-        { swIntTime  :: {-# UNPACK #-}!TimeStamp+        { swIntTime  :: {-# UNPACK #-}!SampleOffset         , swIntEntry :: !(Maybe Int)         , swIntExit  :: {-# UNPACK #-}!Int         , swIntMin   :: {-# UNPACK #-}!Int@@ -246,7 +249,7 @@     numAvg = summaryIntAvg     numRMS = summaryIntRMS -    numWorkTime = swIntTime+    numWorkSO = swIntTime     numWorkEntry = swIntEntry     numWorkExit = swIntExit     numWorkMin = swIntMin@@ -259,10 +262,10 @@  #if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE fromSummaryNum :: SummaryData Int -> Builder #-}-{-# SPECIALIZE initSummaryNumBounded :: TimeStamp -> SummaryWork Int #-}-{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Int -> SummaryData Int #-}-{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Int -> TimeStampDiff -> SummaryData Int -> SummaryData Int #-}-{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Int -> SummaryWork Int -> SummaryWork Int #-}+{-# SPECIALIZE initSummaryNumBounded :: SampleOffset -> SummaryWork Int #-}+{-# SPECIALIZE mkSummaryNum :: SampleOffsetDiff -> SummaryWork Int -> SummaryData Int #-}+{-# SPECIALIZE appendSummaryNum :: SampleOffsetDiff -> SummaryData Int -> SampleOffsetDiff -> SummaryData Int -> SummaryData Int #-}+{-# SPECIALIZE updateSummaryNum :: SampleOffset -> Int -> SummaryWork Int -> SummaryWork Int #-} #endif  ----------------------------------------------------------------------@@ -295,12 +298,15 @@ instance ZoomWrite Int8 where     write = writeData -instance ZoomWrite (TimeStamp, Int8) where+instance ZoomWrite (SampleOffset, Int8) where     write = writeDataVBR +instance ZoomWrite (TimeStamp, Int8) where+    write = writeDataTS+ instance ZoomWritable Int8 where     data SummaryWork Int8 = SummaryWorkInt8-        { swInt8Time  :: {-# UNPACK #-}!TimeStamp+        { swInt8Time  :: {-# UNPACK #-}!SampleOffset         , swInt8Entry :: !(Maybe Int8)         , swInt8Exit  :: {-# UNPACK #-}!Int8         , swInt8Min   :: {-# UNPACK #-}!Int8@@ -326,7 +332,7 @@     numAvg = summaryInt8Avg     numRMS = summaryInt8RMS -    numWorkTime = swInt8Time+    numWorkSO = swInt8Time     numWorkEntry = swInt8Entry     numWorkExit = swInt8Exit     numWorkMin = swInt8Min@@ -339,10 +345,10 @@  #if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE fromSummaryNum :: SummaryData Int8 -> Builder #-}-{-# SPECIALIZE initSummaryNumBounded :: TimeStamp -> SummaryWork Int8 #-}-{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Int8 -> SummaryData Int8 #-}-{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Int8 -> TimeStampDiff -> SummaryData Int8 -> SummaryData Int8 #-}-{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Int8 -> SummaryWork Int8 -> SummaryWork Int8 #-}+{-# SPECIALIZE initSummaryNumBounded :: SampleOffset -> SummaryWork Int8 #-}+{-# SPECIALIZE mkSummaryNum :: SampleOffsetDiff -> SummaryWork Int8 -> SummaryData Int8 #-}+{-# SPECIALIZE appendSummaryNum :: SampleOffsetDiff -> SummaryData Int8 -> SampleOffsetDiff -> SummaryData Int8 -> SummaryData Int8 #-}+{-# SPECIALIZE updateSummaryNum :: SampleOffset -> Int8 -> SummaryWork Int8 -> SummaryWork Int8 #-} #endif  ----------------------------------------------------------------------@@ -375,12 +381,15 @@ instance ZoomWrite Int16 where     write = writeData -instance ZoomWrite (TimeStamp, Int16) where+instance ZoomWrite (SampleOffset, Int16) where     write = writeDataVBR +instance ZoomWrite (TimeStamp, Int16) where+    write = writeDataTS+ instance ZoomWritable Int16 where     data SummaryWork Int16 = SummaryWorkInt16-        { swInt16Time  :: {-# UNPACK #-}!TimeStamp+        { swInt16Time  :: {-# UNPACK #-}!SampleOffset         , swInt16Entry :: !(Maybe Int16)         , swInt16Exit  :: {-# UNPACK #-}!Int16         , swInt16Min   :: {-# UNPACK #-}!Int16@@ -406,7 +415,7 @@     numAvg = summaryInt16Avg     numRMS = summaryInt16RMS -    numWorkTime = swInt16Time+    numWorkSO = swInt16Time     numWorkEntry = swInt16Entry     numWorkExit = swInt16Exit     numWorkMin = swInt16Min@@ -419,10 +428,10 @@  #if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE fromSummaryNum :: SummaryData Int16 -> Builder #-}-{-# SPECIALIZE initSummaryNumBounded :: TimeStamp -> SummaryWork Int16 #-}-{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Int16 -> SummaryData Int16 #-}-{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Int16 -> TimeStampDiff -> SummaryData Int16 -> SummaryData Int16 #-}-{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Int16 -> SummaryWork Int16 -> SummaryWork Int16 #-}+{-# SPECIALIZE initSummaryNumBounded :: SampleOffset -> SummaryWork Int16 #-}+{-# SPECIALIZE mkSummaryNum :: SampleOffsetDiff -> SummaryWork Int16 -> SummaryData Int16 #-}+{-# SPECIALIZE appendSummaryNum :: SampleOffsetDiff -> SummaryData Int16 -> SampleOffsetDiff -> SummaryData Int16 -> SummaryData Int16 #-}+{-# SPECIALIZE updateSummaryNum :: SampleOffset -> Int16 -> SummaryWork Int16 -> SummaryWork Int16 #-} #endif  ----------------------------------------------------------------------@@ -455,12 +464,15 @@ instance ZoomWrite Int32 where     write = writeData -instance ZoomWrite (TimeStamp, Int32) where+instance ZoomWrite (SampleOffset, Int32) where     write = writeDataVBR +instance ZoomWrite (TimeStamp, Int32) where+    write = writeDataTS+ instance ZoomWritable Int32 where     data SummaryWork Int32 = SummaryWorkInt32-        { swInt32Time  :: {-# UNPACK #-}!TimeStamp+        { swInt32Time  :: {-# UNPACK #-}!SampleOffset         , swInt32Entry :: !(Maybe Int32)         , swInt32Exit  :: {-# UNPACK #-}!Int32         , swInt32Min   :: {-# UNPACK #-}!Int32@@ -486,7 +498,7 @@     numAvg = summaryInt32Avg     numRMS = summaryInt32RMS -    numWorkTime = swInt32Time+    numWorkSO = swInt32Time     numWorkEntry = swInt32Entry     numWorkExit = swInt32Exit     numWorkMin = swInt32Min@@ -499,10 +511,10 @@  #if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE fromSummaryNum :: SummaryData Int32 -> Builder #-}-{-# SPECIALIZE initSummaryNumBounded :: TimeStamp -> SummaryWork Int32 #-}-{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Int32 -> SummaryData Int32 #-}-{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Int32 -> TimeStampDiff -> SummaryData Int32 -> SummaryData Int32 #-}-{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Int32 -> SummaryWork Int32 -> SummaryWork Int32 #-}+{-# SPECIALIZE initSummaryNumBounded :: SampleOffset -> SummaryWork Int32 #-}+{-# SPECIALIZE mkSummaryNum :: SampleOffsetDiff -> SummaryWork Int32 -> SummaryData Int32 #-}+{-# SPECIALIZE appendSummaryNum :: SampleOffsetDiff -> SummaryData Int32 -> SampleOffsetDiff -> SummaryData Int32 -> SummaryData Int32 #-}+{-# SPECIALIZE updateSummaryNum :: SampleOffset -> Int32 -> SummaryWork Int32 -> SummaryWork Int32 #-} #endif  ----------------------------------------------------------------------@@ -535,12 +547,15 @@ instance ZoomWrite Int64 where     write = writeData -instance ZoomWrite (TimeStamp, Int64) where+instance ZoomWrite (SampleOffset, Int64) where     write = writeDataVBR +instance ZoomWrite (TimeStamp, Int64) where+    write = writeDataTS+ instance ZoomWritable Int64 where     data SummaryWork Int64 = SummaryWorkInt64-        { swInt64Time  :: {-# UNPACK #-}!TimeStamp+        { swInt64Time  :: {-# UNPACK #-}!SampleOffset         , swInt64Entry :: !(Maybe Int64)         , swInt64Exit  :: {-# UNPACK #-}!Int64         , swInt64Min   :: {-# UNPACK #-}!Int64@@ -566,7 +581,7 @@     numAvg = summaryInt64Avg     numRMS = summaryInt64RMS -    numWorkTime = swInt64Time+    numWorkSO = swInt64Time     numWorkEntry = swInt64Entry     numWorkExit = swInt64Exit     numWorkMin = swInt64Min@@ -579,10 +594,10 @@  #if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE fromSummaryNum :: SummaryData Int64 -> Builder #-}-{-# SPECIALIZE initSummaryNumBounded :: TimeStamp -> SummaryWork Int64 #-}-{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Int64 -> SummaryData Int64 #-}-{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Int64 -> TimeStampDiff -> SummaryData Int64 -> SummaryData Int64 #-}-{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Int64 -> SummaryWork Int64 -> SummaryWork Int64 #-}+{-# SPECIALIZE initSummaryNumBounded :: SampleOffset -> SummaryWork Int64 #-}+{-# SPECIALIZE mkSummaryNum :: SampleOffsetDiff -> SummaryWork Int64 -> SummaryData Int64 #-}+{-# SPECIALIZE appendSummaryNum :: SampleOffsetDiff -> SummaryData Int64 -> SampleOffsetDiff -> SummaryData Int64 -> SummaryData Int64 #-}+{-# SPECIALIZE updateSummaryNum :: SampleOffset -> Int64 -> SummaryWork Int64 -> SummaryWork Int64 #-} #endif  ----------------------------------------------------------------------@@ -615,12 +630,15 @@ instance ZoomWrite Integer where     write = writeData -instance ZoomWrite (TimeStamp, Integer) where+instance ZoomWrite (SampleOffset, Integer) where     write = writeDataVBR +instance ZoomWrite (TimeStamp, Integer) where+    write = writeDataTS+ instance ZoomWritable Integer where     data SummaryWork Integer = SummaryWorkInteger-        { swIntegerTime  :: {-# UNPACK #-}!TimeStamp+        { swIntegerTime  :: {-# UNPACK #-}!SampleOffset         , swIntegerEntry :: !(Maybe Integer)         , swIntegerExit  :: !Integer         , swIntegerMin   :: !(Maybe Integer)@@ -646,7 +664,7 @@     numAvg = summaryIntegerAvg     numRMS = summaryIntegerRMS -    numWorkTime = swIntegerTime+    numWorkSO = swIntegerTime     numWorkEntry = swIntegerEntry     numWorkExit = swIntegerExit     numWorkMin = error "numWorkMin undefined for Integer"@@ -659,16 +677,16 @@  #if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE fromSummaryNum :: SummaryData Integer -> Builder #-}-{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Integer -> SummaryData Integer #-}-{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Integer -> TimeStampDiff -> SummaryData Integer -> SummaryData Integer #-}-{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Integer -> SummaryWork Integer -> SummaryWork Integer #-}+{-# SPECIALIZE mkSummaryNum :: SampleOffsetDiff -> SummaryWork Integer -> SummaryData Integer #-}+{-# SPECIALIZE appendSummaryNum :: SampleOffsetDiff -> SummaryData Integer -> SampleOffsetDiff -> SummaryData Integer -> SummaryData Integer #-}+{-# SPECIALIZE updateSummaryNum :: SampleOffset -> Integer -> SummaryWork Integer -> SummaryWork Integer #-} #endif -initSummaryInteger :: TimeStamp -> SummaryWork Integer+initSummaryInteger :: SampleOffset -> SummaryWork Integer initSummaryInteger entry = SummaryWorkInteger entry Nothing 0 Nothing Nothing 0.0 0.0 -toSummaryInteger :: TimeStampDiff -> SummaryWork Integer -> SummaryData Integer-toSummaryInteger (TSDiff dur) SummaryWorkInteger{..} = SummaryInteger+toSummaryInteger :: SampleOffsetDiff -> SummaryWork Integer -> SummaryData Integer+toSummaryInteger (SODiff dur) SummaryWorkInteger{..} = SummaryInteger     { summaryIntegerEntry = fromMaybe 0 swIntegerEntry     , summaryIntegerExit  = swIntegerExit     , summaryIntegerMin = fromMaybe 0 swIntegerMin@@ -677,7 +695,7 @@     , summaryIntegerRMS = sqrt $ swIntegerSumSq / fromIntegral dur     } -updateSummaryInteger :: TimeStamp -> Integer+updateSummaryInteger :: SampleOffset -> Integer                      -> SummaryWork Integer                      -> SummaryWork Integer updateSummaryInteger t d SummaryWorkInteger{..} = SummaryWorkInteger@@ -690,7 +708,7 @@     , swIntegerSumSq = swIntegerSumSq + realToFrac (d*d * fromIntegral dur)     }     where-        !(TSDiff dur) = timeStampDiff t swIntegerTime+        !(SODiff dur) = sampleOffsetDiff t swIntegerTime  ---------------------------------------------------------------------- 

@@ -43,14 +43,14 @@ {-# INLINABLE fromSummaryNum #-}  initSummaryNumBounded :: (Bounded a, ZoomNum a)-                      => TimeStamp -> SummaryWork a+                      => SampleOffset -> SummaryWork a initSummaryNumBounded entry = numMkSummaryWork entry Nothing 0 maxBound minBound 0.0 0.0 {-# INLINEABLE initSummaryNumBounded #-}  mkSummaryNum :: ZoomNum a-             => TimeStampDiff -> SummaryWork a+             => SampleOffsetDiff -> SummaryWork a              -> SummaryData a-mkSummaryNum (TSDiff dur) sw =+mkSummaryNum (SODiff dur) sw =     numMkSummary (fromMaybe 0 $ numWorkEntry sw) (numWorkExit sw)                  (numWorkMin sw) (numWorkMax sw)                  (numWorkSum sw / fromIntegral dur)@@ -58,10 +58,10 @@ {-# INLINEABLE mkSummaryNum #-}  appendSummaryNum :: ZoomNum a-                 => TimeStampDiff -> SummaryData a-                 -> TimeStampDiff -> SummaryData a+                 => SampleOffsetDiff -> SummaryData a+                 -> SampleOffsetDiff -> SummaryData a                  -> SummaryData a-appendSummaryNum (TSDiff dur1) s1 (TSDiff dur2) s2 = numMkSummary+appendSummaryNum (SODiff dur1) s1 (SODiff dur2) s2 = numMkSummary     (numEntry s1)     (numExit s2)     (min (numMin s1) (numMin s2))@@ -75,7 +75,7 @@ {-# INLINEABLE appendSummaryNum #-}  updateSummaryNum :: ZoomNum a-                 => TimeStamp -> a+                 => SampleOffset -> a                  -> SummaryWork a                  -> SummaryWork a updateSummaryNum t d sw =@@ -86,7 +86,7 @@                        ((numWorkSum sw) + realToFrac (d * fromIntegral dur))                        ((numWorkSumSq sw) + realToFrac (d*d * fromIntegral dur))     where-        !(TSDiff dur) = timeStampDiff t (numWorkTime sw)+        !(SODiff dur) = sampleOffsetDiff t (numWorkSO sw) {-# INLINEABLE updateSummaryNum #-}  deltaDecodeNum :: ZoomNum a => [a] -> [a]

@@ -29,7 +29,7 @@     -- | Root mean square value in the summary interval     numRMS   :: SummaryData a -> Double -    numWorkTime  :: SummaryWork a -> TimeStamp+    numWorkSO    :: SummaryWork a -> SampleOffset     numWorkEntry :: SummaryWork a -> Maybe a     numWorkExit  :: SummaryWork a -> a     numWorkMin   :: SummaryWork a -> a@@ -38,5 +38,5 @@     numWorkSumSq :: SummaryWork a -> Double      numMkSummary :: a -> a -> a -> a -> Double -> Double -> SummaryData a-    numMkSummaryWork :: TimeStamp -> Maybe a -> a -> a -> a -> Double -> Double+    numMkSummaryWork :: SampleOffset -> Maybe a -> a -> a -> a -> Double -> Double                      -> SummaryWork a

@@ -183,12 +183,15 @@ instance ZoomWrite Word where     write = writeData -instance ZoomWrite (TimeStamp, Word) where+instance ZoomWrite (SampleOffset, Word) where     write = writeDataVBR +instance ZoomWrite (TimeStamp, Word) where+    write = writeDataTS+ instance ZoomWritable Word where     data SummaryWork Word = SummaryWorkWord-        { swWordTime  :: {-# UNPACK #-}!TimeStamp+        { swWordTime  :: {-# UNPACK #-}!SampleOffset         , swWordEntry :: !(Maybe Word)         , swWordExit  :: {-# UNPACK #-}!Word         , swWordMin   :: {-# UNPACK #-}!Word@@ -213,7 +216,7 @@     numAvg = summaryWordAvg     numRMS = summaryWordRMS -    numWorkTime = swWordTime+    numWorkSO = swWordTime     numWorkEntry = swWordEntry     numWorkExit = swWordExit     numWorkMin = swWordMin@@ -226,10 +229,10 @@  #if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE fromSummaryNum :: SummaryData Word -> Builder #-}-{-# SPECIALIZE initSummaryNumBounded :: TimeStamp -> SummaryWork Word #-}-{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Word -> SummaryData Word #-}-{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Word -> TimeStampDiff -> SummaryData Word -> SummaryData Word #-}-{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Word -> SummaryWork Word -> SummaryWork Word #-}+{-# SPECIALIZE initSummaryNumBounded :: SampleOffset -> SummaryWork Word #-}+{-# SPECIALIZE mkSummaryNum :: SampleOffsetDiff -> SummaryWork Word -> SummaryData Word #-}+{-# SPECIALIZE appendSummaryNum :: SampleOffsetDiff -> SummaryData Word -> SampleOffsetDiff -> SummaryData Word -> SummaryData Word #-}+{-# SPECIALIZE updateSummaryNum :: SampleOffset -> Word -> SummaryWork Word -> SummaryWork Word #-} #endif  ----------------------------------------------------------------------@@ -260,12 +263,15 @@ instance ZoomWrite Word8 where     write = writeData -instance ZoomWrite (TimeStamp, Word8) where+instance ZoomWrite (SampleOffset, Word8) where     write = writeDataVBR +instance ZoomWrite (TimeStamp, Word8) where+    write = writeDataTS+ instance ZoomWritable Word8 where     data SummaryWork Word8 = SummaryWorkWord8-        { swWord8Time  :: {-# UNPACK #-}!TimeStamp+        { swWord8Time  :: {-# UNPACK #-}!SampleOffset         , swWord8Entry :: !(Maybe Word8)         , swWord8Exit  :: {-# UNPACK #-}!Word8         , swWord8Min   :: {-# UNPACK #-}!Word8@@ -290,7 +296,7 @@     numAvg = summaryWord8Avg     numRMS = summaryWord8RMS -    numWorkTime = swWord8Time+    numWorkSO = swWord8Time     numWorkEntry = swWord8Entry     numWorkExit = swWord8Exit     numWorkMin = swWord8Min@@ -303,10 +309,10 @@  #if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE fromSummaryNum :: SummaryData Word8 -> Builder #-}-{-# SPECIALIZE initSummaryNumBounded :: TimeStamp -> SummaryWork Word8 #-}-{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Word8 -> SummaryData Word8 #-}-{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Word8 -> TimeStampDiff -> SummaryData Word8 -> SummaryData Word8 #-}-{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Word8 -> SummaryWork Word8 -> SummaryWork Word8 #-}+{-# SPECIALIZE initSummaryNumBounded :: SampleOffset -> SummaryWork Word8 #-}+{-# SPECIALIZE mkSummaryNum :: SampleOffsetDiff -> SummaryWork Word8 -> SummaryData Word8 #-}+{-# SPECIALIZE appendSummaryNum :: SampleOffsetDiff -> SummaryData Word8 -> SampleOffsetDiff -> SummaryData Word8 -> SummaryData Word8 #-}+{-# SPECIALIZE updateSummaryNum :: SampleOffset -> Word8 -> SummaryWork Word8 -> SummaryWork Word8 #-} #endif  ----------------------------------------------------------------------@@ -337,12 +343,15 @@ instance ZoomWrite Word16 where     write = writeData -instance ZoomWrite (TimeStamp, Word16) where+instance ZoomWrite (SampleOffset, Word16) where     write = writeDataVBR +instance ZoomWrite (TimeStamp, Word16) where+    write = writeDataTS+ instance ZoomWritable Word16 where     data SummaryWork Word16 = SummaryWorkWord16-        { swWord16Time  :: {-# UNPACK #-}!TimeStamp+        { swWord16Time  :: {-# UNPACK #-}!SampleOffset         , swWord16Entry :: !(Maybe Word16)         , swWord16Exit  :: {-# UNPACK #-}!Word16         , swWord16Min   :: {-# UNPACK #-}!Word16@@ -367,7 +376,7 @@     numAvg = summaryWord16Avg     numRMS = summaryWord16RMS -    numWorkTime = swWord16Time+    numWorkSO = swWord16Time     numWorkEntry = swWord16Entry     numWorkExit = swWord16Exit     numWorkMin = swWord16Min@@ -380,10 +389,10 @@  #if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE fromSummaryNum :: SummaryData Word16 -> Builder #-}-{-# SPECIALIZE initSummaryNumBounded :: TimeStamp -> SummaryWork Word16 #-}-{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Word16 -> SummaryData Word16 #-}-{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Word16 -> TimeStampDiff -> SummaryData Word16 -> SummaryData Word16 #-}-{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Word16 -> SummaryWork Word16 -> SummaryWork Word16 #-}+{-# SPECIALIZE initSummaryNumBounded :: SampleOffset -> SummaryWork Word16 #-}+{-# SPECIALIZE mkSummaryNum :: SampleOffsetDiff -> SummaryWork Word16 -> SummaryData Word16 #-}+{-# SPECIALIZE appendSummaryNum :: SampleOffsetDiff -> SummaryData Word16 -> SampleOffsetDiff -> SummaryData Word16 -> SummaryData Word16 #-}+{-# SPECIALIZE updateSummaryNum :: SampleOffset -> Word16 -> SummaryWork Word16 -> SummaryWork Word16 #-} #endif  ----------------------------------------------------------------------@@ -414,12 +423,15 @@ instance ZoomWrite Word32 where     write = writeData -instance ZoomWrite (TimeStamp, Word32) where+instance ZoomWrite (SampleOffset, Word32) where     write = writeDataVBR +instance ZoomWrite (TimeStamp, Word32) where+    write = writeDataTS+ instance ZoomWritable Word32 where     data SummaryWork Word32 = SummaryWorkWord32-        { swWord32Time  :: {-# UNPACK #-}!TimeStamp+        { swWord32Time  :: {-# UNPACK #-}!SampleOffset         , swWord32Entry :: !(Maybe Word32)         , swWord32Exit  :: {-# UNPACK #-}!Word32         , swWord32Min   :: {-# UNPACK #-}!Word32@@ -444,7 +456,7 @@     numAvg = summaryWord32Avg     numRMS = summaryWord32RMS -    numWorkTime = swWord32Time+    numWorkSO = swWord32Time     numWorkEntry = swWord32Entry     numWorkExit = swWord32Exit     numWorkMin = swWord32Min@@ -457,10 +469,10 @@  #if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE fromSummaryNum :: SummaryData Word32 -> Builder #-}-{-# SPECIALIZE initSummaryNumBounded :: TimeStamp -> SummaryWork Word32 #-}-{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Word32 -> SummaryData Word32 #-}-{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Word32 -> TimeStampDiff -> SummaryData Word32 -> SummaryData Word32 #-}-{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Word32 -> SummaryWork Word32 -> SummaryWork Word32 #-}+{-# SPECIALIZE initSummaryNumBounded :: SampleOffset -> SummaryWork Word32 #-}+{-# SPECIALIZE mkSummaryNum :: SampleOffsetDiff -> SummaryWork Word32 -> SummaryData Word32 #-}+{-# SPECIALIZE appendSummaryNum :: SampleOffsetDiff -> SummaryData Word32 -> SampleOffsetDiff -> SummaryData Word32 -> SummaryData Word32 #-}+{-# SPECIALIZE updateSummaryNum :: SampleOffset -> Word32 -> SummaryWork Word32 -> SummaryWork Word32 #-} #endif  ----------------------------------------------------------------------@@ -491,12 +503,15 @@ instance ZoomWrite Word64 where     write = writeData -instance ZoomWrite (TimeStamp, Word64) where+instance ZoomWrite (SampleOffset, Word64) where     write = writeDataVBR +instance ZoomWrite (TimeStamp, Word64) where+    write = writeDataTS+ instance ZoomWritable Word64 where     data SummaryWork Word64 = SummaryWorkWord64-        { swWord64Time  :: {-# UNPACK #-}!TimeStamp+        { swWord64Time  :: {-# UNPACK #-}!SampleOffset         , swWord64Entry :: !(Maybe Word64)         , swWord64Exit  :: {-# UNPACK #-}!Word64         , swWord64Min   :: {-# UNPACK #-}!Word64@@ -521,7 +536,7 @@     numAvg = summaryWord64Avg     numRMS = summaryWord64RMS -    numWorkTime = swWord64Time+    numWorkSO = swWord64Time     numWorkEntry = swWord64Entry     numWorkExit = swWord64Exit     numWorkMin = swWord64Min@@ -534,10 +549,10 @@  #if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE fromSummaryNum :: SummaryData Word64 -> Builder #-}-{-# SPECIALIZE initSummaryNumBounded :: TimeStamp -> SummaryWork Word64 #-}-{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Word64 -> SummaryData Word64 #-}-{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Word64 -> TimeStampDiff -> SummaryData Word64 -> SummaryData Word64 #-}-{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Word64 -> SummaryWork Word64 -> SummaryWork Word64 #-}+{-# SPECIALIZE initSummaryNumBounded :: SampleOffset -> SummaryWork Word64 #-}+{-# SPECIALIZE mkSummaryNum :: SampleOffsetDiff -> SummaryWork Word64 -> SummaryData Word64 #-}+{-# SPECIALIZE appendSummaryNum :: SampleOffsetDiff -> SummaryData Word64 -> SampleOffsetDiff -> SummaryData Word64 -> SummaryData Word64 #-}+{-# SPECIALIZE updateSummaryNum :: SampleOffset -> Word64 -> SummaryWork Word64 -> SummaryWork Word64 #-} #endif  ----------------------------------------------------------------------

@@ -16,8 +16,8 @@ module Data.ZoomCache.Pretty (       prettyGlobal     , prettyTrackSpec-    , prettyTimeStamp-    , prettySummary+    , prettySampleOffset+    , prettySummarySO ) where  import qualified Data.ByteString.Char8 as C@@ -48,7 +48,7 @@     , "\tName:\t" ++ C.unpack specName     , "\tType:\t" ++ show specType     , "\tEnc:\t"  ++ unwords [encoding, compression]-    , "\tRate:\t" ++ show specDRType ++ " " ++ ratShow specRate+    , "\tRate:\t" ++ show specSRType ++ " " ++ ratShow specRate     ]     where         encoding | specDeltaEncode = "Delta"@@ -56,9 +56,9 @@         compression | specZlibCompress = "Zlib"                     | otherwise        = "Uncompressed" --- | Pretty-print a 'TimeStamp', given a datarate-prettyTimeStamp :: Rational -> TimeStamp -> String-prettyTimeStamp r (TS t)+-- | Pretty-print a 'SampleOffset', given a datarate+prettySampleOffset :: Rational -> SampleOffset -> String+prettySampleOffset r (SO t)     | d == 0    = "00:00:00.000"     {-     | d < 100   = printf "%02d:%02d:%02d::%02d" hrs minN secN framesN@@ -72,22 +72,22 @@           (minT, secN) = quotRem secT 60           (hrs, minN) = quotRem minT 60 --- | Pretty-print a 'Summary', given a datarate-prettySummary :: ZoomReadable a => Rational -> Summary a -> String-prettySummary r s = concat-    [ prettySummaryTimes r s-    , prettySummaryLevel s-    , prettySummaryData (summaryData s)+-- | Pretty-print a 'SummarySO', given a datarate+prettySummarySO :: ZoomReadable a => Rational -> SummarySO a -> String+prettySummarySO r s = concat+    [ prettySummarySOTimes r s+    , prettySummarySOLevel s+    , prettySummaryData (summarySOData s)     ] -prettySummaryTimes :: Rational -> Summary a -> String-prettySummaryTimes r s = concat-    [ "[", (prettyTimeStamp r $ summaryEntryTime s)-    , "-", (prettyTimeStamp r $ summaryExitTime s), "] "+prettySummarySOTimes :: Rational -> SummarySO a -> String+prettySummarySOTimes r s = concat+    [ "[", (prettySampleOffset r $ summarySOEntry s)+    , "-", (prettySampleOffset r $ summarySOExit s), "] "     ] -prettySummaryLevel :: Summary a -> String-prettySummaryLevel s = printf "lvl: %d" (summaryLevel s)+prettySummarySOLevel :: SummarySO a -> String+prettySummarySOLevel s = printf "lvl: %d" (summarySOLevel s)  ---------------------------------------------------------------------- 

@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-}@@ -26,21 +27,30 @@     , IdentifyCodec      -- * Classes+    , Timestampable(..)+    , before+     , ZoomReadable(..)     , ZoomWritable(..)      , ZoomRaw(..)      , ZoomSummary(..)+    , ZoomSummarySO(..)      , ZoomWork(..)      -- * Types     , Packet(..)+    , packetFromPacketSO     , Summary(..)+    , summaryFromSummarySO++    , PacketSO(..)+    , SummarySO(..)     , SummaryData() -    , summaryDuration+    , summarySODuration      -- * CacheFile     , CacheFile(..)@@ -56,6 +66,7 @@ import Data.IntMap (IntMap) import qualified Data.IntMap as IM import Data.Iteratee (Iteratee)+import Data.Maybe (fromJust)  import Data.ZoomCache.Common @@ -68,7 +79,7 @@     { specType         :: !Codec     , specDeltaEncode  :: !Bool     , specZlibCompress :: !Bool-    , specDRType       :: !DataRateType+    , specSRType       :: !SampleRateType     , specRate         :: {-# UNPACK #-}!Rational     , specName         :: !ByteString     }@@ -111,30 +122,94 @@  ------------------------------------------------------------ +class Timestampable a where+    timestamp :: a -> Maybe TimeStamp++before :: (Timestampable a) => Maybe TimeStamp -> a -> Bool+before Nothing _ = True+before (Just b) x = t == Nothing || (fromJust t) <= b+  where+    t = timestamp x++instance Timestampable (TimeStamp, a) where+    timestamp = Just . fst++instance Timestampable a => Timestampable [a] where+    timestamp []    = Nothing+    timestamp (x:_) = timestamp x++------------------------------------------------------------++data PacketSO = PacketSO+    { packetSOTrack         :: {-# UNPACK #-}!TrackNo+    , packetSOEntry         :: {-# UNPACK #-}!SampleOffset+    , packetSOExit          :: {-# UNPACK #-}!SampleOffset+    , packetSOCount         :: {-# UNPACK #-}!Int+    , packetSOData          :: !ZoomRaw+    , packetSOSampleOffsets :: ![SampleOffset]+    }+ data Packet = Packet     { packetTrack      :: {-# UNPACK #-}!TrackNo-    , packetEntryTime  :: {-# UNPACK #-}!TimeStamp-    , packetExitTime   :: {-# UNPACK #-}!TimeStamp+    , packetEntry      :: {-# UNPACK #-}!TimeStamp+    , packetExit       :: {-# UNPACK #-}!TimeStamp     , packetCount      :: {-# UNPACK #-}!Int     , packetData       :: !ZoomRaw     , packetTimeStamps :: ![TimeStamp]     } +packetFromPacketSO :: Rational -> PacketSO -> Packet+packetFromPacketSO r PacketSO{..} = Packet {+      packetTrack = packetSOTrack+    , packetEntry = timeStampFromSO r packetSOEntry+    , packetExit  = timeStampFromSO r packetSOExit+    , packetCount = packetSOCount+    , packetData  = packetSOData+    , packetTimeStamps = map (timeStampFromSO r) packetSOSampleOffsets+    }++instance Timestampable Packet where+    timestamp = Just . packetEntry+ ------------------------------------------------------------ -- | A recorded block of summary data-data Summary a = Summary-    { summaryTrack     :: {-# UNPACK #-}!TrackNo-    , summaryLevel     :: {-# UNPACK #-}!Int-    , summaryEntryTime :: {-# UNPACK #-}!TimeStamp-    , summaryExitTime  :: {-# UNPACK #-}!TimeStamp-    , summaryData      :: !(SummaryData a)+data SummarySO a = SummarySO+    { summarySOTrack :: {-# UNPACK #-}!TrackNo+    , summarySOLevel :: {-# UNPACK #-}!Int+    , summarySOEntry :: {-# UNPACK #-}!SampleOffset+    , summarySOExit  :: {-# UNPACK #-}!SampleOffset+    , summarySOData  :: !(SummaryData a)     }     deriving (Typeable)  -- | The duration covered by a summary, in units of 1 / the track's datarate-summaryDuration :: Summary a -> TimeStampDiff-summaryDuration s = TSDiff $ (unTS $ summaryExitTime s) - (unTS $ summaryEntryTime s)+summarySODuration :: SummarySO a -> SampleOffsetDiff+summarySODuration s = SODiff $ (unSO $ summarySOExit s) - (unSO $ summarySOEntry s) ++-- | A summary block with samplecounts converted to TimeStamp+data Summary a = Summary+    { summaryTrack :: {-# UNPACK #-}!TrackNo+    , summaryLevel :: {-# UNPACK #-}!Int+    , summaryEntry :: {-# UNPACK #-}!TimeStamp+    , summaryExit  :: {-# UNPACK #-}!TimeStamp+    , summaryData  :: !(SummaryData a)+    }+    deriving (Typeable)++-- | Convert a SummarySo to a Summary, given a samplerate+summaryFromSummarySO :: Rational -> SummarySO a -> Summary a+summaryFromSummarySO r SummarySO{..} = Summary {+      summaryTrack = summarySOTrack+    , summaryLevel = summarySOLevel+    , summaryEntry = timeStampFromSO r summarySOEntry+    , summaryExit  = timeStampFromSO r summarySOExit+    , summaryData  = summarySOData+    } ++instance Timestampable (Summary a) where+    timestamp = Just . summaryEntry+ ------------------------------------------------------------ -- Read @@ -173,8 +248,13 @@  data ZoomRaw = forall a . ZoomReadable a => ZoomRaw [a] +data ZoomSummarySO = forall a . ZoomReadable a => ZoomSummarySO (SummarySO a)+ data ZoomSummary = forall a . ZoomReadable a => ZoomSummary (Summary a) +instance Timestampable ZoomSummary where+    timestamp (ZoomSummary s) = timestamp s+ ------------------------------------------------------------ -- Write @@ -190,20 +270,20 @@     fromSummaryData    :: SummaryData a -> Builder      -- | Generate a new 'SummaryWork a', given an initial timestamp.-    initSummaryWork    :: TimeStamp -> SummaryWork a+    initSummaryWork    :: SampleOffset -> SummaryWork a      -- | Update a 'SummaryData' with the value of 'a' occuring at the-    -- given 'TimeStamp'.-    updateSummaryData  :: TimeStamp -> a+    -- given 'SampleOffset'.+    updateSummaryData  :: SampleOffset -> a                        -> SummaryWork a                        -> SummaryWork a      -- | Finalize a 'SummaryWork a', generating a 'SummaryData a'.-    toSummaryData      :: TimeStampDiff -> SummaryWork a -> SummaryData a+    toSummaryData      :: SampleOffsetDiff -> SummaryWork a -> SummaryData a      -- | Append two 'SummaryData'-    appendSummaryData  :: TimeStampDiff -> SummaryData a-                       -> TimeStampDiff -> SummaryData a+    appendSummaryData  :: SampleOffsetDiff -> SummaryData a+                       -> SampleOffsetDiff -> SummaryData a                        -> SummaryData a      -- | Delta-encode a value.@@ -211,6 +291,6 @@     deltaEncodeRaw _ = id  data ZoomWork = forall a . (Typeable a, ZoomWritable a) => ZoomWork-    { levels   :: IntMap (Summary a)+    { levels   :: IntMap (SummarySO a)     , currWork :: Maybe (SummaryWork a)     }

@@ -17,7 +17,7 @@  Default codec implementation for values of type (). Elements of type () are useful for marking events, and variable rate tracks written with-type (TimeStamp, ()) are useful for recording times of events.+type (SampleOffset, ()) are useful for recording times of events.  This module implements the interfaces documented in "Data.ZoomCache.Codec". @@ -102,9 +102,12 @@ instance ZoomWrite () where     write = writeData -instance ZoomWrite (TimeStamp, ()) where+instance ZoomWrite (SampleOffset, ()) where     write = writeDataVBR +instance ZoomWrite (TimeStamp, ()) where+    write = writeDataTS+ instance ZoomWritable () where     data SummaryWork () = SummaryWorkUnit         { swUnitCount :: {-# UNPACK #-}!Int@@ -118,12 +121,12 @@     updateSummaryData = updateSummaryUnit     appendSummaryData = appendSummaryUnit -initSummaryUnit :: TimeStamp -> SummaryWork ()+initSummaryUnit :: SampleOffset -> SummaryWork () initSummaryUnit _ = SummaryWorkUnit     { swUnitCount = 0     } -mkSummaryUnit :: TimeStampDiff -> SummaryWork () -> SummaryData ()+mkSummaryUnit :: SampleOffsetDiff -> SummaryWork () -> SummaryData () mkSummaryUnit _dur SummaryWorkUnit{..} = SummaryUnit     { summaryUnitCount = swUnitCount     }@@ -133,14 +136,14 @@     [ summaryUnitCount     ] -updateSummaryUnit :: TimeStamp  -> () -> SummaryWork ()+updateSummaryUnit :: SampleOffset  -> () -> SummaryWork ()                  -> SummaryWork () updateSummaryUnit _t _ SummaryWorkUnit{..} = SummaryWorkUnit     { swUnitCount = swUnitCount + 1     } -appendSummaryUnit :: TimeStampDiff -> SummaryData ()-                  -> TimeStampDiff -> SummaryData ()+appendSummaryUnit :: SampleOffsetDiff -> SummaryData ()+                  -> SampleOffsetDiff -> SummaryData ()                   -> SummaryData () appendSummaryUnit _dur1 s1 _dur2 s2 = SummaryUnit     { summaryUnitCount = summaryUnitCount s1 + summaryUnitCount s2

@@ -25,6 +25,7 @@     -- * Instance helpers     , writeData     , writeDataVBR+    , writeDataTS      -- * The ZoomW monad     , ZoomW@@ -89,12 +90,12 @@ data TrackWork = TrackWork     { twSpec      :: TrackSpec     , twBuilder   :: Builder-    , twReverseTS :: [TimeStamp]+    , twReverseSO :: [SampleOffset]     , twWriter    :: Maybe ZoomWork     , twCount     :: {-# UNPACK #-}!Int     , twWatermark :: {-# UNPACK #-}!Int-    , twEntryTime :: {-# UNPACK #-}!TimeStamp-    , twExitTime  :: {-# UNPACK #-}!TimeStamp+    , twEntryTime :: {-# UNPACK #-}!SampleOffset+    , twExitTime  :: {-# UNPACK #-}!SampleOffset     }  ----------------------------------------------------------------------@@ -120,7 +121,7 @@ -- necessary to call this function as summary blocks are transparently written -- at regular intervals. flush :: ZoomW ()-flush = diskTracks flushSummary+flush = diskTracks flushSummarySO  -- | Write final, whole-file summary blocks. --@@ -131,16 +132,16 @@ -- the entire range of the file, and this will be the last summary block -- in the track. finish :: ZoomW ()-finish = diskTracks finishSummary+finish = diskTracks finishSummarySO  diskTracks :: (TrackNo -> TrackWork -> ZoomW ()) -> ZoomW ()-diskTracks fSummary = do+diskTracks fSummarySO = do     h <- gets whHandle     tracks <- gets whTrackWork     doRaw <- gets whWriteData     when doRaw $         liftIO $ Fold.mapM_ (L.hPut h) $ IM.mapWithKey bsFromTrack tracks-    mapM_ (uncurry fSummary) (IM.assocs tracks)+    mapM_ (uncurry fSummarySO) (IM.assocs tracks)     pending <- mconcat . IM.elems <$> gets whDeferred     liftIO . B.hPut h . toByteString $ pending     modify $ \z -> z@@ -172,18 +173,18 @@                  -> IntMap TrackWork         addTrack trackNo spec = IM.insert trackNo trackState             where-                trackState = mkTrackWork spec (TS 0) 1024+                trackState = mkTrackWork spec (SO 0) 1024  closeWrite :: ZoomWHandle -> IO () closeWrite z = hClose (whHandle z)  -- | Create a track map for a stream of a given type, as track no. 1-oneTrack :: (ZoomReadable a) => a -> Bool -> Bool -> DataRateType -> Rational -> ByteString -> TrackMap+oneTrack :: (ZoomReadable a) => a -> Bool -> Bool -> SampleRateType -> Rational -> ByteString -> TrackMap oneTrack a delta zlib !drType !rate !name = IM.singleton 1 (mkTrackSpec a delta zlib drType rate name) {-# INLINABLE oneTrack #-}  mkTrackSpec :: (ZoomReadable a)-            => a -> Bool -> Bool -> DataRateType -> Rational -> ByteString -> TrackSpec+            => a -> Bool -> Bool -> SampleRateType -> Rational -> ByteString -> TrackSpec mkTrackSpec a = TrackSpec (Codec a)  -- | Query the maximum number of data points to buffer for a given track before@@ -216,29 +217,32 @@         [ trackHeader         , toByteString $ mconcat             [ fromTrackNo trackNo-            , fromCodec specType-            , fromFlags specDeltaEncode specZlibCompress specDRType+            , fromFlags specDeltaEncode specZlibCompress specSRType             , fromRational64 specRate-            , fromIntegral32be . C.length $ specName+            , fromIntegral32be . C.length $ ident             ]+        , ident+        , toByteString . fromIntegral32be . C.length $ specName         , specName         ]+    where+        ident = toByteString $ fromCodec specType  ---------------------------------------------------------------------- -- Data -incTimeStamp :: TimeStamp -> TimeStamp-incTimeStamp (TS t) = let t' = (t+1) in t' `seq` (TS t')+incSampleOffset :: SampleOffset -> SampleOffset+incSampleOffset (SO t) = let t' = (t+1) in t' `seq` (SO t')  incTime :: TrackNo -> ZoomW () incTime trackNo = modifyTrack trackNo $ \tw -> tw     { twEntryTime = if twCount tw == 0-                        then (incTimeStamp (twEntryTime tw))+                        then (incSampleOffset (twEntryTime tw))                         else twEntryTime tw-    , twExitTime = incTimeStamp (twExitTime tw)+    , twExitTime = incSampleOffset (twExitTime tw)     } -setTime :: TrackNo -> TimeStamp -> ZoomW ()+setTime :: TrackNo -> SampleOffset -> ZoomW () setTime trackNo t = modifyTrack trackNo $ \tw -> tw     { twEntryTime = if twCount tw == 0 then t else twEntryTime tw     , twExitTime = t@@ -273,7 +277,7 @@     flushIfNeeded trackNo  writeDataVBR :: (Typeable a, ZoomWrite a, ZoomWritable a)-             => TrackNo -> (TimeStamp, a) -> ZoomW ()+             => TrackNo -> (SampleOffset, a) -> ZoomW () writeDataVBR trackNo (t, d) = do     setTime trackNo t @@ -282,7 +286,7 @@         modifyTrack trackNo $ \z -> z             { twBuilder = twBuilder z <>                   (deltaEncodeWork (specDeltaEncode . twSpec $ z) (twWriter z) d)-            , twReverseTS = t : twReverseTS z+            , twReverseSO = t : twReverseSO z             }      modifyTrack trackNo $ \z -> let c = (twCount z) in c `seq` z@@ -291,6 +295,16 @@         }     flushIfNeeded trackNo +writeDataTS :: (Typeable a, ZoomWrite a, ZoomWritable a)+            => TrackNo -> (TimeStamp, a) -> ZoomW ()+writeDataTS trackNo (TS ts, d) = do+    tw <- IM.lookup trackNo <$> gets whTrackWork+    case tw of+        Just TrackWork{..} -> do+            let so = floor (ts * fromRational (specRate twSpec))+            writeDataVBR trackNo (SO so, d)+        _ -> return ()+ deltaEncodeWork :: (Typeable a, ZoomWritable a)                 => Bool -> Maybe ZoomWork -> a -> Builder deltaEncodeWork False _                             d = fromRaw d@@ -326,8 +340,8 @@     [ L.pack . B.unpack $ packetHeader     , toLazyByteString $ mconcat         [ fromIntegral32be trackNo-        , fromTimeStamp twEntryTime-        , fromTimeStamp twExitTime+        , fromSampleOffset twEntryTime+        , fromSampleOffset twExitTime         , fromIntegral32be twCount         , fromIntegral32be (L.length rawBS)         ]@@ -335,16 +349,16 @@     ]     where         tsBuilder = mconcat . map fromInt64be .-                    deltaEncode . map unTS .  reverse $ twReverseTS+                    deltaEncode . map unSO .  reverse $ twReverseSO         rawBS = c $ toLazyByteString (twBuilder <> tsBuilder)         c | specZlibCompress twSpec = compress           | otherwise               = id -mkTrackWork :: TrackSpec -> TimeStamp -> Int -> TrackWork+mkTrackWork :: TrackSpec -> SampleOffset -> Int -> TrackWork mkTrackWork !spec !entry !w = TrackWork         { twSpec = spec         , twBuilder = mempty-        , twReverseTS = []+        , twReverseSO = []         , twCount = 0         , twWatermark = w         , twEntryTime = entry@@ -359,7 +373,7 @@ clearWork (ZoomWork l _) = ZoomWork l Nothing  updateWork :: (Typeable b, ZoomWritable b)-           => TimeStamp -> b+           => SampleOffset -> b            -> Maybe ZoomWork            -> Maybe ZoomWork @@ -386,18 +400,18 @@             Nothing -> Nothing  ------------------------------------------------------------------------- Summary+-- SummarySO -flushSummary :: TrackNo -> TrackWork -> ZoomW ()-flushSummary trackNo tw@TrackWork{..} =-    diskSummary (flushWork twEntryTime twExitTime) trackNo tw+flushSummarySO :: TrackNo -> TrackWork -> ZoomW ()+flushSummarySO trackNo tw@TrackWork{..} =+    diskSummarySO (flushWork twEntryTime twExitTime) trackNo tw -finishSummary :: TrackNo -> TrackWork -> ZoomW ()-finishSummary = diskSummary finishWork+finishSummarySO :: TrackNo -> TrackWork -> ZoomW ()+finishSummarySO = diskSummarySO finishWork -diskSummary :: (TrackNo -> ZoomWork -> (ZoomWork, IntMap Builder))+diskSummarySO :: (TrackNo -> ZoomWork -> (ZoomWork, IntMap Builder))             -> TrackNo -> TrackWork -> ZoomW ()-diskSummary fWork trackNo TrackWork{..} = case twWriter of+diskSummarySO fWork trackNo TrackWork{..} = case twWriter of     Just writer -> do         let (writer', bs) = fWork trackNo writer         modify $ \z -> z { whDeferred = IM.unionWith mappend (whDeferred z) bs }@@ -443,67 +457,67 @@ -- and this should be the last summary block in the track (as summary blocks -- are written in order of level) finishLevels :: (Typeable a, ZoomWritable a)-             => IntMap (Summary a) -> IntMap Builder+             => IntMap (SummarySO a) -> IntMap Builder finishLevels l = snd $ foldl' propagate (Nothing, IM.empty) [1 .. fst $ IM.findMax l]     where         propagate (Nothing, bs) k = case IM.lookup k l of             Nothing    -> -- Nothing propagated, nothing saved                 (Nothing, bs)             Just saved -> -- Nothing propagated, saved to flush: propagate saved-                (Just (incLevel saved), IM.insert k (fromSummary saved) bs)+                (Just (incLevel saved), IM.insert k (fromSummarySO saved) bs)         propagate (Just bub, bs) k = case IM.lookup k l of             Nothing    -> -- Something propagated to flush, nothing saved-                (Just (incLevel bub), IM.insert k (fromSummary bub) bs)+                (Just (incLevel bub), IM.insert k (fromSummarySO bub) bs)             Just saved -> -- Something propagated, something saved;                           -- append these, flush and propagate-                let new = saved `appendSummary` bub in-                (Just (incLevel new), IM.insert k (fromSummary new) bs)+                let new = saved `appendSummarySO` bub in+                (Just (incLevel new), IM.insert k (fromSummarySO new) bs) -flushWork :: TimeStamp -> TimeStamp+flushWork :: SampleOffset -> SampleOffset           -> TrackNo -> ZoomWork -> (ZoomWork, IntMap Builder) flushWork _         _        _       op@(ZoomWork _ Nothing) = (op, IM.empty)-flushWork entryTime exitTime trackNo (ZoomWork l (Just cw))  =+flushWork entrySO exitSO trackNo (ZoomWork l (Just cw))  =     (ZoomWork l' (Just cw), bs)     where-        (bs, l') = pushSummary s IM.empty l-        s = Summary-            { summaryTrack = trackNo-            , summaryLevel = 1-            , summaryEntryTime = entryTime-            , summaryExitTime = exitTime-            , summaryData = toSummaryData dur cw+        (bs, l') = pushSummarySO s IM.empty l+        s = SummarySO+            { summarySOTrack = trackNo+            , summarySOLevel = 1+            , summarySOEntry = entrySO+            , summarySOExit = exitSO+            , summarySOData = toSummaryData dur cw             }-        dur = TSDiff $ (unTS exitTime) - (unTS entryTime)+        dur = sampleOffsetDiff exitSO entrySO -pushSummary :: (ZoomWritable a)-            => Summary a-            -> IntMap Builder -> IntMap (Summary a)-            -> (IntMap Builder, IntMap (Summary a))-pushSummary s bs l = do-    case IM.lookup (summaryLevel s) l of-        Just saved -> pushSummary (saved `appendSummary` s) bs' cleared+pushSummarySO :: (ZoomWritable a)+            => SummarySO a+            -> IntMap Builder -> IntMap (SummarySO a)+            -> (IntMap Builder, IntMap (SummarySO a))+pushSummarySO s bs l = do+    case IM.lookup (summarySOLevel s) l of+        Just saved -> pushSummarySO (saved `appendSummarySO` s) bs' cleared         Nothing    -> (bs', inserted)     where-        bs' = IM.insert (summaryLevel s) (fromSummary s) bs-        inserted = IM.insert (summaryLevel s) (incLevel s) l-        cleared = IM.delete (summaryLevel s) l+        bs' = IM.insert (summarySOLevel s) (fromSummarySO s) bs+        inserted = IM.insert (summarySOLevel s) (incLevel s) l+        cleared = IM.delete (summarySOLevel s) l -incLevel :: Summary a -> Summary a-incLevel s =  s { summaryLevel = summaryLevel s + 1 }+incLevel :: SummarySO a -> SummarySO a+incLevel s =  s { summarySOLevel = summarySOLevel s + 1 }  -- | 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)+appendSummarySO :: (ZoomWritable a) => SummarySO a -> SummarySO a -> SummarySO a+appendSummarySO s1 s2 = SummarySO+    { summarySOTrack = summarySOTrack s1+    , summarySOLevel = summarySOLevel s1+    , summarySOEntry = summarySOEntry s1+    , summarySOExit = summarySOExit s2+    , summarySOData = appendSummaryData (dur s1) (summarySOData s1)+                                        (dur s2) (summarySOData s2)     }     where-        dur = summaryDuration+        dur = summarySODuration  ------------------------------------------------------------ 

@@ -6,9 +6,11 @@ import Data.Functor.Identity import Data.Int import qualified Data.Iteratee as I+import Data.TypeLevel.Num hiding ((==)) import Data.Word import Data.ZoomCache import Data.ZoomCache.Codec+import Data.ZoomCache.NList  import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty)@@ -71,6 +73,9 @@ roundTripDouble :: Double -> Bool roundTripDouble = roundTrip +roundTripNListD7Double :: NList D7 Double -> Bool+roundTripNListD7Double = roundTrip+ ---------------------------------------------------------------------- -- * Delta encoding roundtrips @@ -121,6 +126,7 @@       , testProperty "Integer" roundTripInteger       , testProperty "Float" roundTripFloat       , testProperty "Double" roundTripDouble+      , testProperty "NList D7 Double" roundTripNListD7Double       ]     , testGroup "Delta Encoding"       [ testProperty "Int" deltaEncDecInt

@@ -17,6 +17,7 @@  import Data.ZoomCache import Data.ZoomCache.Dump+import Data.ZoomCache.Multichannel  ------------------------------------------------------------ @@ -28,6 +29,7 @@     , intData  :: Bool     , label    :: ByteString     , rate     :: Integer+    , channels :: Int     , wmLevel  :: Int     , track    :: TrackNo     }@@ -44,6 +46,7 @@     , intData  = False     , label    = "gen"     , rate     = 1000+    , channels = 1     , wmLevel  = 1024     , track    = 1     }@@ -55,6 +58,7 @@             | IntData             | Label String             | Rate String+            | Channels String             | Watermark String             | Track String     deriving (Eq)@@ -78,7 +82,9 @@              "Set track label"     , Option ['r'] ["rate"] (ReqArg Rate "data-rate")              "Set track rate"-    , Option ['w'] ["watermark"] (ReqArg Rate "watermark")+    , Option ['c'] ["channels"] (ReqArg Channels "channels")+             "Set number of channels"+    , Option ['w'] ["watermark"] (ReqArg Watermark "watermark")              "Set high-watermark level"     , Option ['t'] ["track"] (ReqArg Track "trackNo")              "Set or select track number"@@ -109,6 +115,8 @@             return $ config {label = C.pack s}         processOneOption config (Rate s) = do             return $ config {rate = read s}+        processOneOption config (Channels s) = do+            return $ config {channels = read s}         processOneOption config (Watermark s) = do             return $ config {wmLevel = read s}         processOneOption config (Track s) = do@@ -136,15 +144,21 @@     | intData   = w ints path     | otherwise = w doubles path     where-    w :: (ZoomReadable a, ZoomWrite a, ZoomWrite (TimeStamp, a))+    w :: (ZoomReadable a, ZoomWrite a, ZoomWritable a, ZoomWrite (SampleOffset, a))       => [a] -> FilePath -> IO ()     w d-        | variable  = withFileWrite (oneTrack (head d) delta zlib VariableDR rate' label)+        | variable && channels == 1 = withFileWrite (oneTrack (head d) delta zlib VariableSR rate' label)                           (not noRaw)-                          (sW >> mapM_ (write track) (zip (map TS [1,3..]) d))-        | otherwise = withFileWrite (oneTrack (head d) delta zlib ConstantDR rate' label)+                          (sW >> mapM_ (write track) (zip (map SO [1,3..]) d))+        | channels == 1 = withFileWrite (oneTrack (head d) delta zlib ConstantSR rate' label)                           (not noRaw)                           (sW >> mapM_ (write track) d)+        | variable  = withFileWrite (oneTrackMultichannel channels (head d) delta zlib VariableSR rate' label)+                          (not noRaw)+                          (sW >> mapM_ (write track) (zip (map SO [1,3..]) (map (replicate channels) d)))+        | otherwise = withFileWrite (oneTrackMultichannel channels (head d) delta zlib ConstantSR rate' label)+                          (not noRaw)+                          (sW >> mapM_ (write track) (map (replicate channels) d))     rate' = fromInteger rate     sW = setWatermark 1 wmLevel 

@@ -3,7 +3,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version:             0.8.1.0+Version:             0.9.0.0  Synopsis:            A streamable, seekable, zoomable cache file format @@ -85,7 +85,9 @@     ListLike                  >= 1.0     && < 4,     MonadCatchIO-transformers >  0.2     && < 0.3,     mtl                       >= 2.0.0.0 && < 3,+    QuickCheck                 >= 2.4.0.1,     transformers              >= 0.2     && < 0.3,+    type-level,     zlib    Exposed-modules:@@ -99,6 +101,12 @@     Data.ZoomCache.Dump     Data.ZoomCache.Format     Data.ZoomCache.Identify+    Data.ZoomCache.Multichannel+    Data.ZoomCache.Multichannel.Common+    Data.ZoomCache.Multichannel.Internal+    Data.ZoomCache.Multichannel.List+    Data.ZoomCache.Multichannel.NList+    Data.ZoomCache.NList     Data.ZoomCache.Numeric     Data.ZoomCache.Numeric.Delta     Data.ZoomCache.Numeric.FloatMinMax@@ -128,7 +136,9 @@     iteratee-compress,     ListLike                  >= 1.0     && < 4,     mtl                       >= 2.0.0.0 && < 3,+    QuickCheck                 >= 2.4.0.1,     transformers              >= 0.2     && < 0.3,+    type-level,     ui-command,     zlib @@ -145,6 +155,7 @@     QuickCheck                 >= 2.4.0.1,     random                     == 1.0.*,     transformers               >= 0.2     && < 0.3,+    type-level,     zoom-cache