packages feed

zoom-cache 0.8.0.0 → 0.8.1.0

raw patch · 9 files changed

+181/−17 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

+ Data.Iteratee.ZoomCache: wholeTrackSummary :: (Functor m, MonadIO m) => [IdentifyCodec] -> TrackNo -> Iteratee ByteString m (TrackSpec, ZoomSummary)
+ Data.ZoomCache.Codec: type IdentifyCodec = ByteString -> Maybe Codec
+ Data.ZoomCache.Numeric: wholeTrackSummaryDouble :: (Functor m, MonadIO m) => [IdentifyCodec] -> TrackNo -> Iteratee ByteString m (Summary Double)
- Data.ZoomCache.Types: ZoomWork :: IntMap (Summary a -> Summary a) -> Maybe (SummaryWork a) -> ZoomWork
+ Data.ZoomCache.Types: ZoomWork :: IntMap (Summary a) -> Maybe (SummaryWork a) -> ZoomWork
- Data.ZoomCache.Types: levels :: ZoomWork -> IntMap (Summary a -> Summary a)
+ Data.ZoomCache.Types: levels :: ZoomWork -> IntMap (Summary a)

Files

Data/Iteratee/ZoomCache.hs view
@@ -43,6 +43,7 @@    -- * Reading zoom-cache files and ByteStrings   , enumCacheFile+  , wholeTrackSummary    , iterHeaders   , enumStream@@ -92,6 +93,19 @@         , strmTrack   :: TrackNo         , strmSummary :: ZoomSummary         }++----------------------------------------------------------------------++-- | Read the summary of an entire track.+wholeTrackSummary :: (Functor m, MonadIO m)+                  => [IdentifyCodec]+                  -> TrackNo+                  -> Iteratee ByteString m (TrackSpec, ZoomSummary)+wholeTrackSummary identifiers trackNo = I.joinI $ enumCacheFile identifiers .+    I.joinI . filterTracks [trackNo] .  I.joinI . enumCTS $ f <$> I.last+    where+        f :: (CacheFile, TrackNo, ZoomSummary) -> (TrackSpec, ZoomSummary)+        f (cf, _, zs) = (fromJust $ IM.lookup trackNo (cfSpecs cf), zs)  ---------------------------------------------------------------------- 
Data/ZoomCache/Codec.hs view
@@ -27,6 +27,7 @@     , ZoomWrite(..)      -- * Identification+    , IdentifyCodec     , identifyCodec      -- * Raw data reading iteratees
Data/ZoomCache/Numeric.hs view
@@ -25,6 +25,7 @@    , toSummaryDouble +  , wholeTrackSummaryDouble   , enumDouble   , enumSummaryDouble @@ -33,6 +34,7 @@  import Control.Applicative ((<$>)) import Control.Monad.Trans (MonadIO)+import Data.ByteString (ByteString) import Data.Int import qualified Data.Iteratee as I import Data.Maybe@@ -122,6 +124,18 @@     (numRMS s)  ----------------------------------------------------------------------++-- | Read the summary of an entire track.+wholeTrackSummaryDouble :: (Functor m, MonadIO m)+                        => [IdentifyCodec]+                        -> TrackNo+                        -> I.Iteratee ByteString m (Summary Double)+wholeTrackSummaryDouble identifiers trackNo = I.joinI $ enumCacheFile identifiers .+    I.joinI . filterTracks [trackNo] .  I.joinI . e $ I.last+    where+        e = I.joinI . enumSummaries . I.mapChunks (catMaybes . map toSD)+        toSD :: ZoomSummary -> Maybe (Summary Double)+        toSD (ZoomSummary s) = toSummaryDouble s  enumDouble :: (Functor m, MonadIO m)            => I.Enumeratee [Stream] [(TimeStamp, Double)] m a
Data/ZoomCache/Numeric/IEEE754.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-}@@ -114,7 +115,9 @@      deltaDecodeRaw    = deltaDecodeNum +#if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Float) #-}+#endif  instance ZoomWrite Float where     write = writeData@@ -160,10 +163,12 @@     numMkSummary = SummaryFloat     numMkSummaryWork = SummaryWorkFloat +#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 #-}+#endif  ---------------------------------------------------------------------- -- Double@@ -188,7 +193,9 @@      deltaDecodeRaw    = deltaDecodeNum +#if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Double) #-}+#endif  instance ZoomWrite Double where     write = writeData@@ -234,10 +241,12 @@     numMkSummary = SummaryDouble     numMkSummaryWork = SummaryWorkDouble +#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 #-}+#endif  ---------------------------------------------------------------------- 
Data/ZoomCache/Numeric/Int.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-}@@ -207,7 +208,9 @@      deltaDecodeRaw    = deltaDecodeNum +#if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Int) #-}+#endif  instance ZoomWrite Int where     write = writeData@@ -254,11 +257,13 @@     numMkSummary = SummaryInt     numMkSummaryWork = SummaryWorkInt +#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 #-}+#endif  ---------------------------------------------------------------------- -- Int8@@ -283,7 +288,9 @@      deltaDecodeRaw    = deltaDecodeNum +#if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Int8) #-}+#endif  instance ZoomWrite Int8 where     write = writeData@@ -330,11 +337,13 @@     numMkSummary = SummaryInt8     numMkSummaryWork = SummaryWorkInt8 +#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 #-}+#endif  ---------------------------------------------------------------------- -- Int16@@ -359,7 +368,9 @@      deltaDecodeRaw    = deltaDecodeNum +#if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Int16) #-}+#endif  instance ZoomWrite Int16 where     write = writeData@@ -406,11 +417,13 @@     numMkSummary = SummaryInt16     numMkSummaryWork = SummaryWorkInt16 +#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 #-}+#endif  ---------------------------------------------------------------------- -- Int32@@ -435,7 +448,9 @@      deltaDecodeRaw    = deltaDecodeNum +#if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Int32) #-}+#endif  instance ZoomWrite Int32 where     write = writeData@@ -482,11 +497,13 @@     numMkSummary = SummaryInt32     numMkSummaryWork = SummaryWorkInt32 +#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 #-}+#endif  ---------------------------------------------------------------------- -- Int64@@ -511,7 +528,9 @@      deltaDecodeRaw    = deltaDecodeNum +#if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Int64) #-}+#endif  instance ZoomWrite Int64 where     write = writeData@@ -558,11 +577,13 @@     numMkSummary = SummaryInt64     numMkSummaryWork = SummaryWorkInt64 +#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 #-}+#endif  ---------------------------------------------------------------------- -- Integer@@ -587,7 +608,9 @@      deltaDecodeRaw    = deltaDecodeNum +#if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Integer) #-}+#endif  instance ZoomWrite Integer where     write = writeData@@ -634,10 +657,12 @@     numMkSummary = SummaryInteger     numMkSummaryWork = error "numMkSummaryWork undefined for Integer" +#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 #-}+#endif  initSummaryInteger :: TimeStamp -> SummaryWork Integer initSummaryInteger entry = SummaryWorkInteger entry Nothing 0 Nothing Nothing 0.0 0.0
Data/ZoomCache/Numeric/Word.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-}@@ -175,7 +176,9 @@     prettyRaw         = show     prettySummaryData = prettySummaryWord +#if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Word) #-}+#endif  instance ZoomWrite Word where     write = writeData@@ -221,11 +224,13 @@     numMkSummary = SummaryWord     numMkSummaryWork = SummaryWorkWord +#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 #-}+#endif  ---------------------------------------------------------------------- -- Word8@@ -248,7 +253,9 @@     prettyRaw         = show     prettySummaryData = prettySummaryWord +#if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Word8) #-}+#endif  instance ZoomWrite Word8 where     write = writeData@@ -294,11 +301,13 @@     numMkSummary = SummaryWord8     numMkSummaryWork = SummaryWorkWord8 +#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 #-}+#endif  ---------------------------------------------------------------------- -- Word16@@ -321,7 +330,9 @@     prettyRaw         = show     prettySummaryData = prettySummaryWord +#if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Word16) #-}+#endif  instance ZoomWrite Word16 where     write = writeData@@ -367,11 +378,13 @@     numMkSummary = SummaryWord16     numMkSummaryWork = SummaryWorkWord16 +#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 #-}+#endif  ---------------------------------------------------------------------- -- Word32@@ -394,7 +407,9 @@     prettyRaw         = show     prettySummaryData = prettySummaryWord +#if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Word32) #-}+#endif  instance ZoomWrite Word32 where     write = writeData@@ -440,11 +455,13 @@     numMkSummary = SummaryWord32     numMkSummaryWork = SummaryWorkWord32 +#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 #-}+#endif  ---------------------------------------------------------------------- -- Word64@@ -467,7 +484,9 @@     prettyRaw         = show     prettySummaryData = prettySummaryWord +#if __GLASGOW_HASKELL__ >= 702 {-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Word64) #-}+#endif  instance ZoomWrite Word64 where     write = writeData@@ -513,11 +532,13 @@     numMkSummary = SummaryWord64     numMkSummaryWork = SummaryWorkWord64 +#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 #-}+#endif  ---------------------------------------------------------------------- 
Data/ZoomCache/Types.hs view
@@ -211,6 +211,6 @@     deltaEncodeRaw _ = id  data ZoomWork = forall a . (Typeable a, ZoomWritable a) => ZoomWork-    { levels   :: IntMap (Summary a -> Summary a)+    { levels   :: IntMap (Summary a)     , currWork :: Maybe (SummaryWork a)     }
Data/ZoomCache/Write.hs view
@@ -57,6 +57,7 @@ import qualified Data.Foldable as Fold import Data.IntMap (IntMap) import qualified Data.IntMap as IM+import Data.List (foldl') import Data.Monoid import System.IO @@ -112,20 +113,34 @@               -> IO () withFileWrite ztypes doRaw f path = do     z <- openWrite ztypes doRaw path-    z' <- execStateT (f >> flush) z+    z' <- execStateT (f >> flush >> finish) z     hClose (whHandle z')  -- | Force a flush of ZoomCache summary blocks to disk. It is not usually -- necessary to call this function as summary blocks are transparently written -- at regular intervals. flush :: ZoomW ()-flush = do+flush = diskTracks flushSummary++-- | Write final, whole-file summary blocks.+--+-- This function flushes saved summaries at all levels, to ensure that all+-- summary levels contain data for the entire time range of the track.+--+-- In particular, the highest level of summary will contain one block for+-- the entire range of the file, and this will be the last summary block+-- in the track.+finish :: ZoomW ()+finish = diskTracks finishSummary++diskTracks :: (TrackNo -> TrackWork -> ZoomW ()) -> ZoomW ()+diskTracks fSummary = do     h <- gets whHandle     tracks <- gets whTrackWork     doRaw <- gets whWriteData     when doRaw $         liftIO $ Fold.mapM_ (L.hPut h) $ IM.mapWithKey bsFromTrack tracks-    mapM_ (uncurry flushSummary) (IM.assocs tracks)+    mapM_ (uncurry fSummary) (IM.assocs tracks)     pending <- mconcat . IM.elems <$> gets whDeferred     liftIO . B.hPut h . toByteString $ pending     modify $ \z -> z@@ -374,17 +389,80 @@ -- Summary  flushSummary :: TrackNo -> TrackWork -> ZoomW ()-flushSummary trackNo TrackWork{..} = case twWriter of+flushSummary trackNo tw@TrackWork{..} =+    diskSummary (flushWork twEntryTime twExitTime) trackNo tw++finishSummary :: TrackNo -> TrackWork -> ZoomW ()+finishSummary = diskSummary finishWork++diskSummary :: (TrackNo -> ZoomWork -> (ZoomWork, IntMap Builder))+            -> TrackNo -> TrackWork -> ZoomW ()+diskSummary fWork trackNo TrackWork{..} = case twWriter of     Just writer -> do-        let (writer', bs) = flushWork trackNo twEntryTime twExitTime writer+        let (writer', bs) = fWork trackNo writer         modify $ \z -> z { whDeferred = IM.unionWith mappend (whDeferred z) bs }         modifyTrack trackNo (\ztt -> ztt { twWriter = Just writer' } )     _           -> return () -flushWork :: TrackNo -> TimeStamp -> TimeStamp-          -> ZoomWork -> (ZoomWork, IntMap Builder)-flushWork _       _         _        op@(ZoomWork _ Nothing) = (op, IM.empty)-flushWork trackNo entryTime exitTime (ZoomWork l (Just cw))  =+finishWork :: TrackNo -> ZoomWork -> (ZoomWork, IntMap Builder)+finishWork _trackNo (ZoomWork l cw) = (ZoomWork IM.empty cw, finishLevels l)++{-++When finishing the writing of a file, we want the final, highest-level+summary block to contain data for the entire range of the file:++   1:  [ ] [ ] [ ] [ ]+        \   /   \   /+   2:    [ ]     [ ]+          \_     _/+            \   /+   3:        [ ]++However this is not usually the case -- unless, by chance, exactly 2^n level 1+summary blocks have been written.++So, we traverse all saved summary levels, and flush a summary at each level. In+order to do so we force all saved summary data to be flushed, and push that+saved data up to higher levels. In this way the contents of the final level 1+summary block are bubbled through the tree and appended to all saved summary+blocks.++   1:  [ ] [ ] [x]+        \   /  |||  Block x is propagated to the next summary level,+   2:    [s]   [x]  where it is appended to saved block s.+          \_    |+            \   /+   3:        [ ]++-}++-- Flush saved summaries at all levels, to ensure that all summary levels+-- contain data for the entire time range. In particular, the highest level+-- of summary should contain one block for the entire range of the file,+-- 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+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)+        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 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)++flushWork :: TimeStamp -> TimeStamp+          -> TrackNo -> ZoomWork -> (ZoomWork, IntMap Builder)+flushWork _         _        _       op@(ZoomWork _ Nothing) = (op, IM.empty)+flushWork entryTime exitTime trackNo (ZoomWork l (Just cw))  =     (ZoomWork l' (Just cw), bs)     where         (bs, l') = pushSummary s IM.empty l@@ -399,17 +477,19 @@  pushSummary :: (ZoomWritable a)             => Summary a-            -> IntMap Builder -> IntMap (Summary a -> Summary a)-            -> (IntMap Builder, IntMap (Summary 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 g  -> pushSummary (g s) bs' cleared-        Nothing -> (bs', inserted)+        Just saved -> pushSummary (saved `appendSummary` s) bs' cleared+        Nothing    -> (bs', inserted)     where         bs' = IM.insert (summaryLevel s) (fromSummary s) bs-        f next = (s `appendSummary` next) { summaryLevel = summaryLevel s + 1 }-        inserted = IM.insert (summaryLevel s) f l+        inserted = IM.insert (summaryLevel s) (incLevel s) l         cleared = IM.delete (summaryLevel s) l++incLevel :: Summary a -> Summary a+incLevel s =  s { summaryLevel = summaryLevel s + 1 }  -- | Append two Summaries, merging statistical summary data. -- XXX: summaries are only compatible if tracks and levels are equal
zoom-cache.cabal view
@@ -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.0.0+Version:             0.8.1.0  Synopsis:            A streamable, seekable, zoomable cache file format