zoom-cache 0.9.1.0 → 1.0.0.0

raw patch · 14 files changed

+432/−114 lines, 14 filesdep +old-localedep +timePVP ok

version bump matches the API change (PVP)

Dependencies added: old-locale, time

API changes (from Hackage documentation)

Files

• Blaze/ByteString/Builder/ZoomCache/Internal.hs +13/−4
• Data/Iteratee/ZoomCache.hs +75/−15
• Data/Iteratee/ZoomCache/Utils.hs +8/−0
• Data/ZoomCache.hs +10/−0
• Data/ZoomCache/Common.hs +17/−4
• Data/ZoomCache/Format.hs +30/−21
• Data/ZoomCache/Multichannel/List.hs +75/−2
• Data/ZoomCache/Multichannel/NList.hs +9/−0
• Data/ZoomCache/Numeric.hs +67/−34
• Data/ZoomCache/Pretty.hs +5/−3
• Data/ZoomCache/Types.hs +87/−0
• Data/ZoomCache/Write.hs +10/−9
• tools/zoom-cache.hs +19/−19
• zoom-cache.cabal +7/−3

@@ -26,8 +26,8 @@ import Blaze.ByteString.Builder import Data.Bits import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as C import Data.Monoid+import Data.Time  import Blaze.ByteString.Builder.ZoomCache import Data.ZoomCache.Common@@ -53,11 +53,20 @@     , mconcat $         [ fromVersion version         , fromIntegral32be noTracks-        , fromRational64 presentationTime-        , fromRational64 baseTime+        , fromUTCBaseTime baseUTC         ]-    , fromByteString $ C.pack (replicate 20 '\0') -- UTCTime     ]++fromUTCBaseTime :: Maybe UTCTime -> Builder+fromUTCBaseTime Nothing = mconcat $ replicate 3 (fromIntegerVLC 0)+fromUTCBaseTime (Just UTCTime{..}) = mconcat . map fromIntegerVLC $+    [ toModifiedJulianDay utctDay+    , round . toRational . (pico *) $ utctDayTime+    , pico+    ]+    where+        pico :: forall a . Num a => a+        pico = 1000000000000  fromSummarySO :: ZoomWritable a => SummarySO a -> Builder fromSummarySO s@SummarySO{..} = mconcat [ fromSummarySOHeader s, l, d]

