diff --git a/Data/Iteratee/ZoomCache.hs b/Data/Iteratee/ZoomCache.hs --- a/Data/Iteratee/ZoomCache.hs +++ b/Data/Iteratee/ZoomCache.hs @@ -5,33 +5,57 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS -Wall #-} ---------------------------------------------------------------------- --- | --- Module : Data.ZoomCache.Write --- Copyright : Conrad Parker --- License : BSD3-style (see LICENSE) --- --- Maintainer : Conrad Parker --- Stability : unstable --- Portability : unknown --- --- Iteratee reading of ZoomCache files. +{- | + Module : Data.Iteratee.ZoomCache + Copyright : Conrad Parker + License : BSD3-style (see LICENSE) + + Maintainer : Conrad Parker + Stability : unstable + Portability : unknown + + Iteratee reading of ZoomCache files. + + A typical usage, using the iteratee @iter@ to process the level 3 summaries + from the track called \"rainfall\": + +@ + I.fileDriverRandom (enumCacheFile standardIdentifiers . + I.joinI . filterTracksByName [\"rainfall\"] . + I.joinI . enumSummaryLevel 3 $ iter) filename +@ + + Similarly, using the iteratee @rawIter@ to process the raw data from the + track called \"rainfall\": + +@ + I.fileDriverRandom (enumCacheFile standardIdentifiers . + I.joinI . filterTracksByName [\"rainfall\"] . + I.joinI . enumPackets $ rawIter) filename +@ +-} + ---------------------------------------------------------------------- module Data.Iteratee.ZoomCache ( - -- * Types - Stream(..) + -- * Types + Stream(..) - -- * Parsing iteratees - , iterHeaders + -- * Reading zoom-cache files and ByteStrings + , enumCacheFile - -- * Enumeratee - , enumCacheFile - , enumStream + , iterHeaders + , enumStream + , enumStreamTrackNo - -- * Iteratee maps - , mapStream - , mapPackets - , mapSummaries + -- * Stream enumeratees + , enumPackets + , enumSummaryLevel + , enumSummaries + , enumCTP + , enumCTS + , filterTracksByName + , filterTracks ) where import Control.Applicative @@ -68,47 +92,128 @@ , strmTrack :: TrackNo , strmSummary :: ZoomSummary } - | StreamNull -instance I.Nullable Stream where - nullC StreamNull = True - nullC _ = False +---------------------------------------------------------------------- -instance I.NullPoint Stream where - empty = StreamNull +-- | Filter just the raw data +enumPackets :: (Functor m, MonadIO m) + => I.Enumeratee [Stream] [Packet] m a +enumPackets = I.joinI . enumCTP . I.mapChunks (map (\(_,_,p) -> p)) ----------------------------------------------------------------------- +-- | Filter summaries at a particular summary level +enumSummaryLevel :: (Functor m, MonadIO m) + => Int + -> I.Enumeratee [Stream] [ZoomSummary] m a +enumSummaryLevel level = + I.joinI . enumSummaries . + I.filter (\(ZoomSummary s) -> summaryLevel s == level) +-- | Filter summaries at all levels +enumSummaries :: (Functor m, MonadIO m) + => I.Enumeratee [Stream] [ZoomSummary] m a +enumSummaries = I.joinI . enumCTS . I.mapChunks (map (\(_,_,s) -> s)) + +-- | Filter raw data +enumCTP :: (Functor m, MonadIO m) + => I.Enumeratee [Stream] [(CacheFile, TrackNo, Packet)] m a +enumCTP = I.mapChunks (catMaybes . map toCTP) + where + toCTP :: Stream -> Maybe (CacheFile, TrackNo, Packet) + toCTP StreamPacket{..} = Just (strmFile, strmTrack, strmPacket) + toCTP _ = Nothing + +-- | Filter summaries +enumCTS :: (Functor m, MonadIO m) + => I.Enumeratee [Stream] [(CacheFile, TrackNo, ZoomSummary)] m a +enumCTS = I.mapChunks (catMaybes . map toCTS) + where + toCTS :: Stream -> Maybe (CacheFile, TrackNo, ZoomSummary) + toCTS StreamSummary{..} = Just (strmFile, strmTrack, strmSummary) + toCTS _ = Nothing + +-- | Filter to a given list of track names +filterTracksByName :: (Functor m, MonadIO m) + => CacheFile + -> [ByteString] + -> I.Enumeratee [Stream] [Stream] m a +filterTracksByName CacheFile{..} names = filterTracks tracks + where + tracks :: [TrackNo] + tracks = IM.keys (IM.filter f cfSpecs) + f :: TrackSpec -> Bool + f ts = specName ts `elem` names + +-- | Filter to a given list of track numbers +filterTracks :: (Functor m, MonadIO m) + => [TrackNo] + -> I.Enumeratee [Stream] [Stream] m a +filterTracks tracks = I.filter fil + where + fil :: Stream -> Bool + fil StreamPacket{..} = strmTrack `elem` tracks + fil StreamSummary{..} = strmTrack `elem` tracks + -- | An enumeratee of a zoom-cache file, from the global header onwards. -- The global and track headers will be transparently read, and the -- 'CacheFile' visible in the 'Stream' elements. enumCacheFile :: (Functor m, MonadIO m) => [IdentifyCodec] - -> I.Enumeratee ByteString Stream m a -enumCacheFile mappings iter = do - fi <- iterHeaders mappings + -> I.Enumeratee ByteString [Stream] m a +enumCacheFile identifiers iter = do + fi <- iterHeaders identifiers enumStream fi iter -- | An enumeratee of zoom-cache data, after global and track headers -- have been read, or if the 'CacheFile' has been acquired elsewhere. +-- This version skips parsing of all tracks other than the specified 'TrackNo'. +-- +-- This function should only be used in applications where only one track is +-- used from a file; if you need to process multiple tracks independently then +-- give each an iteratee filtered by filterTracks or filterTracksByName, and +-- run these in parallel on the output of 'enumCacheFile' or 'enumStream'. +-- Using this function multiple times in parallel will duplicate some parsing. +enumStreamTrackNo :: (Functor m, MonadIO m) + => CacheFile + -> TrackNo + -> I.Enumeratee ByteString [Stream] m a +enumStreamTrackNo cf0 trackNo = I.unfoldConvStream go cf0 + where + go :: (Functor m, MonadIO m) + => CacheFile + -> Iteratee ByteString m (CacheFile, [Stream]) + go cf = do + header <- I.joinI $ I.takeUpTo 8 I.stream2list + case parseHeader (B.pack header) of + Just PacketHeader -> do + (_, packet) <- readPacketTrackNo (cfSpecs cf) trackNo + let res = maybe [] (\p -> [StreamPacket cf trackNo p]) packet + return (cf, res) + Just SummaryHeader -> do + (_, summary) <- readSummaryBlockTrackNo (cfSpecs cf) trackNo + let res = maybe [] (\s -> [StreamSummary cf trackNo s]) summary + return (cf, res) + _ -> return (cf, []) + +-- | An enumeratee of zoom-cache data, after global and track headers +-- have been read, or if the 'CacheFile' has been acquired elsewhere. enumStream :: (Functor m, MonadIO m) => CacheFile - -> I.Enumeratee ByteString Stream m a + -> I.Enumeratee ByteString [Stream] m a enumStream = I.unfoldConvStream go where go :: (Functor m, MonadIO m) => CacheFile - -> Iteratee ByteString m (CacheFile, Stream) + -> Iteratee ByteString m (CacheFile, [Stream]) go cf = do header <- I.joinI $ I.takeUpTo 8 I.stream2list case parseHeader (B.pack header) of Just PacketHeader -> do (trackNo, packet) <- readPacket (cfSpecs cf) - return (cf, StreamPacket cf trackNo (fromJust packet)) + return (cf, [StreamPacket cf trackNo (fromJust packet)]) Just SummaryHeader -> do (trackNo, summary) <- readSummaryBlock (cfSpecs cf) - return (cf, StreamSummary cf trackNo (fromJust summary)) - _ -> return (cf, StreamNull) + return (cf, [StreamSummary cf trackNo (fromJust summary)]) + _ -> return (cf, []) ------------------------------------------------------------ @@ -130,7 +235,7 @@ iterHeaders :: (Functor m, Monad m) => [IdentifyCodec] -> I.Iteratee ByteString m CacheFile -iterHeaders mappings = iterGlobal >>= go +iterHeaders identifiers = iterGlobal >>= go where iterGlobal :: (Functor m, Monad m) => Iteratee ByteString m CacheFile @@ -147,7 +252,7 @@ header <- I.joinI $ I.takeUpTo 8 I.stream2list case parseHeader (B.pack header) of Just TrackHeader -> do - (trackNo, spec) <- readTrackHeader mappings + (trackNo, spec) <- readTrackHeader identifiers let fi' = fi{cfSpecs = IM.insert trackNo spec (cfSpecs fi)} if (fiFull fi') then return fi' @@ -167,9 +272,9 @@ readTrackHeader :: (Functor m, Monad m) => [IdentifyCodec] -> Iteratee ByteString m (TrackNo, TrackSpec) -readTrackHeader mappings = do +readTrackHeader identifiers = do trackNo <- readInt32be - trackType <- readCodec mappings + trackType <- readCodec identifiers (drType, delta, zlib) <- readFlags rate <- readRational64be byteLength <- readInt32be @@ -183,20 +288,49 @@ enumInflateZlib :: (MonadIO m) => I.Enumeratee ByteString ByteString m a enumInflateZlib = enumInflate Zlib defaultDecompressParams -readPacket :: (Functor m, MonadIO m) - => IntMap TrackSpec - -> Iteratee ByteString m (TrackNo, Maybe Packet) -readPacket specs = do +readPacketPred :: (Functor m, MonadIO m) + => IntMap TrackSpec + -> ((TrackNo, TimeStamp, TimeStamp) -> Bool) + -> Iteratee ByteString m (TrackNo, Maybe Packet) +readPacketPred specs p = do trackNo <- readInt32be entryTime <- TS <$> readInt64be exitTime <- TS <$> readInt64be count <- readInt32be byteLength <- readInt32be - packet <- case IM.lookup trackNo specs of + packet <- if (p (trackNo, entryTime, exitTime)) + then do + readPacketData specs trackNo entryTime exitTime count byteLength + else do + I.drop byteLength + return Nothing + return (trackNo, packet) + +readPacketTrackNo :: (Functor m, MonadIO m) + => IntMap TrackSpec + -> TrackNo + -> Iteratee ByteString m (TrackNo, Maybe Packet) +readPacketTrackNo specs wantTrackNo = + readPacketPred specs (\(trackNo, _, _) -> trackNo == wantTrackNo) + +readPacket :: (Functor m, MonadIO m) + => IntMap TrackSpec + -> Iteratee ByteString m (TrackNo, Maybe Packet) +readPacket specs = readPacketPred specs (const True) + +readPacketData :: (Functor m, MonadIO m) + => IntMap TrackSpec + -> TrackNo + -> TimeStamp -> TimeStamp + -> Int + -> Int + -> Iteratee ByteString m (Maybe Packet) +readPacketData specs trackNo entryTime exitTime count byteLength = + case IM.lookup trackNo specs of Just TrackSpec{..} -> do let readDTS :: (Functor m, Monad m) => Iteratee ByteString m (ZoomRaw, [TimeStamp]) - readDTS = readDataTimeStamps specType specDeltaEncode specDRType count entryTime + readDTS = readDataTimeStamps specType specDeltaEncode specDRType (d, ts) <- if specZlibCompress then do z <- I.joinI $ enumInflateZlib I.stream2stream @@ -207,15 +341,14 @@ Nothing -> do I.drop byteLength return Nothing - return (trackNo, packet) where runner1 :: Identity (I.Iteratee s Identity c) -> c runner1 = runIdentity . I.run . runIdentity readRawCodec :: (Functor m, Monad m) - => Codec -> Bool -> Int + => Codec -> Bool -> Iteratee ByteString m ZoomRaw - readRawCodec (Codec a) delta count = ZoomRaw . f <$> replicateM count (readRawAs a) + readRawCodec (Codec a) delta = ZoomRaw . f <$> replicateM count (readRawAs a) where f | delta = deltaDecodeRaw | otherwise = id @@ -225,45 +358,73 @@ readRawAs = const readRaw readDataTimeStamps :: (Functor m, Monad m) - => Codec -> Bool -> DataRateType -> Int -> TimeStamp + => Codec -> Bool -> DataRateType -> Iteratee ByteString m (ZoomRaw, [TimeStamp]) - readDataTimeStamps codec delta drType count entry = do - d <- readRawCodec codec delta count - ts <- readTimeStamps drType count entry + readDataTimeStamps codec delta drType = do + d <- readRawCodec codec delta + ts <- readTimeStamps drType return (d, ts) readTimeStamps :: (Functor m, Monad m) - => DataRateType -> Int -> TimeStamp + => DataRateType -> Iteratee ByteString m [TimeStamp] - readTimeStamps drType count entry = map TS <$> case drType of + readTimeStamps drType = map TS <$> case drType of ConstantDR -> do - return $ take count [unTS entry ..] + return $ take count [unTS entryTime ..] VariableDR -> do deltaDecode <$> replicateM count readInt64be -readSummaryBlock :: (Functor m, Monad m) - => IntMap TrackSpec - -> Iteratee ByteString m (TrackNo, Maybe ZoomSummary) -readSummaryBlock specs = do +readSummaryBlockPred :: (Functor m, Monad m) + => IntMap TrackSpec + -> ((TrackNo, Int, TimeStamp, TimeStamp) -> Bool) + -> Iteratee ByteString m (TrackNo, Maybe ZoomSummary) +readSummaryBlockPred specs p = do trackNo <- readInt32be lvl <- readInt32be entryTime <- TS <$> readInt64be exitTime <- TS <$> readInt64be byteLength <- readInt32be + summary <- if (p (trackNo, lvl, entryTime, exitTime)) + then do + readSummaryBlockData specs trackNo lvl entryTime exitTime byteLength + else do + I.drop byteLength + return Nothing + return (trackNo, summary) - summary <- case IM.lookup trackNo specs of +readSummaryBlockTrackNo :: (Functor m, Monad m) + => IntMap TrackSpec + -> TrackNo + -> Iteratee ByteString m (TrackNo, Maybe ZoomSummary) +readSummaryBlockTrackNo specs wantTrackNo = + readSummaryBlockPred specs (\(trackNo, _, _, _) -> trackNo == wantTrackNo) + +readSummaryBlock :: (Functor m, Monad m) + => IntMap TrackSpec + -> Iteratee ByteString m (TrackNo, Maybe ZoomSummary) +readSummaryBlock specs = readSummaryBlockPred specs (const True) + +readSummaryBlockData :: (Functor m, Monad m) + => IntMap TrackSpec + -> TrackNo + -> Int + -> TimeStamp -> TimeStamp + -> Int + -> Iteratee ByteString m (Maybe ZoomSummary) +readSummaryBlockData specs trackNo lvl entryTime exitTime byteLength = + case IM.lookup trackNo specs of Just TrackSpec{..} -> do - sd <- readSummaryCodec specType trackNo lvl entryTime exitTime - return $ Just sd + Just <$> readSummaryCodec specType + -- sd <- readSummaryCodec specType + -- return $ Just sd Nothing -> do I.drop byteLength return Nothing - return (trackNo, summary) where readSummaryCodec :: (Functor m, Monad m) - => Codec -> TrackNo -> Int -> TimeStamp -> TimeStamp + => Codec -> Iteratee ByteString m ZoomSummary - readSummaryCodec (Codec a) trackNo lvl entryTime exitTime = do + readSummaryCodec (Codec a) = do ZoomSummary <$> (Summary trackNo lvl entryTime exitTime <$> readSummaryAs a) readSummaryAs :: (ZoomReadable a, Functor m, Monad m) @@ -272,39 +433,6 @@ ---------------------------------------------------------------------- --- Convenience functions - --- | Map a monadic 'Stream' processing function over an entire zoom-cache file. -mapStream :: (Functor m, MonadIO m) - => [IdentifyCodec] - -> (Stream -> m ()) - -> Iteratee ByteString m () -mapStream mappings = I.joinI . enumCacheFile mappings . I.mapChunksM_ -{-# INLINABLE mapStream #-} - --- | Map a monadic 'Packet' processing function over an entire zoom-cache file. -mapPackets :: (Functor m, MonadIO m) - => [IdentifyCodec] - -> (Packet -> m ()) - -> Iteratee ByteString m () -mapPackets mappings f = mapStream mappings process - where - process StreamPacket{..} = f strmPacket - process _ = return () -{-# INLINABLE mapPackets #-} - --- | Map a monadic 'Summary' processing function over an entire zoom-cache file. -mapSummaries :: (Functor m, MonadIO m) - => [IdentifyCodec] - -> (ZoomSummary -> m ()) - -> Iteratee ByteString m () -mapSummaries mappings f = mapStream mappings process - where - process StreamSummary{..} = f strmSummary - process _ = return () -{-# INLINABLE mapSummaries #-} - ----------------------------------------------------------------------- -- zoom-cache datatype parsers readVersion :: (Functor m, Monad m) @@ -314,12 +442,12 @@ readCodec :: (Functor m, Monad m) => [IdentifyCodec] -> Iteratee ByteString m Codec -readCodec mappings = do +readCodec identifiers = do tt <- B.pack <$> (I.joinI $ I.takeUpTo 8 I.stream2list) - maybe (error "Unknown track type") return (parseCodec mappings tt) + maybe (error "Unknown track type") return (parseCodec identifiers tt) parseCodec :: [IdentifyCodec] -> IdentifyCodec -parseCodec mappings h = msum . map ($ h) $ mappings +parseCodec identifiers h = msum . map ($ h) $ identifiers readFlags :: (Functor m, Monad m) => Iteratee ByteString m (DataRateType, Bool, Bool) diff --git a/Data/ZoomCache/Dump.hs b/Data/ZoomCache/Dump.hs --- a/Data/ZoomCache/Dump.hs +++ b/Data/ZoomCache/Dump.hs @@ -24,8 +24,6 @@ ) where import Control.Applicative ((<$>)) -import Control.Monad.Trans (MonadIO) -import Data.ByteString (ByteString) import Data.Int import qualified Data.IntMap as IM import qualified Data.Iteratee as I @@ -37,35 +35,22 @@ zoomInfoFile :: [IdentifyCodec] -> FilePath -> IO () -zoomInfoFile mappings path = - I.fileDriverRandom (iterHeadersBS mappings) path >>= info - -zoomDumpFile :: [IdentifyCodec] - -> TrackNo -> FilePath -> IO () -zoomDumpFile mappings trackNo = - I.fileDriverRandom (mapStreamBS mappings (dumpData trackNo)) - -zoomDumpSummary :: [IdentifyCodec] - -> TrackNo -> FilePath -> IO () -zoomDumpSummary mappings trackNo = - I.fileDriverRandom (mapStreamBS mappings (dumpSummary trackNo)) +zoomInfoFile identifiers path = + I.fileDriverRandom (iterHeaders identifiers) path >>= info -zoomDumpSummaryLevel :: [IdentifyCodec] - -> TrackNo -> Int -> FilePath -> IO () -zoomDumpSummaryLevel mappings trackNo lvl = - I.fileDriverRandom (mapStreamBS mappings (dumpSummaryLevel trackNo lvl)) +zoomDumpFile :: [IdentifyCodec] -> TrackNo -> FilePath -> IO () +zoomDumpFile = dumpSomething dumpData ----------------------------------------------------------------------- +zoomDumpSummary :: [IdentifyCodec] -> TrackNo -> FilePath -> IO () +zoomDumpSummary = dumpSomething dumpSummary -iterHeadersBS :: [IdentifyCodec] - -> I.Iteratee ByteString IO CacheFile -iterHeadersBS = iterHeaders +zoomDumpSummaryLevel :: Int + -> [IdentifyCodec] -> TrackNo -> FilePath -> IO () +zoomDumpSummaryLevel lvl = dumpSomething (dumpSummaryLevel lvl) -mapStreamBS :: (Functor m, MonadIO m) - => [IdentifyCodec] - -> (Stream -> m ()) - -> I.Iteratee ByteString m () -mapStreamBS = mapStream +dumpSomething :: (Stream -> IO ()) -> [IdentifyCodec] -> TrackNo -> FilePath -> IO () +dumpSomething f identifiers trackNo = I.fileDriverRandom + (I.joinI . enumCacheFile identifiers . I.joinI . filterTracks [trackNo] . I.mapM_ $ f) ---------------------------------------------------------------------- @@ -75,13 +60,10 @@ mapM_ (putStrLn . uncurry prettyTrackSpec) . IM.assocs $ cfSpecs streamRate :: Stream -> Maybe Rational -streamRate StreamNull = Nothing -streamRate s = specRate <$> IM.lookup (strmTrack s) (cfSpecs (strmFile s)) +streamRate s = specRate <$> IM.lookup (strmTrack s) (cfSpecs (strmFile s)) -dumpData :: TrackNo -> Stream -> IO () -dumpData trackNo s@StreamPacket{..} - | strmTrack == trackNo = mapM_ (\(t,d) -> printf "%s: %s\n" t d) tds - | otherwise = return () +dumpData :: Stream -> IO () +dumpData s@StreamPacket{..} = mapM_ (\(t,d) -> printf "%s: %s\n" t d) tds where pretty = case streamRate s of Just r -> prettyTimeStamp r @@ -89,22 +71,20 @@ tds = zip (map pretty (packetTimeStamps strmPacket)) vals vals = f (packetData strmPacket) f (ZoomRaw a) = map prettyRaw a -dumpData _ _ = return () +dumpData _ = return () -dumpSummary :: TrackNo -> Stream -> IO () -dumpSummary trackNo s@StreamSummary{..} - | strmTrack == trackNo = case streamRate s of +dumpSummary :: Stream -> IO () +dumpSummary s@StreamSummary{..} = case streamRate s of Just r -> putStrLn $ f r strmSummary Nothing -> return () - | otherwise = return () where f r (ZoomSummary a) = prettySummary r a -dumpSummary _ _ = return () +dumpSummary _ = return () -dumpSummaryLevel :: TrackNo -> Int -> Stream -> IO () -dumpSummaryLevel trackNo level s@StreamSummary{..} - | level == opLevel strmSummary && strmTrack == trackNo = dumpSummary trackNo s - | otherwise = return () +dumpSummaryLevel :: Int -> Stream -> IO () +dumpSummaryLevel level s@StreamSummary{..} + | level == opLevel strmSummary = dumpSummary s + | otherwise = return () where opLevel (ZoomSummary a) = summaryLevel a -dumpSummaryLevel _ _ _ = return () +dumpSummaryLevel _ _ = return () diff --git a/Data/ZoomCache/Numeric.hs b/Data/ZoomCache/Numeric.hs new file mode 100644 --- /dev/null +++ b/Data/ZoomCache/Numeric.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE RecordWildCards #-} +{-# OPTIONS -Wall #-} +---------------------------------------------------------------------- +-- | +-- Module : Data.ZoomCache.Types +-- Copyright : Conrad Parker +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Conrad Parker +-- Stability : unstable +-- Portability : unknown +-- +-- ZoomCache numeric API +---------------------------------------------------------------------- + +module Data.ZoomCache.Numeric ( + ZoomNum + , numEntry + , numExit + , numMin + , numMax + , numAvg + , numRMS + + , toSummaryDouble + + , enumDouble + , enumSummaryDouble + + , module Data.ZoomCache +) where + +import Control.Applicative ((<$>)) +import Control.Monad.Trans (MonadIO) +import Data.Int +import qualified Data.Iteratee as I +import Data.Maybe +import Data.Typeable +import Data.Word +import Data.ZoomCache +import Data.ZoomCache.Numeric.Types +import Data.ZoomCache.Types + +---------------------------------------------------------------------- + +rawToDouble :: ZoomRaw -> [Double] +rawToDouble (ZoomRaw xs) | typeOf xs == typeOf (undefined :: [Double]) = + fromMaybe [] (cast xs :: Maybe [Double]) + | typeOf xs == typeOf (undefined :: [Float]) = + f (cast xs :: Maybe [Float]) + | typeOf xs == typeOf (undefined :: [Int]) = + f (cast xs :: Maybe [Int]) + | typeOf xs == typeOf (undefined :: [Int8]) = + f (cast xs :: Maybe [Int8]) + | typeOf xs == typeOf (undefined :: [Int16]) = + f (cast xs :: Maybe [Int16]) + | typeOf xs == typeOf (undefined :: [Int32]) = + f (cast xs :: Maybe [Int32]) + | typeOf xs == typeOf (undefined :: [Int64]) = + f (cast xs :: Maybe [Int64]) + | typeOf xs == typeOf (undefined :: [Integer]) = + f (cast xs :: Maybe [Integer]) + | typeOf xs == typeOf (undefined :: [Word]) = + f (cast xs :: Maybe [Word]) + | typeOf xs == typeOf (undefined :: [Word8]) = + f (cast xs :: Maybe [Word8]) + | typeOf xs == typeOf (undefined :: [Word16]) = + f (cast xs :: Maybe [Word16]) + | typeOf xs == typeOf (undefined :: [Word32]) = + f (cast xs :: Maybe [Word32]) + | typeOf xs == typeOf (undefined :: [Word64]) = + f (cast xs :: Maybe [Word64]) + | otherwise = [] + where + f :: Real a => Maybe [a] -> [Double] + f = maybe [] (map realToFrac) + +---------------------------------------------------------------------- + +-- | Coercion of numeric summaries to type Summary Double. +toSummaryDouble :: Typeable a => Summary a -> Maybe (Summary Double) +toSummaryDouble s | typeOf s == typeOf (undefined :: Summary Double) = + id (cast s :: Maybe (Summary Double)) + | typeOf s == typeOf (undefined :: Summary Float) = + sd <$> (cast s :: Maybe (Summary Float)) + | typeOf s == typeOf (undefined :: Summary Int) = + sd <$> (cast s :: Maybe (Summary Int)) + | typeOf s == typeOf (undefined :: Summary Int8) = + sd <$> (cast s :: Maybe (Summary Int8)) + | typeOf s == typeOf (undefined :: Summary Int16) = + sd <$> (cast s :: Maybe (Summary Int16)) + | typeOf s == typeOf (undefined :: Summary Int32) = + sd <$> (cast s :: Maybe (Summary Int32)) + | typeOf s == typeOf (undefined :: Summary Int64) = + sd <$> (cast s :: Maybe (Summary Int64)) + | typeOf s == typeOf (undefined :: Summary Integer) = + sd <$> (cast s :: Maybe (Summary Integer)) + | typeOf s == typeOf (undefined :: Summary Word) = + sd <$> (cast s :: Maybe (Summary Word)) + | typeOf s == typeOf (undefined :: Summary Word8) = + sd <$> (cast s :: Maybe (Summary Word8)) + | typeOf s == typeOf (undefined :: Summary Word16) = + sd <$> (cast s :: Maybe (Summary Word16)) + | typeOf s == typeOf (undefined :: Summary Word32) = + sd <$> (cast s :: Maybe (Summary Word32)) + | typeOf s == typeOf (undefined :: Summary Word64) = + sd <$> (cast s :: Maybe (Summary Word64)) + | otherwise = Nothing + + where + sd :: ZoomNum a => Summary a -> Summary Double + sd s' = s' { summaryData = toSummaryDataDouble (summaryData s') } + +toSummaryDataDouble :: ZoomNum a => SummaryData a -> SummaryData Double +toSummaryDataDouble s = numMkSummary + (realToFrac . numEntry $ s) + (realToFrac . numExit $ s) + (realToFrac . numMin $ s) + (realToFrac . numMax $ s) + (numAvg s) + (numRMS s) + +---------------------------------------------------------------------- + +enumDouble :: (Functor m, MonadIO 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) + => Int + -> I.Enumeratee [Stream] [Summary Double] m a +enumSummaryDouble level = + I.joinI . enumSummaryLevel level . + I.mapChunks (catMaybes . map toSD) + where + toSD :: ZoomSummary -> Maybe (Summary Double) + toSD (ZoomSummary s) = toSummaryDouble s diff --git a/Data/ZoomCache/Numeric/Types.hs b/Data/ZoomCache/Numeric/Types.hs --- a/Data/ZoomCache/Numeric/Types.hs +++ b/Data/ZoomCache/Numeric/Types.hs @@ -3,7 +3,7 @@ {-# OPTIONS -Wall #-} module Data.ZoomCache.Numeric.Types ( - -- * Classes + -- * Summaries of numeric values ZoomNum(..) ) where @@ -13,11 +13,20 @@ -- ZoomNum class (Ord a, Real a, ZoomReadable a, ZoomWritable a) => ZoomNum a where + -- | Value at start of interval numEntry :: SummaryData a -> a + -- | Value at end of interval numExit :: SummaryData a -> a + + -- | Minimum value in the summary interval numMin :: SummaryData a -> a + -- | Maximum value in the summary interval numMax :: SummaryData a -> a + + -- | Mean value in the summary interval numAvg :: SummaryData a -> Double + + -- | Root mean square value in the summary interval numRMS :: SummaryData a -> Double numWorkTime :: SummaryWork a -> TimeStamp @@ -31,4 +40,3 @@ numMkSummary :: a -> a -> a -> a -> Double -> Double -> SummaryData a numMkSummaryWork :: TimeStamp -> Maybe a -> a -> a -> a -> Double -> Double -> SummaryWork a - diff --git a/tools/zoom-cache.hs b/tools/zoom-cache.hs --- a/tools/zoom-cache.hs +++ b/tools/zoom-cache.hs @@ -202,7 +202,8 @@ (config, filenames) <- liftIO . processArgs =<< appArgs liftIO . (f (track config)) $ filenames where - f trackNo (lvl:paths) = mapM_ (zoomDumpSummaryLevel standardIdentifiers trackNo (read lvl)) paths + f trackNo (lvl:paths) = mapM_ (zoomDumpSummaryLevel (read lvl) + standardIdentifiers trackNo) paths f _ _ = putStrLn "Usage: zoom-cache summary n file.zxd" ------------------------------------------------------------ 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.7.0.0 +Version: 0.8.0.0 Synopsis: A streamable, seekable, zoomable cache file format @@ -99,6 +99,7 @@ Data.ZoomCache.Dump Data.ZoomCache.Format Data.ZoomCache.Identify + Data.ZoomCache.Numeric Data.ZoomCache.Numeric.Delta Data.ZoomCache.Numeric.FloatMinMax Data.ZoomCache.Numeric.IEEE754