diff --git a/Data/Iteratee/ZoomCache.hs b/Data/Iteratee/ZoomCache.hs --- a/Data/Iteratee/ZoomCache.hs +++ b/Data/Iteratee/ZoomCache.hs @@ -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) ---------------------------------------------------------------------- diff --git a/Data/ZoomCache/Codec.hs b/Data/ZoomCache/Codec.hs --- a/Data/ZoomCache/Codec.hs +++ b/Data/ZoomCache/Codec.hs @@ -27,6 +27,7 @@ , ZoomWrite(..) -- * Identification + , IdentifyCodec , identifyCodec -- * Raw data reading iteratees diff --git a/Data/ZoomCache/Numeric.hs b/Data/ZoomCache/Numeric.hs --- a/Data/ZoomCache/Numeric.hs +++ b/Data/ZoomCache/Numeric.hs @@ -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 diff --git a/Data/ZoomCache/Numeric/IEEE754.hs b/Data/ZoomCache/Numeric/IEEE754.hs --- a/Data/ZoomCache/Numeric/IEEE754.hs +++ b/Data/ZoomCache/Numeric/IEEE754.hs @@ -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 ---------------------------------------------------------------------- diff --git a/Data/ZoomCache/Numeric/Int.hs b/Data/ZoomCache/Numeric/Int.hs --- a/Data/ZoomCache/Numeric/Int.hs +++ b/Data/ZoomCache/Numeric/Int.hs @@ -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 diff --git a/Data/ZoomCache/Numeric/Word.hs b/Data/ZoomCache/Numeric/Word.hs --- a/Data/ZoomCache/Numeric/Word.hs +++ b/Data/ZoomCache/Numeric/Word.hs @@ -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 ---------------------------------------------------------------------- diff --git a/Data/ZoomCache/Types.hs b/Data/ZoomCache/Types.hs --- a/Data/ZoomCache/Types.hs +++ b/Data/ZoomCache/Types.hs @@ -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) } diff --git a/Data/ZoomCache/Write.hs b/Data/ZoomCache/Write.hs --- a/Data/ZoomCache/Write.hs +++ b/Data/ZoomCache/Write.hs @@ -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 diff --git a/zoom-cache.cabal b/zoom-cache.cabal --- a/zoom-cache.cabal +++ b/zoom-cache.cabal @@ -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