@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-}@@ -45,6 +46,7 @@   -- * Reading zoom-cache files and ByteStrings   , enumCacheFile   , wholeTrackSummary+  , wholeTrackSummaryUTC    , iterHeaders   , enumStream@@ -53,11 +55,15 @@    -- * Seeking   , seekTimeStamp+  , seekUTCTime    -- * Stream enumeratees   , enumPackets+  , enumPacketsUTC   , enumSummaryLevel   , enumSummaries+  , enumSummaryUTCLevel+  , enumSummariesUTC   , filterTracksByName   , filterTracks @@ -83,6 +89,8 @@ import qualified Data.Iteratee as I import Data.Iteratee.ZLib import Data.Maybe+import Data.Ratio+import Data.Time  import Data.Iteratee.ZoomCache.Utils import Data.ZoomCache.Common@@ -123,14 +131,25 @@         f ctso@(cf, _, _) = (fromJust $ IM.lookup trackNo (cfSpecs cf),                              summaryFromCTSO ctso) +-- | Read the summary of an entire track.+wholeTrackSummaryUTC :: (Functor m, MonadIO m)+                     => [IdentifyCodec]+                     -> TrackNo+                     -> Iteratee ByteString m (TrackSpec, Maybe ZoomSummaryUTC)+wholeTrackSummaryUTC identifiers trackNo = I.joinI $ enumCacheFile identifiers .+    I.joinI . filterTracks [trackNo] .  I.joinI . enumCTSO $ f <$> I.last+    where+        f :: (CacheFile, TrackNo, ZoomSummarySO) -> (TrackSpec, Maybe ZoomSummaryUTC)+        f ctso@(cf, _, _) = (fromJust $ IM.lookup trackNo (cfSpecs cf),+                             summaryUTCFromCTSO ctso) ----------------------------------------------------------------------  -- | Filter just the raw data-enumPackets :: (Functor m, MonadIO m)+enumPackets :: (Functor m, Monad m)             => I.Enumeratee [Stream] [Packet] m a enumPackets = I.joinI . enumCTPSO . I.mapChunks (map packetFromCTPSO) --- | Convert a CTSO triple into a ZoomSummary+-- | Convert a CTPSO triple into a Packet packetFromCTPSO :: (CacheFile, TrackNo, PacketSO) -> Packet packetFromCTPSO (cf, trackNo, pso) = packetFromPacketSO r pso     where@@ -138,8 +157,23 @@  ---------------------------------------------------------------------- +-- | Filter just the raw data, timestamped by UTC+enumPacketsUTC :: (Functor m, Monad m)+               => I.Enumeratee [Stream] [PacketUTC] m a+enumPacketsUTC = I.joinI . enumCTPSO . I.mapChunks (catMaybes . map packetUTCFromCTPSO)++-- | Convert a CTPSO triple into a Packet+packetUTCFromCTPSO :: (CacheFile, TrackNo, PacketSO) -> Maybe PacketUTC+packetUTCFromCTPSO (cf, trackNo, pso) = toPacket <$> base'm+    where+        toPacket base = packetUTCFromPacketSO base r pso+        r = specRate . fromJust . IM.lookup trackNo . cfSpecs $ cf+        base'm = baseUTC . cfGlobal $ cf++----------------------------------------------------------------------+ -- | Filter summaries at a particular summary level-enumSummaryLevel :: (Functor m, MonadIO m)+enumSummaryLevel :: (Functor m, Monad m)                  => Int                  -> I.Enumeratee [Stream] [ZoomSummary] m a enumSummaryLevel level =@@ -147,7 +181,7 @@     I.filter (\(ZoomSummary s) -> summaryLevel s == level)  -- | Filter summaries at all levels-enumSummaries :: (Functor m, MonadIO m)+enumSummaries :: (Functor m, Monad m)               => I.Enumeratee [Stream] [ZoomSummary] m a enumSummaries = I.joinI . enumCTSO .  I.mapChunks (map summaryFromCTSO) @@ -160,13 +194,36 @@  ---------------------------------------------------------------------- +-- | Filter summaries at a particular summary level+enumSummaryUTCLevel :: (Functor m, Monad m)+                    => Int+                    -> I.Enumeratee [Stream] [ZoomSummaryUTC] m a+enumSummaryUTCLevel level =+    I.joinI . enumSummariesUTC .+    I.filter (\(ZoomSummaryUTC s) -> summaryUTCLevel s == level)++-- | Filter summaries at all levels+enumSummariesUTC :: (Functor m, Monad m)+                 => I.Enumeratee [Stream] [ZoomSummaryUTC] m a+enumSummariesUTC = I.joinI . enumCTSO .  I.mapChunks (catMaybes . map summaryUTCFromCTSO)++-- | Convert a CTSO triple into a ZoomSummaryUTC+summaryUTCFromCTSO :: (CacheFile, TrackNo, ZoomSummarySO) -> Maybe ZoomSummaryUTC+summaryUTCFromCTSO (cf, trackNo, (ZoomSummarySO zso)) = toZS <$> base'm+    where+        toZS base = ZoomSummaryUTC (summaryUTCFromSummarySO base r zso)+        r = specRate . fromJust . IM.lookup trackNo . cfSpecs $ cf+        base'm = baseUTC . cfGlobal $ cf++----------------------------------------------------------------------+ -- | Filter just the raw data-enumPacketSOs :: (Functor m, MonadIO m)+enumPacketSOs :: (Functor m, Monad 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)+enumSummarySOLevel :: (Functor m, Monad m)                    => Int                    -> I.Enumeratee [Stream] [ZoomSummarySO] m a enumSummarySOLevel level =@@ -174,12 +231,12 @@     I.filter (\(ZoomSummarySO s) -> summarySOLevel s == level)  -- | Filter summaries at all levels-enumSummarySOs :: (Functor m, MonadIO m)+enumSummarySOs :: (Functor m, Monad m)                => I.Enumeratee [Stream] [ZoomSummarySO] m a enumSummarySOs = I.joinI . enumCTSO .  I.mapChunks (map (\(_,_,s) -> s))  -- | Filter raw data-enumCTPSO :: (Functor m, MonadIO m)+enumCTPSO :: (Functor m, Monad m)           => I.Enumeratee [Stream] [(CacheFile, TrackNo, PacketSO)] m a enumCTPSO = I.mapChunks (catMaybes . map toCTPSO)     where@@ -188,7 +245,7 @@         toCTPSO _                = Nothing  -- | Filter summaries-enumCTSO :: (Functor m, MonadIO m)+enumCTSO :: (Functor m, Monad m)          => I.Enumeratee [Stream] [(CacheFile, TrackNo, ZoomSummarySO)] m a enumCTSO = I.mapChunks (catMaybes . map toCTSO)     where@@ -197,7 +254,7 @@         toCTSO _                 = Nothing  -- | Filter to a given list of track names-filterTracksByName :: (Functor m, MonadIO m)+filterTracksByName :: (Functor m, Monad m)                    => CacheFile                    -> [ByteString]                    -> I.Enumeratee [Stream] [Stream] m a@@ -209,7 +266,7 @@         f ts = specName ts `elem` names  -- | Filter to a given list of track numbers-filterTracks :: (Functor m, MonadIO m)+filterTracks :: (Functor m, Monad m)              => [TrackNo]              -> I.Enumeratee [Stream] [Stream] m a filterTracks tracks = I.filter fil@@ -361,10 +418,13 @@     v <- readVersion     checkVersion v     n <- readInt32be-    p <- readRational64be-    b <- readRational64be-    _u <- B.pack <$> (I.joinI $ I.takeUpTo 20 I.stream2list)-    return $ Global v n p b Nothing+    jDay <- readIntegerVLC+    sN <- readIntegerVLC+    sD <- readIntegerVLC+    let !u = if (sD == 0)+                then Nothing+                else Just $ UTCTime (ModifiedJulianDay jDay) (fromRational (sN % sD))+    return $ Global v n u     where         checkVersion (Version major minor)             | major == versionMajor && minor >= versionMinor = return ()

