diff --git a/Blaze/ByteString/Builder/ZoomCache.hs b/Blaze/ByteString/Builder/ZoomCache.hs --- a/Blaze/ByteString/Builder/ZoomCache.hs +++ b/Blaze/ByteString/Builder/ZoomCache.hs @@ -38,6 +38,7 @@ -- | Serialize a 'TimeStamp' in 64bit big endian format. fromTimeStamp :: TimeStamp -> Builder fromTimeStamp = fromInt64be . fromIntegral . unTS +{-# INLINE fromTimeStamp #-} ---------------------------------------------------------------------- -- Creating builders from numeric types used by ZoomCache. @@ -49,10 +50,13 @@ where toWord64 :: Double -> Word64 toWord64 = unsafeCoerce +{-# INLINE fromDouble #-} -- | Serialize an 'Integral' in 32bit big endian format. fromIntegral32be :: forall a . (Integral a) => a -> Builder fromIntegral32be = fromInt32be . fromIntegral +{-# SPECIALIZE INLINE fromIntegral32be :: Int -> Builder #-} +{-# SPECIALIZE INLINE fromIntegral32be :: Integer -> Builder #-} -- | Serialize a 'Rational' as a sequence of two 64bit big endian format -- integers. @@ -61,4 +65,4 @@ [ fromInt64be . fromIntegral . numerator $ r , fromInt64be . fromIntegral . denominator $ r ] - +{-# INLINE fromRational64 #-} diff --git a/Blaze/ByteString/Builder/ZoomCache/Internal.hs b/Blaze/ByteString/Builder/ZoomCache/Internal.hs --- a/Blaze/ByteString/Builder/ZoomCache/Internal.hs +++ b/Blaze/ByteString/Builder/ZoomCache/Internal.hs @@ -71,8 +71,8 @@ fromTrackNo = fromInt32be . fromIntegral fromTrackType :: TrackType -> Builder -fromTrackType ZDouble = fromInt16be 0 -fromTrackType ZInt = fromInt16be 1 +fromTrackType ZDouble = fromLazyByteString trackTypeDouble +fromTrackType ZInt = fromLazyByteString trackTypeInt fromVersion :: Version -> Builder fromVersion (Version vMaj vMin) = mconcat diff --git a/Data/Iteratee/ZoomCache.hs b/Data/Iteratee/ZoomCache.hs --- a/Data/Iteratee/ZoomCache.hs +++ b/Data/Iteratee/ZoomCache.hs @@ -155,21 +155,21 @@ readGlobalHeader :: (Functor m, MonadIO m) => Iteratee [Word8] m Global readGlobalHeader = do v <- readVersion - n <- zReadInt32 - p <- readRational64 - b <- readRational64 + n <- readInt32be + p <- readRational64be + b <- readRational64be _u <- L.pack <$> (I.joinI $ I.takeUpTo 20 I.stream2list) return $ Global v n p b Nothing readTrackHeader :: (Functor m, MonadIO m) => Iteratee [Word8] m (TrackNo, TrackSpec) readTrackHeader = do - trackNo <- zReadInt32 + trackNo <- readInt32be trackType <- readTrackType drType <- readDataRateType - rate <- readRational64 + rate <- readRational64be - byteLength <- zReadInt32 + byteLength <- readInt32be name <- L.pack <$> (I.joinI $ I.takeUpTo byteLength I.stream2list) let spec = TrackSpec trackType drType rate name @@ -183,11 +183,11 @@ => IntMap TrackSpec -> Iteratee [Word8] m (TrackNo, Maybe Packet) readPacket specs = do - trackNo <- zReadInt32 - entryTime <- TS <$> zReadInt64 - exitTime <- TS <$> zReadInt64 - byteLength <- zReadInt32 - count <- zReadInt32 + trackNo <- readInt32be + entryTime <- TS <$> readInt64be + exitTime <- TS <$> readInt64be + count <- readInt32be + byteLength <- readInt32be packet <- case IM.lookup trackNo specs of Just TrackSpec{..} -> do let readTS = readTimeStamps specDRType count entryTime @@ -197,13 +197,13 @@ ts <- readTS return . Just $ (Packet trackNo entryTime exitTime count - (ZoomRaw . fromList $ d) ts) + (ZoomRaw d) ts) ZInt -> do (d :: [Int]) <- replicateM count readRaw ts <- readTS return . Just $ (Packet trackNo entryTime exitTime count - (ZoomRaw . fromList $ d) ts) + (ZoomRaw d) ts) Nothing -> do I.drop byteLength return Nothing @@ -216,17 +216,17 @@ ConstantDR -> do return $ take count [unTS entry ..] VariableDR -> do - replicateM count zReadInt64 + replicateM count readInt64be readSummaryBlock :: (Functor m, MonadIO m) => IntMap TrackSpec -> Iteratee [Word8] m (TrackNo, Maybe ZoomSummary) readSummaryBlock specs = do - trackNo <- zReadInt32 - lvl <- zReadInt32 - entryTime <- TS <$> zReadInt64 - exitTime <- TS <$> zReadInt64 - byteLength <- zReadInt32 + trackNo <- readInt32be + lvl <- readInt32be + entryTime <- TS <$> readInt64be + exitTime <- TS <$> readInt64be + byteLength <- readInt32be summary <- case IM.lookup trackNo specs of Just TrackSpec{..} -> do @@ -276,21 +276,24 @@ readVersion :: (Functor m, MonadIO m) => Iteratee [Word8] m Version readVersion = do - vMaj <- zReadInt16 - vMin <- zReadInt16 + vMaj <- readInt16be + vMin <- readInt16be return $ Version vMaj vMin readTrackType :: (Functor m, MonadIO m) => Iteratee [Word8] m TrackType readTrackType = do - n <- zReadInt16 - case n of - 0 -> return ZDouble - 1 -> return ZInt - _ -> error "Bad tracktype" + tt <- I.joinI $ I.takeUpTo 8 I.stream2list + maybe (error "Unknown track type") return (parseTrackType . L.pack $ tt) +parseTrackType :: L.ByteString -> Maybe TrackType +parseTrackType h + | h == trackTypeDouble = Just ZDouble + | h == trackTypeInt = Just ZInt + | otherwise = Nothing + readDataRateType :: (Functor m, MonadIO m) => Iteratee [Word8] m DataRateType readDataRateType = do - n <- zReadInt16 + n <- readInt16be case n of 0 -> return ConstantDR 1 -> return VariableDR diff --git a/Data/Iteratee/ZoomCache/Utils.hs b/Data/Iteratee/ZoomCache/Utils.hs --- a/Data/Iteratee/ZoomCache/Utils.hs +++ b/Data/Iteratee/ZoomCache/Utils.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS -Wall #-} ---------------------------------------------------------------------- -- | @@ -13,12 +14,12 @@ ---------------------------------------------------------------------- module Data.Iteratee.ZoomCache.Utils ( - -- * Raw data iteratees - zReadInt16 - , zReadInt32 - , zReadInt64 - , zReadFloat64be - , readRational64 + -- * Raw data reading iteratees + readInt16be + , readInt32be + , readInt64be + , readDouble64be + , readRational64be ) where import Control.Applicative ((<$>)) @@ -30,35 +31,43 @@ import Data.Word import Unsafe.Coerce (unsafeCoerce) -zReadInt16 :: (Functor m, MonadIO m) => Iteratee [Word8] m Int -zReadInt16 = fromIntegral . u16_to_s16 <$> I.endianRead2 I.MSB +-- | Read 2 bytes as a big-endian Int. +readInt16be :: (Functor m, MonadIO m) => Iteratee [Word8] m Int +readInt16be = fromIntegral . u16_to_s16 <$> I.endianRead2 I.MSB where u16_to_s16 :: Word16 -> Int16 u16_to_s16 = fromIntegral -zReadInt32 :: (Functor m, MonadIO m) => Iteratee [Word8] m Int -zReadInt32 = fromIntegral . u32_to_s32 <$> I.endianRead4 I.MSB +-- | Read 4 bytes as a big-endian Int. +readInt32be :: (Functor m, MonadIO m) => Iteratee [Word8] m Int +readInt32be = fromIntegral . u32_to_s32 <$> I.endianRead4 I.MSB where u32_to_s32 :: Word32 -> Int32 u32_to_s32 = fromIntegral -zReadInt64 :: (Functor m, MonadIO m) => Iteratee [Word8] m Integer -zReadInt64 = fromIntegral . u64_to_s64 <$> I.endianRead8 I.MSB +-- | Read 8 bytes as a big-endian Integer +readInt64be :: (Functor m, MonadIO m, Integral a) => Iteratee [Word8] m a +readInt64be = fromIntegral . u64_to_s64 <$> I.endianRead8 I.MSB where u64_to_s64 :: Word64 -> Int64 u64_to_s64 = fromIntegral +{-# SPECIALIZE INLINE readInt64be :: (Functor m, MonadIO m) => Iteratee [Word8] m Int #-} +{-# SPECIALIZE INLINE readInt64be :: (Functor m, MonadIO m) => Iteratee [Word8] m Int64 #-} -zReadFloat64be :: (Functor m, MonadIO m) => Iteratee [Word8] m Double -zReadFloat64be = do +-- | Read 8 bytes as a big-endian Double +readDouble64be :: (Functor m, MonadIO m) => Iteratee [Word8] m Double +readDouble64be = do n <- I.endianRead8 I.MSB return (unsafeCoerce n :: Double) -readRational64 :: (Functor m, MonadIO m) => Iteratee [Word8] m Rational -readRational64 = do - num <- zReadInt64 - den <- zReadInt64 +-- | Read 16 bytes as a big-endian Rational, encoded as an 8 byte +-- big endian numerator followed by an 8 byte big endian denominator. +readRational64be :: (Functor m, MonadIO m) => Iteratee [Word8] m Rational +readRational64be = do + (num :: Integer) <- readInt64be + (den :: Integer) <- readInt64be if (den == 0) then return 0 - else return $ (fromIntegral num) % (fromIntegral den) + else return (num % den) diff --git a/Data/ZoomCache/Codec.hs b/Data/ZoomCache/Codec.hs --- a/Data/ZoomCache/Codec.hs +++ b/Data/ZoomCache/Codec.hs @@ -9,40 +9,41 @@ -- Stability : unstable -- Portability : unknown -- --- Interface for implementing ZoomCache codec instances. --- This module re-exports the interfaces required for developing --- zoom-cache codecs. +-- This module re-exports the required interfaces and some useful +-- functions for developing zoom-cache codecs. -- +-- To implement a codec, specify 'SummaryData' and 'SummaryWork' types, and +-- implement the methods of the ZoomReadable and ZoomWritable classes. +-- -- For sample implementations, read the source of the provided instances -- "Data.ZoomCache.Int" and "Data.ZoomCache.Double". ---------------------------------------------------------------------- module Data.ZoomCache.Codec ( - -- * Interfaces + -- * Required interfaces ZoomReadable(..) - , RawData() , SummaryData() , ZoomWritable(..) , ZoomWrite(..) - -- * ZoomCache Types - , TimeStamp(..) + -- * Raw data reading iteratees + , readInt16be + , readInt32be + , readInt64be + , readDouble64be + , readRational64be - -- * Raw data iteratees - , zReadInt16 - , zReadInt32 - , zReadInt64 - , zReadFloat64be - , readRational64 + -- * ZoomWrite instance helpers + , writeData + , writeDataVBR - -- * Binary data helpers + -- * Builders , fromRational64 , fromIntegral32be , fromDouble - -- * Write instance helpers - , writeData - , writeDataVBR + -- * ZoomCache Types + , TimeStamp(..) ) where import Blaze.ByteString.Builder.ZoomCache diff --git a/Data/ZoomCache/Common.hs b/Data/ZoomCache/Common.hs --- a/Data/ZoomCache/Common.hs +++ b/Data/ZoomCache/Common.hs @@ -13,29 +13,30 @@ ---------------------------------------------------------------------- module Data.ZoomCache.Common ( - -- * Types - TimeStamp(..) - , TrackType(..) - , DataRateType(..) - , TrackNo + -- * Types + TimeStamp(..) + , TrackType(..) + , DataRateType(..) + , TrackNo - -- * Global header - , Global(..) + -- * Global header + , Global(..) - -- * CacheFile - , CacheFile(..) - , mkCacheFile - , fiFull + -- * CacheFile + , CacheFile(..) + , mkCacheFile + , fiFull - -- * Version - , Version(..) + -- * Version + , Version(..) - -- * Track specification - , TrackMap - , TrackSpec(..) + -- * Track specification + , TrackMap + , TrackSpec(..) ) where import qualified Data.ByteString.Lazy as L +import Data.Int import Data.IntMap (IntMap) import qualified Data.IntMap as IM @@ -43,10 +44,10 @@ type TrackNo = Int -data TimeStamp = TS { unTS :: !Integer } +data TimeStamp = TS { unTS :: {-# UNPACK #-}!Int64 } deriving (Eq, Ord, Show) -data Version = Version Int Int +data Version = Version !Int !Int deriving (Eq, Show) data Global = Global @@ -63,10 +64,10 @@ -- | A specification of the type and name of each track data TrackSpec = TrackSpec - { specType :: TrackType - , specDRType :: DataRateType - , specRate :: Rational - , specName :: L.ByteString + { specType :: !TrackType + , specDRType :: !DataRateType + , specRate :: {-# UNPACK #-}!Rational + , specName :: !L.ByteString } deriving (Show) diff --git a/Data/ZoomCache/Double.hs b/Data/ZoomCache/Double.hs --- a/Data/ZoomCache/Double.hs +++ b/Data/ZoomCache/Double.hs @@ -1,25 +1,62 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wall -fno-warn-orphans #-} ---------------------------------------------------------------------- --- | --- Module : Data.ZoomCache.Double --- Copyright : Conrad Parker --- License : BSD3-style (see LICENSE) --- --- Maintainer : Conrad Parker --- Stability : unstable --- Portability : unknown --- --- Default codec implementation for values of type Double. This module --- implements the interfaces documented in "Data.ZoomCache.Codec". --- View the module source for enlightenment. +{- | + Module : Data.ZoomCache.Double + Copyright : Conrad Parker + License : BSD3-style (see LICENSE) + + Maintainer : Conrad Parker + Stability : unstable + Portability : unknown + +Default codec implementation for values of type Double. This module +implements the interfaces documented in "Data.ZoomCache.Codec". +View the module source for enlightenment. + +The table below describes the encoding of SummaryData for Double. + +@ + | ... | -35 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Entry (double) | 36-39 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 40-43 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Exit (double) | 44-47 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 48-51 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Min (double) | 52-55 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 56-59 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Max (double) | 60-63 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 64-67 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Avg (double) | 68-71 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 72-75 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | RMS (double) | 76-79 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 80-83 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +@ + +Field encoding formats: + + @double@: big-endian IEEE 754-2008 binary64 (IEEE 754-1985 double) + +-} ---------------------------------------------------------------------- module Data.ZoomCache.Double ( - RawData(..) - , SummaryData(..) + SummaryData(..) , SummaryWork(..) )where @@ -38,32 +75,28 @@ -- Read instance ZoomReadable Double where - data RawData Double = RDDouble [Double] - - readRaw = zReadFloat64be - fromList = RDDouble - data SummaryData Double = SummaryDouble - { summaryDoubleEntry :: Double - , summaryDoubleExit :: Double - , summaryDoubleMin :: Double - , summaryDoubleMax :: Double - , summaryDoubleAvg :: Double - , summaryDoubleRMS :: Double + { summaryDoubleEntry :: {-# UNPACK #-}!Double + , summaryDoubleExit :: {-# UNPACK #-}!Double + , summaryDoubleMin :: {-# UNPACK #-}!Double + , summaryDoubleMax :: {-# UNPACK #-}!Double + , summaryDoubleAvg :: {-# UNPACK #-}!Double + , summaryDoubleRMS :: {-# UNPACK #-}!Double } + readRaw = readDouble64be readSummary = readSummaryDouble - prettyRawData = prettyPacketDouble + prettyRaw = prettyPacketDouble prettySummaryData = prettySummaryDouble -prettyPacketDouble :: RawData Double -> [String] -prettyPacketDouble (RDDouble ds) = map (printf "%.3f") ds +prettyPacketDouble :: Double -> String +prettyPacketDouble = printf "%.3f" readSummaryDouble :: (Functor m, MonadIO m) => Iteratee [Word8] m (SummaryData Double) readSummaryDouble = do - [en,ex,mn,mx,avg,rms] <- replicateM 6 zReadFloat64be + [en,ex,mn,mx,avg,rms] <- replicateM 6 readDouble64be return (SummaryDouble en ex mn mx avg rms) prettySummaryDouble :: SummaryData Double -> String @@ -94,13 +127,13 @@ instance ZoomWritable Double where data SummaryWork Double = SummaryWorkDouble - { ztsdTime :: TimeStamp - , ztsdEntry :: Double - , ztsdExit :: Double - , ztsdMin :: Double - , ztsdMax :: Double - , ztsdSum :: Double - , ztsdSumSq :: Double + { ztsdTime :: {-# UNPACK #-}!TimeStamp + , ztsdEntry :: {-# UNPACK #-}!Double + , ztsdExit :: {-# UNPACK #-}!Double + , ztsdMin :: {-# UNPACK #-}!Double + , ztsdMax :: {-# UNPACK #-}!Double + , ztsdSum :: {-# UNPACK #-}!Double + , ztsdSumSq :: {-# UNPACK #-}!Double } fromRaw = fromDouble fromSummaryData = fromSummaryDouble @@ -153,7 +186,7 @@ , ztsdSumSq = ztsdSumSq + (d*d * dur) } where - dur = fromIntegral $ (unTS t) - (unTS ztsdTime) + !dur = fromIntegral $ (unTS t) - (unTS ztsdTime) appendSummaryDouble :: Double -> SummaryData Double -> Double -> SummaryData Double @@ -171,5 +204,5 @@ durSum } where - durSum = dur1 + dur2 + !durSum = dur1 + dur2 diff --git a/Data/ZoomCache/Dump.hs b/Data/ZoomCache/Dump.hs --- a/Data/ZoomCache/Dump.hs +++ b/Data/ZoomCache/Dump.hs @@ -66,7 +66,7 @@ Nothing -> show . unTS tds = zip (map pretty (packetTimeStamps strmPacket)) vals vals = f (packetData strmPacket) - f (ZoomRaw a) = prettyRawData a + f (ZoomRaw a) = map prettyRaw a dumpData _ _ = return () dumpSummary :: TrackNo -> Stream -> IO () diff --git a/Data/ZoomCache/Format.hs b/Data/ZoomCache/Format.hs --- a/Data/ZoomCache/Format.hs +++ b/Data/ZoomCache/Format.hs @@ -1,34 +1,42 @@ {-# OPTIONS -Wall #-} ---------------------------------------------------------------------- --- | --- Module : Data.ZoomCache.Format --- Copyright : Conrad Parker --- License : BSD3-style (see LICENSE) --- --- Maintainer : Conrad Parker --- Stability : unstable --- Portability : unknown --- --- zoom-cache format specification --- --- All fields are big-endian. +{- | + Module : Data.ZoomCache.Format + Copyright : Conrad Parker + License : BSD3-style (see LICENSE) + + Maintainer : Conrad Parker + Stability : unstable + Portability : unknown + +zoom-cache format specification + +Field encoding formats: + + @int16@: 16bit big endian + + @int32@: 32bit big endian + + @double@: big-endian IEEE 754-2008 binary64 (IEEE 754-1985 double) +-} ---------------------------------------------------------------------- module Data.ZoomCache.Format ( - - -- * Global header - globalHeader - , versionMajor - , versionMinor + -- * Global header + globalHeader + , versionMajor + , versionMinor - -- * Track header - , trackHeader + -- * Track header + , trackHeader + , trackTypeDouble + , trackTypeInt - -- * Packet header - , packetHeader + -- * Packet header + , packetHeader - -- * Summary header - , summaryHeader + -- * Summary header + , summaryHeader ) where import qualified Data.ByteString.Lazy as L @@ -44,42 +52,42 @@ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Identifier | 0-3 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 4-7 + | ... | 4-7 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Version major | Version minor | 8-11 + | Version major (int16) | Version minor (int16) | 8-11 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | No. tracks | 12-15 + | No. tracks (int32) | 12-15 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Presentationtime numerator | 16-19 + | Presentationtime numerator (int64) | 16-19 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 20-23 + | ... | 20-23 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Presentationtime denominator | 24-27 + | Presentationtime denominator (int64) | 24-27 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 28-31 + | ... | 28-31 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Basetime numerator | 32-35 + | Basetime numerator (int64) | 32-35 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 36-39 + | ... | 36-39 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Basetime denominator | 40-43 + | Basetime denominator (int64) | 40-43 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 44-47 + | ... | 44-47 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | UTC | 48-51 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 52-55 + | ... | 52-55 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 56-59 + | ... | 56-59 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 60-63 + | ... | 60-63 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 64-67 + | ... | 64-67 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ @ -} --- | Magic identifier at the beginning of a zoom-cache file. +-- Magic identifier at the beginning of a zoom-cache file. globalHeader :: L.ByteString globalHeader = LC.pack "\xe5ZXhe4d\0" @@ -101,37 +109,43 @@ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Identifier | 0-3 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 4-7 + | ... | 4-7 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Track no. | 8-11 + | Track no. (int32) | 8-11 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Type | Flag: 0=CBR, 1=VBR | 12-15 + | Codec identifier | 12-15 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Datarate numerator | 16-19 + | ... | 16-19 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 20-23 + | Flag: 0=CBR, 1=VBR | 20-23 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Datarate denominator | 24-27 + | Datarate numerator (int64) | 24-27 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 28-31 + | ... | 28-31 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Length of name in bytes | 32-35 + | Datarate denominator (int64) | 32-35 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Name (UTF-8) ... | 36- + | ... | 36-39 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Length of name in bytes (int32) | 40-43 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Name (UTF-8) ... | 44- + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ @ -Type: 0 64 bit IEEE754 floating point (Double) - 1 32 bit signed integer (Int32) - Datarate: numerator 0 indicates variable bitrate (all data values are timestamped) -} --- | Identifier for track headers +-- Identifier for track headers trackHeader :: L.ByteString trackHeader = LC.pack "\xe5ZXtRcK\0" +trackTypeDouble :: L.ByteString +trackTypeDouble = LC.pack "ZOOMf64b" +trackTypeInt :: L.ByteString +trackTypeInt = LC.pack "ZOOMi32b" + {- | Raw Data Packet header: @@ -142,21 +156,21 @@ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Identifier | 0-3 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 4-7 + | ... | 4-7 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Track no. | 8-11 + | Track no. (int32) | 8-11 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Entry Timestamp | 12-15 + | Entry Timestamp (int64) | 12-15 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | ... | 16-19 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Exit TImestamp | 20-23 + | Exit TImestamp (int64) | 20-23 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | ... | 24-27 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Payload length in bytes (remainder of packet) | 28-31 + | Count of data points COUNT (int32) | 28-31 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Count of data points COUNT | 32-35 + | Payload length in bytes (remainder of packet) (int32) | 32-35 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Data ... | 36-39 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ @@ -172,14 +186,14 @@ TS = 28 + (COUNT * sizeof(Type)) -} --- | Identifier for packet headers +-- Identifier for packet headers packetHeader :: L.ByteString packetHeader = LC.pack "\xe5ZXp4ck\0" {- | -Summary Data Packet header (IEEE754 floating point): +Summary Data Packet header: @ 0 1 2 3 @@ -187,94 +201,31 @@ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Identifier | 0-3 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 4-7 + | ... | 4-7 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Track no. | 8-11 + | Track no. (int32) | 8-11 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Level | 12-15 + | Level (int32) | 12-15 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Entry Timestamp | 16-19 + | Entry Timestamp (int64) | 16-19 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | ... | 20-23 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Exit Timestamp | 24-27 + | Exit Timestamp (int64) | 24-27 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | ... | 28-31 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Summary length in bytes | 32-35 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Entry (double) | 36-39 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 40-43 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Exit (double) | 44-47 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 48-51 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Min (double) | 52-55 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 56-59 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Max (double) | 60-63 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 64-67 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Avg (double) | 68-71 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 72-75 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | RMS (double) | 76-79 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 80-83 + | Summary length in bytes (int32) | 32-35 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Summary Data ... | 36- @ --} -{- | - -Summary Data Packet header (signed 32-bit integer) +Some default encodings of Summary Data are provided in modules +"Data.ZoomCache.Double" and "Data.ZoomCache.Int". -@ - 0 1 2 3 - 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1| Byte - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Identifier | 0-3 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 4-7 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Track no. | 8-11 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Level | 12-15 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Entry Timestamp | 16-19 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | ... | 20-23 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Exit Timestamp | 24-27 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | ... | 28-31 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Summary length in bytes | 32-35 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Entry (int32) | 36-39 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Exit (int32) | 40-43 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Min (int32) | 44-47 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Max (int32) | 48-51 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Avg (double) | 52-55 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 56-59 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | RMS (double) | 60-63 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 64-67 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -@ -} --- | Identifier for summary headers + +-- Identifier for summary headers summaryHeader :: L.ByteString summaryHeader = LC.pack "\xe5ZX5umm\0" diff --git a/Data/ZoomCache/Int.hs b/Data/ZoomCache/Int.hs --- a/Data/ZoomCache/Int.hs +++ b/Data/ZoomCache/Int.hs @@ -1,25 +1,56 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wall -fno-warn-orphans #-} ---------------------------------------------------------------------- --- | --- Module : Data.ZoomCache.Int --- Copyright : Conrad Parker --- License : BSD3-style (see LICENSE) --- --- Maintainer : Conrad Parker --- Stability : unstable --- Portability : unknown --- --- Default codec implementation for values of type Int. This module --- implements the interfaces documented in "Data.ZoomCache.Codec". --- View the module source for enlightenment. +{- | + Module : Data.ZoomCache.Int + Copyright : Conrad Parker + License : BSD3-style (see LICENSE) + + Maintainer : Conrad Parker + Stability : unstable + Portability : unknown + +Default codec implementation for values of type Int. This module +implements the interfaces documented in "Data.ZoomCache.Codec". +View the module source for enlightenment. + +The table below describes the encoding of SummaryData for Int. + +@ + | ... | -35 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Entry (int32) | 36-39 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Exit (int32) | 40-43 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Min (int32) | 44-47 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Max (int32) | 48-51 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Avg (double) | 52-55 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 56-59 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | RMS (double) | 60-63 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 64-67 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +@ + +Field encoding formats: + + @int32@: 32bit big endian + + @double@: big-endian IEEE 754-2008 binary64 (IEEE 754-1985 double) + +-} ---------------------------------------------------------------------- module Data.ZoomCache.Int ( - RawData(..) - , SummaryData(..) + SummaryData(..) , SummaryWork(..) )where @@ -37,33 +68,29 @@ -- Read instance ZoomReadable Int where - data RawData Int = RDInt [Int] - - readRaw = zReadInt32 - fromList = RDInt - data SummaryData Int = SummaryInt - { summaryIntEntry :: Int - , summaryIntExit :: Int - , summaryIntMin :: Int - , summaryIntMax :: Int - , summaryIntAvg :: Double - , summaryIntRMS :: Double + { summaryIntEntry :: {-# UNPACK #-}!Int + , summaryIntExit :: {-# UNPACK #-}!Int + , summaryIntMin :: {-# UNPACK #-}!Int + , summaryIntMax :: {-# UNPACK #-}!Int + , summaryIntAvg :: {-# UNPACK #-}!Double + , summaryIntRMS :: {-# UNPACK #-}!Double } + readRaw = readInt32be readSummary = readSummaryInt - prettyRawData = prettyPacketInt + prettyRaw = prettyPacketInt prettySummaryData = prettySummaryInt -prettyPacketInt :: RawData Int -> [String] -prettyPacketInt (RDInt ds) = map show ds +prettyPacketInt :: Int -> String +prettyPacketInt = show readSummaryInt :: (Functor m, MonadIO m) => Iteratee [Word8] m (SummaryData Int) readSummaryInt = do - [en,ex,mn,mx] <- replicateM 4 zReadInt32 - [avg,rms] <- replicateM 2 zReadFloat64be + [en,ex,mn,mx] <- replicateM 4 readInt32be + [avg,rms] <- replicateM 2 readDouble64be return (SummaryInt en ex mn mx avg rms) prettySummaryInt :: SummaryData Int -> String @@ -94,13 +121,13 @@ instance ZoomWritable Int where data SummaryWork Int = SummaryWorkInt - { ztsiTime :: TimeStamp - , ztsiEntry :: Int - , ztsiExit :: Int - , ztsiMin :: Int - , ztsiMax :: Int - , ztsiSum :: Int - , ztsiSumSq :: Double + { ztsiTime :: {-# UNPACK #-}!TimeStamp + , ztsiEntry :: {-# UNPACK #-}!Int + , ztsiExit :: {-# UNPACK #-}!Int + , ztsiMin :: {-# UNPACK #-}!Int + , ztsiMax :: {-# UNPACK #-}!Int + , ztsiSum :: {-# UNPACK #-}!Int + , ztsiSumSq :: {-# UNPACK #-}!Double } fromRaw = fromIntegral32be @@ -155,7 +182,7 @@ , ztsiSumSq = ztsiSumSq + fromIntegral (i*i * dur) } where - dur = fromIntegral $ (unTS t) - (unTS ztsiTime) + !dur = fromIntegral $ (unTS t) - (unTS ztsiTime) appendSummaryInt :: Double -> SummaryData Int -> Double -> SummaryData Int @@ -173,5 +200,5 @@ durSum } where - durSum = dur1 + dur2 + !durSum = dur1 + dur2 diff --git a/Data/ZoomCache/Types.hs b/Data/ZoomCache/Types.hs --- a/Data/ZoomCache/Types.hs +++ b/Data/ZoomCache/Types.hs @@ -19,7 +19,6 @@ module Data.ZoomCache.Types ( -- * Classes ZoomReadable(..) - , RawData() , ZoomWritable(..) , ZoomRaw(..) @@ -39,6 +38,7 @@ import Blaze.ByteString.Builder import Control.Monad.Trans (MonadIO) import Data.Dynamic +import Data.Int import Data.IntMap (IntMap) import Data.Iteratee (Iteratee) import Data.Word @@ -67,44 +67,67 @@ } -- | The duration covered by a summary, in units of 1 / the track's datarate -summaryDuration :: Summary a -> Integer +summaryDuration :: Summary a -> Int64 summaryDuration s = (unTS $ summaryExitTime s) - (unTS $ summaryEntryTime s) ------------------------------------------------------------ -- Read +-- | A codec instance must specify a 'SummaryData' type, +-- and implement all methods of this class. class ZoomReadable a where - data RawData a :: * + -- | Summaries of a subsequence of values of type 'a'. In the default + -- instances for 'Int' and 'Double', this is a record containing values + -- such as the maximum, minimum and mean of the subsequence. + data SummaryData a :: * + + -- | An iteratee to read one value of type 'a' from a stream of '[Word8]'. readRaw :: (Functor m, MonadIO m) => Iteratee [Word8] m a - fromList :: [a] -> RawData a - data SummaryData a :: * + -- | An iteratee to read one value of type 'SummaryData a' from a stream + -- of '[Word8]'. readSummary :: (Functor m, MonadIO m) => Iteratee [Word8] m (SummaryData a) - prettyRawData :: RawData a -> [String] + -- | Pretty printing, used for dumping values of type 'a'. + prettyRaw :: a -> String + + -- | Pretty printing for values of type 'SummaryData a'. prettySummaryData :: SummaryData a -> String -- typeOfSummaryData :: SummaryData a -> TypeRep -data ZoomRaw = forall a . ZoomReadable a => ZoomRaw (RawData a) +data ZoomRaw = forall a . ZoomReadable a => ZoomRaw [a] data ZoomSummary = forall a . ZoomReadable a => ZoomSummary (Summary a) ------------------------------------------------------------ -- Write +-- | A codec instance must additionally specify a 'SummaryWork' type class ZoomWritable a where + -- | Intermediate calculations data SummaryWork a :: * + -- | Serialize a value of type 'a' fromRaw :: a -> Builder + + -- | Serialize a 'SummaryData a' fromSummaryData :: SummaryData a -> Builder + -- | Generate a new 'SummaryWork a', given an initial timestamp. initSummaryWork :: TimeStamp -> SummaryWork a - toSummaryData :: Double -> SummaryWork a -> SummaryData a + + -- | Update a 'SummaryData' with the value of 'a' occuring at the + -- given 'TimeStamp'. updateSummaryData :: Int -> TimeStamp -> a -> SummaryWork a -> SummaryWork a + + -- | Finalize a 'SummaryWork a', generating a 'SummaryData a'. + toSummaryData :: Double -> SummaryWork a -> SummaryData a + + -- | Append two 'SummaryData' appendSummaryData :: Double -> SummaryData a -> Double -> SummaryData a -> SummaryData a diff --git a/Data/ZoomCache/Write.hs b/Data/ZoomCache/Write.hs --- a/Data/ZoomCache/Write.hs +++ b/Data/ZoomCache/Write.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} @@ -73,7 +74,7 @@ data ZoomWHandle = ZoomWHandle { whHandle :: Handle - , whTrackWork :: IntMap TrackWork + , whTrackWork :: !(IntMap TrackWork) , whDeferred :: IntMap Builder , whWriteData :: Bool } @@ -82,11 +83,11 @@ { twSpec :: TrackSpec , twBuilder :: Builder , twTSBuilder :: Builder - , twCount :: Int - , twWatermark :: Int - , twEntryTime :: TimeStamp - , twExitTime :: TimeStamp , twWriter :: Maybe ZoomWork + , twCount :: {-# UNPACK #-}!Int + , twWatermark :: {-# UNPACK #-}!Int + , twEntryTime :: {-# UNPACK #-}!TimeStamp + , twExitTime :: {-# UNPACK #-}!TimeStamp } ---------------------------------------------------------------------- @@ -154,7 +155,8 @@ -- | Create a track map for a stream of a given type, as track no. 1 oneTrack :: TrackType -> DataRateType -> Rational -> L.ByteString -> TrackMap -oneTrack zType drType rate name = IM.singleton 1 (TrackSpec zType drType rate name) +oneTrack !zType !drType !rate !name = IM.singleton 1 (TrackSpec zType drType rate name) +{-# INLINABLE oneTrack #-} -- | Query the maximum number of data points to buffer for a given track before -- forcing a flush of all buffered data and summaries. @@ -198,7 +200,7 @@ -- Data incTimeStamp :: TimeStamp -> TimeStamp -incTimeStamp (TS t) = TS (t+1) +incTimeStamp (TS t) = let t' = (t+1) in t' `seq` (TS t') incTime :: TrackNo -> ZoomW () incTime trackNo = modifyTrack trackNo $ \tw -> tw @@ -233,9 +235,9 @@ when doRaw $ modifyTrack trackNo $ \z -> z { twBuilder = twBuilder z <> fromRaw d } - modifyTrack trackNo $ \z -> z - { twCount = twCount z + 1 - , twWriter = updateWork (twCount z) (twExitTime z) d (twWriter z) + modifyTrack trackNo $ \z -> let c = (twCount z) in c `seq` z + { twCount = c + 1 + , twWriter = updateWork c (twExitTime z) d (twWriter z) } flushIfNeeded trackNo @@ -251,9 +253,9 @@ , twTSBuilder = twTSBuilder z <> fromTimeStamp t } - modifyTrack trackNo $ \z -> z - { twCount = twCount z + 1 - , twWriter = updateWork (twCount z) t d (twWriter z) + modifyTrack trackNo $ \z -> let c = (twCount z) in c `seq` z + { twCount = c + 1 + , twWriter = updateWork c t d (twWriter z) } flushIfNeeded trackNo @@ -284,8 +286,8 @@ , fromIntegral32be trackNo , fromTimeStamp twEntryTime , fromTimeStamp twExitTime - , fromIntegral32be (len twBuilder + len twTSBuilder) , fromIntegral32be twCount + , fromIntegral32be (len twBuilder + len twTSBuilder) , twBuilder , twTSBuilder ] @@ -293,7 +295,7 @@ len = L.length . toLazyByteString mkTrackWork :: TrackSpec -> TimeStamp -> Int -> TrackWork -mkTrackWork spec entry w = TrackWork +mkTrackWork !spec !entry !w = TrackWork { twSpec = spec , twBuilder = mempty , twTSBuilder = mempty @@ -315,11 +317,11 @@ -> Maybe ZoomWork -> Maybe ZoomWork -updateWork count t d Nothing = Just (ZoomWork IM.empty (Just cw)) +updateWork !count !t !d Nothing = Just (ZoomWork IM.empty (Just cw)) where cw = updateSummaryData count t d (initSummaryWork t) -updateWork count t d (Just (ZoomWork l Nothing)) = +updateWork !count !t !d (Just (ZoomWork l Nothing)) = case cw'm of Just _ -> Just (ZoomWork l cw'm) Nothing -> Nothing @@ -328,7 +330,7 @@ Just d' -> Just (updateSummaryData count t d' (initSummaryWork t)) Nothing -> Nothing -updateWork count t d (Just (ZoomWork l (Just cw))) = +updateWork !count !t !d (Just (ZoomWork l (Just cw))) = case cw'm of Just _ -> Just (ZoomWork l cw'm) Nothing -> Nothing diff --git a/tools/zoom-cache.hs b/tools/zoom-cache.hs --- a/tools/zoom-cache.hs +++ b/tools/zoom-cache.hs @@ -137,7 +137,7 @@ ------------------------------------------------------------ doubles :: [Double] -doubles = take 1000000 $ map ((* 1000.0) . sin) [0.0, 0.01 ..] +doubles = take 10000000 $ map ((* 1000.0) . sin) [0.0, 0.01 ..] ints :: [Int] ints = map round doubles diff --git a/zoom-cache.cabal b/zoom-cache.cabal --- a/zoom-cache.cabal +++ b/zoom-cache.cabal @@ -7,7 +7,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.3.0.0 +Version: 0.4.0.0 -- A short (one-line) description of the package. Synopsis: A streamable, seekable, zoomable cache file format @@ -24,6 +24,12 @@ for zoom-cache files. . What's neat about this format and library? Glad you asked! + . + * Data can be stored at variable or constant rates. For variable rate + data, a timestamp is explicitly written into the file for every value, + which is useful for recording events that occur at unpredictable times. + Constant rate is useful for regularly sampled data, like most digital + audio and video recordings. . * While writing a file, summary blocks (such as minimum, maximum, mean and RMS values) are written out every n samples. The summary blocks