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 +14/−0
- Data/ZoomCache/Codec.hs +1/−0
- Data/ZoomCache/Numeric.hs +14/−0
- Data/ZoomCache/Numeric/IEEE754.hs +9/−0
- Data/ZoomCache/Numeric/Int.hs +25/−0
- Data/ZoomCache/Numeric/Word.hs +21/−0
- Data/ZoomCache/Types.hs +1/−1
- Data/ZoomCache/Write.hs +95/−15
- zoom-cache.cabal +1/−1
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