@@ -17,6 +17,7 @@ module Data.Iteratee.ZoomCache.Utils (     -- * Seeking       seekTimeStamp+    , seekUTCTime      -- * Raw data reading iteratees     , readInt8@@ -46,6 +47,7 @@ import qualified Data.Iteratee as I import qualified Data.ListLike as LL import Data.Ratio+import Data.Time.Clock (UTCTime) import Data.Word import Unsafe.Coerce (unsafeCoerce) @@ -59,6 +61,12 @@ seekTimeStamp ts = do     I.seek 0     dropWhileB (before ts)++seekUTCTime :: (LL.ListLike s el, I.Nullable s, I.NullPoint s, UTCTimestampable el, Monad m)+            => Maybe UTCTime -> Iteratee s m ()+seekUTCTime uts = do+    I.seek 0+    dropWhileB (beforeUTC uts)  -- |Skip all elements while the predicate is true, but also return the last false element --

@@ -21,6 +21,11 @@     , Timestampable(..)     , before +    , UTCTimestampable(..)+    , beforeUTC+    , timeStampFromUTCTime+    , utcTimeFromTimeStamp+     -- * Types     , SampleOffset(..)     , TrackNo@@ -28,6 +33,7 @@     , IdentifyCodec     , SampleRateType(..) +    , Global(..)     , CacheFile(..)      , ZoomReadable(..)@@ -36,6 +42,10 @@     , ZoomSummary(..)     , Packet(..)     , Summary(..)++    , ZoomSummaryUTC(..)+    , PacketUTC(..)+    , SummaryUTC(..)      , ZoomSummarySO(..)     , PacketSO(..)

@@ -20,6 +20,9 @@     , timeStampDiff     , timeStampFromSO +    , timeStampFromUTCTime+    , utcTimeFromTimeStamp+     -- * SampleOffsets     , SampleOffset(..)     , SampleOffsetDiff(..)@@ -38,6 +41,7 @@  import Data.Int import Data.Ratio+import Data.Time.Clock (UTCTime, addUTCTime, diffUTCTime)  ------------------------------------------------------------ @@ -59,11 +63,8 @@ data Global = Global     { version          :: Version     , noTracks         :: Int-    , presentationTime :: Rational-    , baseTime         :: Rational-    , baseUTC          :: Maybe Int -- UTCTime+    , baseUTC          :: Maybe UTCTime     }-    deriving (Show)  -- | Constant or Variable samplerate. -- For constant samplerate, timestamps are implied as incrementing by 1/samplerate@@ -88,3 +89,15 @@     where           n = fromIntegral $ numerator r           d = fromIntegral $ denominator r++-- | @utcTimeFromTimeStamp base (TS ts) = baseUTC + ts@+utcTimeFromTimeStamp :: UTCTime -> TimeStamp -> UTCTime+utcTimeFromTimeStamp base (TS ts) = addUTCTime dTime base+    where+        dTime = fromRational . toRational $ ts++-- | @timeStampFromUTCTime base u = TS (u - base)+timeStampFromUTCTime :: UTCTime -> UTCTime -> TimeStamp+timeStampFromUTCTime base u = TS (fromRational . toRational $ d)+    where+        d = diffUTCTime u base

@@ -56,33 +56,42 @@    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+    | No. tracks (int32)                                            | 12-15    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Presentationtime numerator (int64)                            | 16-19-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | ...                                                           | 20-23-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Presentationtime denominator (int64)                          | 24-27-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | ...                                                           | 28-31-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Basetime numerator (int64)                                    | 32-35-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | ...                                                           | 36-39-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | Basetime denominator (int64)                                  | 40-43-   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | ...                                                           | 44-47+   | Modified Julian Day (intVLC)                                  | 16-    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | UTC                                                           | 48-51+   | ...                                                           | ...    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | ...                                                           | 52-55+   | Seconds since midnight Numerator (intVLC)                     | ...    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | ...                                                           | 56-59+   | ...                                                           | ...    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | ...                                                           | 60-63+   | Seconds since midnight Denominator (intVLC)                   | ...    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-   | ...                                                           | 64-67+   | ...                                                           | ...    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ @++The Universal Time corresponding to data timestamp 0 is uniquely given+by the fields "Modified Julian Day", "Seconds since midnight Numerator"+and "Seconds since midnight Denominator".++The Modified Julian Day is a standard count of days, with zero being+the day 1858-11-17.+Seconds since midnight: 0 <= t <= 86401s (because of leap seconds)++If the correspondence to Universal Time is meaningless or unknown when+writing data, these fields shall be given the special values 0, 0, 0.++When reading, a value of 0 for "Seconds since midnight Denominator"+should be interpreted as no corresponding Universal Time.++Field encoding formats:++  @int16@:  16bit big endian signed integer++  @int32@:  32bit big endian signed integer++  @intVLC@: Variable-length-coded signed integer+ -}  -- Magic identifier at the beginning of a zoom-cache file.@@ -91,7 +100,7 @@  -- | The major version encoded by this library versionMajor :: Int-versionMajor = 2+versionMajor = 3  -- | The minor version encoded by this library versionMinor :: Int

@@ -28,6 +28,10 @@     , wholeTrackSummaryListDouble     , enumListDouble     , enumSummaryListDouble++    , wholeTrackSummaryUTCListDouble+    , enumUTCListDouble+    , enumSummaryUTCListDouble )where  import Control.Applicative ((<$>))@@ -36,6 +40,7 @@ import Data.Int import qualified Data.Iteratee as I import Data.Maybe+import Data.Time (UTCTime) import Data.Typeable import Data.TypeLevel.Num hiding ((==)) import Data.Word@@ -134,6 +139,42 @@         sld :: Typeable a => Summary (NList D1 a) -> [Summary Double]         sld = catMaybes . map toSummaryDouble . sl +toSummaryUTCListDouble :: Typeable a => SummaryUTC a -> Maybe [SummaryUTC Double]+toSummaryUTCListDouble s | isJust sd = (:[]) <$> sd+                         | typeOf s == typeOf (undefined :: SummaryUTC (NList D1 Double)) =+                                   sl <$> (cast s :: Maybe (SummaryUTC (NList D1 Double)))+                         | typeOf s == typeOf (undefined :: SummaryUTC (NList D1 Float)) =+                                  sld <$> (cast s :: Maybe (SummaryUTC (NList D1 Float)))+                         | typeOf s == typeOf (undefined :: SummaryUTC (NList D1 Int)) =+                                  sld <$> (cast s :: Maybe (SummaryUTC (NList D1 Int)))+                         | typeOf s == typeOf (undefined :: SummaryUTC (NList D1 Int8)) =+                                  sld <$> (cast s :: Maybe (SummaryUTC (NList D1 Int8)))+                         | typeOf s == typeOf (undefined :: SummaryUTC (NList D1 Int16)) =+                                  sld <$> (cast s :: Maybe (SummaryUTC (NList D1 Int16)))+                         | typeOf s == typeOf (undefined :: SummaryUTC (NList D1 Int32)) =+                                  sld <$> (cast s :: Maybe (SummaryUTC (NList D1 Int32)))+                         | typeOf s == typeOf (undefined :: SummaryUTC (NList D1 Int64)) =+                                  sld <$> (cast s :: Maybe (SummaryUTC (NList D1 Int64)))+                         | typeOf s == typeOf (undefined :: SummaryUTC (NList D1 Integer)) =+                                  sld <$> (cast s :: Maybe (SummaryUTC (NList D1 Integer)))+                         | typeOf s == typeOf (undefined :: SummaryUTC (NList D1 Word)) =+                                  sld <$> (cast s :: Maybe (SummaryUTC (NList D1 Word)))+                         | typeOf s == typeOf (undefined :: SummaryUTC (NList D1 Word8)) =+                                  sld <$> (cast s :: Maybe (SummaryUTC (NList D1 Word8)))+                         | typeOf s == typeOf (undefined :: SummaryUTC (NList D1 Word16)) =+                                  sld <$> (cast s :: Maybe (SummaryUTC (NList D1 Word16)))+                         | typeOf s == typeOf (undefined :: SummaryUTC (NList D1 Word32)) =+                                  sld <$> (cast s :: Maybe (SummaryUTC (NList D1 Word32)))+                         | typeOf s == typeOf (undefined :: SummaryUTC (NList D1 Word64)) =+                                  sld <$> (cast s :: Maybe (SummaryUTC (NList D1 Word64)))+                         | otherwise = Nothing+    where+        sd = toSummaryUTCDouble s+        sl :: SummaryUTC (NList D1 a) -> [SummaryUTC a]+        sl = summaryUTCNListToList+        sld :: Typeable a => SummaryUTC (NList D1 a) -> [SummaryUTC Double]+        sld = catMaybes . map toSummaryUTCDouble . sl+ ----------------------------------------------------------------------  -- | Read the summary of an entire track.@@ -149,14 +190,14 @@         toSLD :: ZoomSummary -> Maybe [Summary Double]         toSLD (ZoomSummary s) = toSummaryListDouble s -enumListDouble :: (Functor m, MonadIO m)+enumListDouble :: (Functor m, Monad 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)+enumSummaryListDouble :: (Functor m, Monad m)                       => Int                       -> I.Enumeratee [Stream] [[Summary Double]] m a enumSummaryListDouble level =@@ -165,3 +206,35 @@     where         toSLD :: ZoomSummary -> Maybe [Summary Double]         toSLD (ZoomSummary s) = toSummaryListDouble s++----------------------------------------------------------------------++-- | Read the summary of an entire track.+wholeTrackSummaryUTCListDouble :: (Functor m, MonadIO m)+                               => [IdentifyCodec]+                               -> TrackNo+                               -> I.Iteratee ByteString m [SummaryUTC Double]+wholeTrackSummaryUTCListDouble identifiers trackNo =+    I.joinI $ enumCacheFile identifiers .+    I.joinI . filterTracks [trackNo] .  I.joinI . e $ I.last+    where+        e = I.joinI . enumSummariesUTC . I.mapChunks (catMaybes . map toSLD)+        toSLD :: ZoomSummaryUTC -> Maybe [SummaryUTC Double]+        toSLD (ZoomSummaryUTC s) = toSummaryUTCListDouble s++enumUTCListDouble :: (Functor m, Monad m)+                  => I.Enumeratee [Stream] [(UTCTime, [Double])] m a+enumUTCListDouble = I.joinI . enumPacketsUTC . I.mapChunks (concatMap f)+    where+        f :: PacketUTC -> [(UTCTime, [Double])]+        f PacketUTC{..} = zip packetUTCTimeStamps (rawToListDouble packetUTCData)++enumSummaryUTCListDouble :: (Functor m, Monad m)+                         => Int+                         -> I.Enumeratee [Stream] [[SummaryUTC Double]] m a+enumSummaryUTCListDouble level =+    I.joinI . enumSummaryUTCLevel level .+    I.mapChunks (catMaybes . map toSLD)+    where+        toSLD :: ZoomSummaryUTC -> Maybe [SummaryUTC Double]+        toSLD (ZoomSummaryUTC s) = toSummaryUTCListDouble s

@@ -27,6 +27,7 @@     , SummaryWork(..)      , summaryNListToList+    , summaryUTCNListToList )where  import Blaze.ByteString.Builder@@ -51,6 +52,14 @@     where         mkSummary :: SummaryData a -> Summary a         mkSummary sd = s { summaryData = sd }+        expandData :: SummaryData (NList n a) -> [SummaryData a]+        expandData (SummaryNList (NList _ l)) = l++summaryUTCNListToList :: SummaryUTC (NList n a) -> [SummaryUTC a]+summaryUTCNListToList s = map mkSummaryUTC (expandData (summaryUTCData s))+    where+        mkSummaryUTC :: SummaryData a -> SummaryUTC a+        mkSummaryUTC sd = s { summaryUTCData = sd }         expandData :: SummaryData (NList n a) -> [SummaryData a]         expandData (SummaryNList (NList _ l)) = l 

@@ -24,11 +24,14 @@    , rawToDouble   , toSummaryDouble-  , toSummarySODouble+  , toSummaryUTCDouble    , wholeTrackSummaryDouble+  , wholeTrackSummaryUTCDouble   , enumDouble+  , enumUTCDouble   , enumSummaryDouble+  , enumSummaryUTCDouble    , module Data.ZoomCache ) where@@ -39,6 +42,7 @@ import Data.Int import qualified Data.Iteratee as I import Data.Maybe+import Data.Time (UTCTime) import Data.Typeable import Data.Word import Data.ZoomCache@@ -114,39 +118,39 @@         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))+-- | Coercion of numeric SummaryUTC to type SummaryUTC Double.+toSummaryUTCDouble :: Typeable a => SummaryUTC a -> Maybe (SummaryUTC Double)+toSummaryUTCDouble s | typeOf s == typeOf (undefined :: SummaryUTC Double) =+                                  id (cast s :: Maybe (SummaryUTC Double))+                    | typeOf s == typeOf (undefined :: SummaryUTC Float) =+                                  sd <$> (cast s :: Maybe (SummaryUTC Float))+                    | typeOf s == typeOf (undefined :: SummaryUTC Int) =+                              sd <$> (cast s :: Maybe (SummaryUTC Int))+                    | typeOf s == typeOf (undefined :: SummaryUTC Int8) =+                              sd <$> (cast s :: Maybe (SummaryUTC Int8))+                    | typeOf s == typeOf (undefined :: SummaryUTC Int16) =+                              sd <$> (cast s :: Maybe (SummaryUTC Int16))+                    | typeOf s == typeOf (undefined :: SummaryUTC Int32) =+                              sd <$> (cast s :: Maybe (SummaryUTC Int32))+                    | typeOf s == typeOf (undefined :: SummaryUTC Int64) =+                              sd <$> (cast s :: Maybe (SummaryUTC Int64))+                    | typeOf s == typeOf (undefined :: SummaryUTC Integer) =+                              sd <$> (cast s :: Maybe (SummaryUTC Integer))+                    | typeOf s == typeOf (undefined :: SummaryUTC Word) =+                              sd <$> (cast s :: Maybe (SummaryUTC Word))+                    | typeOf s == typeOf (undefined :: SummaryUTC Word8) =+                              sd <$> (cast s :: Maybe (SummaryUTC Word8))+                    | typeOf s == typeOf (undefined :: SummaryUTC Word16) =+                              sd <$> (cast s :: Maybe (SummaryUTC Word16))+                    | typeOf s == typeOf (undefined :: SummaryUTC Word32) =+                              sd <$> (cast s :: Maybe (SummaryUTC Word32))+                    | typeOf s == typeOf (undefined :: SummaryUTC Word64) =+                              sd <$> (cast s :: Maybe (SummaryUTC Word64))                     | otherwise = Nothing     where-        sd :: ZoomNum a => SummarySO a -> SummarySO Double-        sd s' = s' { summarySOData = toSummaryDataDouble (summarySOData s') }-        +        sd :: ZoomNum a => SummaryUTC a -> SummaryUTC Double+        sd s' = s' { summaryUTCData = toSummaryDataDouble (summaryUTCData s') }+ toSummaryDataDouble :: ZoomNum a => SummaryData a -> SummaryData Double toSummaryDataDouble s = numMkSummary     (realToFrac . numEntry $ s)@@ -170,14 +174,33 @@         toSD :: ZoomSummary -> Maybe (Summary Double)         toSD (ZoomSummary s) = toSummaryDouble s -enumDouble :: (Functor m, MonadIO m)+-- | Read the summary of an entire track.+wholeTrackSummaryUTCDouble :: (Functor m, MonadIO m)+                           => [IdentifyCodec]+                           -> TrackNo+                           -> I.Iteratee ByteString m (SummaryUTC Double)+wholeTrackSummaryUTCDouble identifiers trackNo = I.joinI $ enumCacheFile identifiers .+    I.joinI . filterTracks [trackNo] .  I.joinI . e $ I.last+    where+        e = I.joinI . enumSummariesUTC . I.mapChunks (catMaybes . map toSD)+        toSD :: ZoomSummaryUTC -> Maybe (SummaryUTC Double)+        toSD (ZoomSummaryUTC s) = toSummaryUTCDouble s++enumDouble :: (Functor m, Monad m)            => I.Enumeratee [Stream] [(TimeStamp, Double)] m a enumDouble = I.joinI . enumPackets . I.mapChunks (concatMap f)     where         f :: Packet -> [(TimeStamp, Double)]         f Packet{..} = zip packetTimeStamps (rawToDouble packetData) -enumSummaryDouble :: (Functor m, MonadIO m)+enumUTCDouble :: (Functor m, Monad m)+              => I.Enumeratee [Stream] [(UTCTime, Double)] m a+enumUTCDouble = I.joinI . enumPacketsUTC . I.mapChunks (concatMap f)+    where+        f :: PacketUTC -> [(UTCTime, Double)]+        f PacketUTC{..} = zip packetUTCTimeStamps (rawToDouble packetUTCData)++enumSummaryDouble :: (Functor m, Monad m)                   => Int                   -> I.Enumeratee [Stream] [Summary Double] m a enumSummaryDouble level =@@ -186,3 +209,13 @@     where         toSD :: ZoomSummary -> Maybe (Summary Double)         toSD (ZoomSummary s) = toSummaryDouble s++enumSummaryUTCDouble :: (Functor m, Monad m)+                     => Int+                     -> I.Enumeratee [Stream] [SummaryUTC Double] m a+enumSummaryUTCDouble level =+    I.joinI . enumSummaryUTCLevel level .+    I.mapChunks (catMaybes . map toSD)+    where+        toSD :: ZoomSummaryUTC -> Maybe (SummaryUTC Double)+        toSD (ZoomSummaryUTC s) = toSummaryUTCDouble s

@@ -23,6 +23,8 @@  import qualified Data.ByteString.Char8 as C import Data.Ratio+import Data.Time (UTCTime, formatTime)+import System.Locale (defaultTimeLocale) import Text.Printf  import Data.ZoomCache.Common@@ -35,12 +37,12 @@ prettyGlobal Global{..} = unlines     [ "Version:\t\t" ++ show vMaj ++ "." ++ show vMin     , "No. tracks:\t\t" ++ show noTracks-    , "Presentation-time:\t" ++ ratShow presentationTime-    , "Base-time:\t\t" ++ ratShow baseTime-    , "UTC baseTime:\t\t" ++ maybe "undefined" show baseUTC+    , "UTC baseTime:\t\t" ++ maybe "undefined" showUTC baseUTC     ]     where         Version vMaj vMin = version+        showUTC :: UTCTime -> String+        showUTC = formatTime defaultTimeLocale "%Y-%m-%d %T"  -- | Pretty-print a 'TrackSpec' prettyTrackSpec :: TrackNo -> TrackSpec -> String

@@ -30,12 +30,16 @@     , Timestampable(..)     , before +    , UTCTimestampable(..)+    , beforeUTC+     , ZoomReadable(..)     , ZoomWritable(..)      , ZoomRaw(..)      , ZoomSummary(..)+    , ZoomSummaryUTC(..)     , ZoomSummarySO(..)      , ZoomWork(..)@@ -46,6 +50,14 @@     , Summary(..)     , summaryFromSummarySO +    , PacketUTC(..)+    , packetUTCFromPacket+    , packetUTCFromPacketSO++    , SummaryUTC(..)+    , summaryUTCFromSummary+    , summaryUTCFromSummarySO+     , PacketSO(..)     , SummarySO(..)     , SummaryData()@@ -67,6 +79,7 @@ import qualified Data.IntMap as IM import Data.Iteratee (Iteratee) import Data.Maybe (fromJust)+import Data.Time (UTCTime)  import Data.ZoomCache.Common @@ -140,6 +153,24 @@  ------------------------------------------------------------ +class UTCTimestampable a where+    utcTimestamp :: a -> Maybe UTCTime++beforeUTC :: (UTCTimestampable a) => Maybe UTCTime -> a -> Bool+beforeUTC Nothing _ = True+beforeUTC (Just b) x = t == Nothing || (fromJust t) < b+  where+    t = utcTimestamp x++instance UTCTimestampable (UTCTime, a) where+    utcTimestamp = Just . fst++instance UTCTimestampable a => UTCTimestampable [a] where+    utcTimestamp []    = Nothing+    utcTimestamp (x:_) = utcTimestamp x++------------------------------------------------------------+ data PacketSO = PacketSO     { packetSOTrack         :: {-# UNPACK #-}!TrackNo     , packetSOEntry         :: {-# UNPACK #-}!SampleOffset@@ -171,6 +202,31 @@ instance Timestampable Packet where     timestamp = Just . packetEntry +data PacketUTC = PacketUTC+    { packetUTCTrack      :: {-# UNPACK #-}!TrackNo+    , packetUTCEntry      :: {-# UNPACK #-}!UTCTime+    , packetUTCExit       :: {-# UNPACK #-}!UTCTime+    , packetUTCCount      :: {-# UNPACK #-}!Int+    , packetUTCData       :: !ZoomRaw+    , packetUTCTimeStamps :: ![UTCTime]+    }++packetUTCFromPacket :: UTCTime -> Packet -> PacketUTC+packetUTCFromPacket base Packet{..} = PacketUTC {+      packetUTCTrack = packetTrack+    , packetUTCEntry = utcTimeFromTimeStamp base packetEntry+    , packetUTCExit  = utcTimeFromTimeStamp base packetExit+    , packetUTCCount = packetCount+    , packetUTCData  = packetData+    , packetUTCTimeStamps = map (utcTimeFromTimeStamp base) packetTimeStamps+    }++packetUTCFromPacketSO :: UTCTime -> Rational -> PacketSO -> PacketUTC+packetUTCFromPacketSO base r = packetUTCFromPacket base . packetFromPacketSO r++instance UTCTimestampable PacketUTC where+    utcTimestamp = Just . packetUTCEntry+ ------------------------------------------------------------ -- | A recorded block of summary data data SummarySO a = SummarySO@@ -210,6 +266,32 @@ instance Timestampable (Summary a) where     timestamp = Just . summaryEntry +-- | A summary block with timestamps converted to UTCTime+data SummaryUTC a = SummaryUTC+    { summaryUTCTrack :: {-# UNPACK #-}!TrackNo+    , summaryUTCLevel :: {-# UNPACK #-}!Int+    , summaryUTCEntry :: {-# UNPACK #-}!UTCTime+    , summaryUTCExit  :: {-# UNPACK #-}!UTCTime+    , summaryUTCData  :: !(SummaryData a)+    }+    deriving (Typeable)++-- | Convert a Summary to a SummaryUTC, given a UTC base time+summaryUTCFromSummary :: UTCTime -> Summary a -> SummaryUTC a+summaryUTCFromSummary base Summary{..} = SummaryUTC {+      summaryUTCTrack = summaryTrack+    , summaryUTCLevel = summaryLevel+    , summaryUTCEntry = utcTimeFromTimeStamp base summaryEntry+    , summaryUTCExit  = utcTimeFromTimeStamp base summaryExit+    , summaryUTCData  = summaryData+    }++summaryUTCFromSummarySO :: UTCTime -> Rational -> SummarySO a -> SummaryUTC a+summaryUTCFromSummarySO base r = summaryUTCFromSummary base . summaryFromSummarySO r++instance UTCTimestampable (SummaryUTC a) where+    utcTimestamp = Just . summaryUTCEntry+ ------------------------------------------------------------ -- Read @@ -254,6 +336,11 @@  instance Timestampable ZoomSummary where     timestamp (ZoomSummary s) = timestamp s++data ZoomSummaryUTC = forall a . ZoomReadable a => ZoomSummaryUTC (SummaryUTC a)++instance UTCTimestampable ZoomSummaryUTC where+    utcTimestamp (ZoomSummaryUTC s) = utcTimestamp s  ------------------------------------------------------------ -- Write

@@ -55,6 +55,7 @@ import qualified Data.IntMap as IM import Data.List (foldl') import Data.Monoid+import Data.Time (UTCTime) import System.IO  import Blaze.ByteString.Builder.ZoomCache@@ -102,13 +103,14 @@ -- | Run a @ZoomW ()@ action on a given file handle, using the specified -- 'TrackMap' specification withFileWrite :: TrackMap+              -> Maybe UTCTime               -> Bool          -- ^ Whether or not to write raw data packets.                                -- If False, only summary blocks are written.               -> ZoomW ()               -> FilePath               -> IO ()-withFileWrite ztypes doRaw f path = do-    z <- openWrite ztypes doRaw path+withFileWrite ztypes utc doRaw f path = do+    z <- openWrite ztypes utc doRaw path     z' <- execStateT (f >> flush >> finish) z     hClose (whHandle z') @@ -151,13 +153,14 @@  -- | Open a new ZoomCache file for writing, using a specified 'TrackMap'. openWrite :: TrackMap+          -> Maybe UTCTime           -> Bool              -- ^ Whether or not to write raw data packets.                                -- If False, only summary blocks are written.           -> FilePath           -> IO ZoomWHandle-openWrite trackMap doRaw path = do+openWrite trackMap utc doRaw path = do     h <- openFile path WriteMode-    let global = mkGlobal (IM.size trackMap)+    let global = mkGlobal (IM.size trackMap) utc     writeGlobalHeader h global     let tracks = IM.foldWithKey addTrack IM.empty trackMap     mapM_ (uncurry (writeTrackHeader h)) (IM.assocs trackMap)@@ -303,13 +306,11 @@ ---------------------------------------------------------------------- -- Global -mkGlobal :: Int -> Global-mkGlobal n = Global+mkGlobal :: Int -> Maybe UTCTime -> Global+mkGlobal n utc = Global     { version = Version versionMajor versionMinor     , noTracks = n-    , presentationTime = 0-    , baseTime = 0-    , baseUTC = Nothing+    , baseUTC = utc     }  ----------------------------------------------------------------------

@@ -12,6 +12,7 @@ import qualified Data.ByteString.Char8 as C import Data.Default import qualified Data.IntMap as IM+import Data.Time.Clock (getCurrentTime) import System.Console.GetOpt import UI.Command @@ -142,28 +143,27 @@  zoomWriteFile :: Config -> FilePath -> IO () zoomWriteFile Config{..} path-    | intData   = w ints path-    | otherwise = w doubles path+    | intData   = w ints+    | otherwise = w doubles     where     w :: (ZoomReadable a, ZoomWrite a, ZoomWritable a, ZoomWrite (SampleOffset, a))-      => [a] -> FilePath -> IO ()+      => [a] -> IO ()     w d-        | variable && channels == 1 = withFileWrite trackMap-                          (not noRaw)-                          (sW >> mapM_ (write track)-                                       (zip (map SO [1,3..]) d))-        | channels == 1 = withFileWrite trackMap-                          (not noRaw)-                          (sW >> mapM_ (write track) d)-        | variable  = withFileWrite trackMap-                          (not noRaw)-                          (sW >> mapM_ (write track)-                                       (zip (map SO [1,3..])-                                            (map (replicate channels) d)))-        | otherwise = withFileWrite trackMap-                          (not noRaw)-                          (sW >> mapM_ (write track)-                                       (map (replicate channels) d))+        | variable && channels == 1 =+            writeData (sW >> mapM_ (write track) (zip (map SO [1,3..]) d))+        | channels == 1             =+            writeData (sW >> mapM_ (write track) d)+        | variable                  =+            writeData (sW >> mapM_ (write track)+                                   (zip (map SO [1,3..])+                                        (map (replicate channels) d)))+        | otherwise                 =+            writeData (sW >> mapM_ (write track) (map (replicate channels) d))++    writeData ds = do+        now <- getCurrentTime+        withFileWrite trackMap (Just now) (not noRaw) ds path+     sW = setWatermark track wmLevel     trackMap = IM.singleton track spec'     spec' | channels == 1 && intData = setCodec (undefined :: Int) spec

@@ -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.9.1.0+Version:             1.0.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,+    old-locale,+    QuickCheck                >= 2.4.0.1,+    time,     transformers              >= 0.2     && < 0.3,     type-level,     zlib@@ -137,7 +139,9 @@     iteratee-compress,     ListLike                  >= 1.0     && < 4,     mtl                       >= 2.0.0.0 && < 3,-    QuickCheck                 >= 2.4.0.1,+    old-locale,+    QuickCheck                >= 2.4.0.1,+    time,     transformers              >= 0.2     && < 0.3,     type-level,     ui-command,