diff --git a/Blaze/ByteString/Builder/ZoomCache.hs b/Blaze/ByteString/Builder/ZoomCache.hs new file mode 100644 --- /dev/null +++ b/Blaze/ByteString/Builder/ZoomCache.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# OPTIONS -Wall #-} +---------------------------------------------------------------------- +-- | +-- Module : Blaze.ByteString.Builder.ZoomCache +-- Copyright : Conrad Parker +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Conrad Parker +-- Stability : unstable +-- Portability : unknown +-- +-- Blaze-builder utility functions for writing ZoomCache files. +---------------------------------------------------------------------- + +module Blaze.ByteString.Builder.ZoomCache ( + -- * Creating builders for ZoomCache types + fromTimeStamp + + -- * Creating builders from numeric types used by ZoomCache + , fromDouble + , fromIntegral32be + , fromRational64 +) where + +import Blaze.ByteString.Builder +import Data.Monoid +import Data.Ratio +import Data.Word +import Unsafe.Coerce (unsafeCoerce) + +import Data.ZoomCache.Common + +---------------------------------------------------------------------- +-- Creating builders for ZoomCache types. + +-- | Serialize a 'TimeStamp' in 64bit big endian format. +fromTimeStamp :: TimeStamp -> Builder +fromTimeStamp = fromInt64be . fromIntegral . unTS + +---------------------------------------------------------------------- +-- Creating builders from numeric types used by ZoomCache. + +-- | Serialize a 'Double' in big-endian IEEE 754-2008 binary64 format +-- (IEEE 754-1985 double format). +fromDouble :: Double -> Builder +fromDouble = fromWord64be . toWord64 + where + toWord64 :: Double -> Word64 + toWord64 = unsafeCoerce + +-- | Serialize an 'Integral' in 32bit big endian format. +fromIntegral32be :: forall a . (Integral a) => a -> Builder +fromIntegral32be = fromInt32be . fromIntegral + +-- | Serialize a 'Rational' as a sequence of two 64bit big endian format +-- integers. +fromRational64 :: Rational -> Builder +fromRational64 r = mconcat + [ fromInt64be . fromIntegral . numerator $ r + , fromInt64be . fromIntegral . denominator $ r + ] + diff --git a/Blaze/ByteString/Builder/ZoomCache/Internal.hs b/Blaze/ByteString/Builder/ZoomCache/Internal.hs new file mode 100644 --- /dev/null +++ b/Blaze/ByteString/Builder/ZoomCache/Internal.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# OPTIONS -Wall #-} +---------------------------------------------------------------------- +-- | +-- Module : Blaze.ByteString.Builder.ZoomCache.Internal +-- Copyright : Conrad Parker +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Conrad Parker +-- Stability : unstable +-- Portability : unknown +-- +-- Blaze-builder utility functions for writing ZoomCache files. +---------------------------------------------------------------------- + +module Blaze.ByteString.Builder.ZoomCache.Internal ( + -- * Builders + fromDataRateType + , fromGlobal + , fromSummary + , fromTrackNo + , fromTrackType +) where + +import Blaze.ByteString.Builder +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Lazy.Char8 as LC +import Data.Monoid + +import Blaze.ByteString.Builder.ZoomCache +import Data.ZoomCache.Common +import Data.ZoomCache.Format +import Data.ZoomCache.Types + +---------------------------------------------------------------------- +-- Creating builders for ZoomCache types. + +fromDataRateType :: DataRateType -> Builder +fromDataRateType ConstantDR = fromInt16be 0 +fromDataRateType VariableDR = fromInt16be 1 + +fromGlobal :: Global -> Builder +fromGlobal Global{..} = mconcat + [ fromLazyByteString globalHeader + , mconcat $ + [ fromVersion version + , fromIntegral32be noTracks + , fromRational64 presentationTime + , fromRational64 baseTime + ] + , fromLazyByteString $ LC.pack (replicate 20 '\0') -- UTCTime + ] + +fromSummary :: ZoomWritable a => Summary a -> Builder +fromSummary s@Summary{..} = mconcat [ fromSummaryHeader s, l, d] + where + d = fromSummaryData summaryData + l = fromIntegral32be . L.length . toLazyByteString $ d + +fromSummaryHeader :: Summary a -> Builder +fromSummaryHeader s = mconcat + [ fromLazyByteString summaryHeader + , fromIntegral32be . summaryTrack $ s + , fromIntegral32be . summaryLevel $ s + , fromTimeStamp . summaryEntryTime $ s + , fromTimeStamp . summaryExitTime $ s + ] + +fromTrackNo :: TrackNo -> Builder +fromTrackNo = fromInt32be . fromIntegral + +fromTrackType :: TrackType -> Builder +fromTrackType ZDouble = fromInt16be 0 +fromTrackType ZInt = fromInt16be 1 + +fromVersion :: Version -> Builder +fromVersion (Version vMaj vMin) = mconcat + [ fromInt16be . fromIntegral $ vMaj + , fromInt16be . fromIntegral $ vMin + ] + diff --git a/Data/Iteratee/ZoomCache.hs b/Data/Iteratee/ZoomCache.hs --- a/Data/Iteratee/ZoomCache.hs +++ b/Data/Iteratee/ZoomCache.hs @@ -1,5 +1,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS -Wall #-} ---------------------------------------------------------------------- -- | @@ -42,14 +44,17 @@ import qualified Data.Iteratee as I import qualified Data.Iteratee.ListLike as LL import Data.Maybe -import Data.Ratio import Data.Word -import Unsafe.Coerce (unsafeCoerce) +import Data.Iteratee.ZoomCache.Utils import Data.ZoomCache.Common -import Data.ZoomCache.Packet -import Data.ZoomCache.Summary +import Data.ZoomCache.Format +import Data.ZoomCache.Types +-- XXX: Remove these +import Data.ZoomCache.Double() +import Data.ZoomCache.Int() + ---------------------------------------------------------------------- data Stream = @@ -61,7 +66,7 @@ | StreamSummary { strmFile :: CacheFile , strmTrack :: TrackNo - , strmSummary :: Summary + , strmSummary :: ZoomSummary } | StreamNull @@ -100,12 +105,14 @@ (trackNo, packet) <- readPacket (cfSpecs cf) return (cf, StreamPacket cf trackNo (fromJust packet)) Just SummaryHeader -> do - (trackNo, summary) <- readSummary (cfSpecs cf) + (trackNo, summary) <- readSummaryBlock (cfSpecs cf) return (cf, StreamSummary cf trackNo (fromJust summary)) _ -> return (cf, StreamNull) ------------------------------------------------------------ +data HeaderType = GlobalHeader | TrackHeader | PacketHeader | SummaryHeader + parseHeader :: L.ByteString -> Maybe HeaderType parseHeader h | h == globalHeader = Just GlobalHeader @@ -183,26 +190,38 @@ count <- zReadInt32 packet <- case IM.lookup trackNo specs of Just TrackSpec{..} -> do - d <- case specType of + let readTS = readTimeStamps specDRType count entryTime + case specType of ZDouble -> do - PDDouble <$> replicateM count zRead + (d :: [Double]) <- replicateM count readRaw + ts <- readTS + return . Just $ + (Packet trackNo entryTime exitTime count + (ZoomRaw . fromList $ d) ts) ZInt -> do - PDInt <$> replicateM count zRead - ts <- map TS <$> case specDRType of - ConstantDR -> do - return $ take count [unTS entryTime ..] - VariableDR -> do - replicateM count zReadInt64 - return $ Just (Packet trackNo entryTime exitTime count d ts) + (d :: [Int]) <- replicateM count readRaw + ts <- readTS + return . Just $ + (Packet trackNo entryTime exitTime count + (ZoomRaw . fromList $ d) ts) Nothing -> do I.drop byteLength return Nothing return (trackNo, packet) + where + readTimeStamps :: (Functor m, MonadIO m) + => DataRateType -> Int -> TimeStamp + -> Iteratee [Word8] m [TimeStamp] + readTimeStamps drType count entry = map TS <$> case drType of + ConstantDR -> do + return $ take count [unTS entry ..] + VariableDR -> do + replicateM count zReadInt64 -readSummary :: (Functor m, MonadIO m) - => IntMap TrackSpec - -> Iteratee [Word8] m (TrackNo, Maybe Summary) -readSummary specs = do +readSummaryBlock :: (Functor m, MonadIO m) + => IntMap TrackSpec + -> Iteratee [Word8] m (TrackNo, Maybe ZoomSummary) +readSummaryBlock specs = do trackNo <- zReadInt32 lvl <- zReadInt32 entryTime <- TS <$> zReadInt64 @@ -213,15 +232,13 @@ Just TrackSpec{..} -> do case specType of ZDouble -> do - let n = flip div 8 byteLength - [en,ex,mn,mx,avg,rms] <- replicateM n zReadFloat64be - return $ Just (SummaryDouble trackNo lvl entryTime exitTime - en ex mn mx avg rms) + (sd :: SummaryData Double) <- readSummary + return . Just . ZoomSummary $ + Summary trackNo lvl entryTime exitTime sd ZInt -> do - [en,ex,mn,mx] <- replicateM 4 zReadInt32 - [avg,rms] <- replicateM 2 zReadFloat64be - return $ Just (SummaryInt trackNo lvl entryTime exitTime - en ex mn mx avg rms) + (sd :: SummaryData Int) <- readSummary + return . Just . ZoomSummary $ + Summary trackNo lvl entryTime exitTime sd Nothing -> do I.drop byteLength return Nothing @@ -247,7 +264,7 @@ -- | Map a monadic 'Summary' processing function over an entire zoom-cache file. mapSummaries :: (Functor m, MonadIO m) - => (Summary -> m ()) + => (ZoomSummary -> m ()) -> Iteratee [Word8] m () mapSummaries f = mapStream process where @@ -278,50 +295,3 @@ 0 -> return ConstantDR 1 -> return VariableDR _ -> error "Bad data rate type" - ----------------------------------------------------------------------- - -zReadInt16 :: (Functor m, MonadIO m) => Iteratee [Word8] m Int -zReadInt16 = 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 - 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 - where - u64_to_s64 :: Word64 -> Int64 - u64_to_s64 = fromIntegral - -zReadFloat64be :: (Functor m, MonadIO m) => Iteratee [Word8] m Double -zReadFloat64be = 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 - if (den == 0) - then return 0 - else return $ (fromIntegral num) % (fromIntegral den) - ----------------------------------------------------------------------- - -class ZReadable a where - zRead :: (Functor m, MonadIO m) => Iteratee [Word8] m a - zStreamType :: (a, TrackType) - -instance ZReadable Double where - zRead = zReadFloat64be - zStreamType = (undefined, ZDouble) - -instance ZReadable Int where - zRead = zReadInt32 - zStreamType = (undefined, ZInt) diff --git a/Data/Iteratee/ZoomCache/Utils.hs b/Data/Iteratee/ZoomCache/Utils.hs new file mode 100644 --- /dev/null +++ b/Data/Iteratee/ZoomCache/Utils.hs @@ -0,0 +1,64 @@ +{-# OPTIONS -Wall #-} +---------------------------------------------------------------------- +-- | +-- Module : Data.Iteratee.ZoomCache.Utils +-- Copyright : Conrad Parker +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Conrad Parker +-- Stability : unstable +-- Portability : unknown +-- +-- Iteratee reading of ZoomCache files. +---------------------------------------------------------------------- + +module Data.Iteratee.ZoomCache.Utils ( + -- * Raw data iteratees + zReadInt16 + , zReadInt32 + , zReadInt64 + , zReadFloat64be + , readRational64 +) where + +import Control.Applicative ((<$>)) +import Control.Monad.Trans (MonadIO) +import Data.Int +import Data.Iteratee (Iteratee) +import qualified Data.Iteratee as I +import Data.Ratio +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 + 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 + 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 + where + u64_to_s64 :: Word64 -> Int64 + u64_to_s64 = fromIntegral + +zReadFloat64be :: (Functor m, MonadIO m) => Iteratee [Word8] m Double +zReadFloat64be = 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 + if (den == 0) + then return 0 + else return $ (fromIntegral num) % (fromIntegral den) + + diff --git a/Data/ZoomCache.hs b/Data/ZoomCache.hs new file mode 100644 --- /dev/null +++ b/Data/ZoomCache.hs @@ -0,0 +1,62 @@ +{-# OPTIONS -Wall #-} +---------------------------------------------------------------------- +-- | +-- Module : Data.ZoomCache +-- Copyright : Conrad Parker +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Conrad Parker +-- Stability : unstable +-- Portability : unknown +-- +-- API for implementing ZoomCache applications +---------------------------------------------------------------------- + +module Data.ZoomCache ( + -- * Types + TimeStamp(..) + , TrackNo + , TrackType(..) + , DataRateType(..) + + , CacheFile(..) + + , ZoomReadable(..) + + , ZoomRaw(..) + , ZoomSummary(..) + , Packet(..) + , Summary(..) + + -- * Track specification + , TrackMap + , TrackSpec(..) + + -- * The ZoomWrite class + , ZoomWrite(..) + + -- * The ZoomW monad + , ZoomW + , withFileWrite + , flush + + -- * Watermarks + , watermark + , setWatermark + + -- * TrackSpec helpers + , oneTrack + + -- * Iteratee parsers + , module Data.Iteratee.ZoomCache + + -- * Pretty printing + , module Data.ZoomCache.Pretty +) where + +import Data.ZoomCache.Write + +import Data.Iteratee.ZoomCache +import Data.ZoomCache.Common +import Data.ZoomCache.Pretty +import Data.ZoomCache.Types diff --git a/Data/ZoomCache/Binary.hs b/Data/ZoomCache/Binary.hs deleted file mode 100644 --- a/Data/ZoomCache/Binary.hs +++ /dev/null @@ -1,130 +0,0 @@ -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# OPTIONS -Wall #-} ----------------------------------------------------------------------- --- | --- Module : Data.ZoomCache.Write --- Copyright : Conrad Parker --- License : BSD3-style (see LICENSE) --- --- Maintainer : Conrad Parker --- Stability : unstable --- Portability : unknown --- --- Blaze-builder utility functions for writing ZoomCache files. ----------------------------------------------------------------------- - -module Data.ZoomCache.Binary ( - -- * Builders - encInt - , encInt64 - , encDbl - , fromRational64 - , fromGlobal - , fromTrackType - , fromDataRateType - , fromTrackNo - , fromSummary - - -- * Helpers - , toWord64 -) where - -import Blaze.ByteString.Builder hiding (flush) -import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString.Lazy.Char8 as LC -import Data.Monoid -import Data.Ratio -import Data.Word -import Unsafe.Coerce (unsafeCoerce) - -import Data.ZoomCache.Common -import Data.ZoomCache.Summary - ----------------------------------------------------------------------- --- Builders for local types - -fromGlobal :: Global -> Builder -fromGlobal Global{..} = mconcat - [ fromLazyByteString globalHeader - , mconcat $ - [ fromVersion version - , encInt noTracks - , fromRational64 presentationTime - , fromRational64 baseTime - ] - , fromLazyByteString $ LC.pack (replicate 20 '\0') -- UTCTime - ] - -fromVersion :: Version -> Builder -fromVersion (Version vMaj vMin) = mconcat - [ fromInt16be . fromIntegral $ vMaj - , fromInt16be . fromIntegral $ vMin - ] - -fromTrackType :: TrackType -> Builder -fromTrackType ZDouble = fromInt16be 0 -fromTrackType ZInt = fromInt16be 1 - -fromDataRateType :: DataRateType -> Builder -fromDataRateType ConstantDR = fromInt16be 0 -fromDataRateType VariableDR = fromInt16be 1 - -fromTrackNo :: TrackNo -> Builder -fromTrackNo = fromInt32be . fromIntegral - -fromSummary :: Summary -> Builder -fromSummary s@SummaryDouble{..} = mconcat [ fromSummaryHeader s, l, d] - where - d = mconcat $ map encDbl - [ summaryDoubleEntry - , summaryDoubleExit - , summaryDoubleMin - , summaryDoubleMax - , summaryAvg - , summaryRMS - ] - l = encInt . L.length . toLazyByteString $ d -fromSummary s@SummaryInt{..} = mconcat [ fromSummaryHeader s, l, d] - where - d = mconcat $ map encInt - [ summaryIntEntry - , summaryIntExit - , summaryIntMin - , summaryIntMax - ] ++ map encDbl - [ summaryAvg - , summaryRMS - ] - l = encInt . L.length . toLazyByteString $ d - -fromSummaryHeader :: Summary -> Builder -fromSummaryHeader s = mconcat - [ fromLazyByteString summaryHeader - , encInt . summaryTrack $ s - , encInt . summaryLevel $ s - , encInt64 . unTS . summaryEntryTime $ s - , encInt64 . unTS . summaryExitTime $ s - ] - ----------------------------------------------------------------------- --- Binary data helpers - -fromRational64 :: Rational -> Builder -fromRational64 r = mconcat - [ fromInt64be . fromIntegral . numerator $ r - , fromInt64be . fromIntegral . denominator $ r - ] - -encInt :: forall a . (Integral a) => a -> Builder -encInt = fromInt32be . fromIntegral - -encInt64 :: forall a . (Integral a) => a -> Builder -encInt64 = fromInt64be . fromIntegral - -encDbl :: Double -> Builder -encDbl = fromWord64be . toWord64 - -toWord64 :: Double -> Word64 -toWord64 = unsafeCoerce - diff --git a/Data/ZoomCache/Codec.hs b/Data/ZoomCache/Codec.hs new file mode 100644 --- /dev/null +++ b/Data/ZoomCache/Codec.hs @@ -0,0 +1,52 @@ +{-# OPTIONS -Wall #-} +---------------------------------------------------------------------- +-- | +-- Module : Data.ZoomCache.Codec +-- Copyright : Conrad Parker +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Conrad Parker +-- Stability : unstable +-- Portability : unknown +-- +-- Interface for implementing ZoomCache codec instances. +-- This module re-exports the interfaces required for developing +-- zoom-cache codecs. +-- +-- For sample implementations, read the source of the provided instances +-- "Data.ZoomCache.Int" and "Data.ZoomCache.Double". +---------------------------------------------------------------------- + +module Data.ZoomCache.Codec ( + -- * Interfaces + ZoomReadable(..) + , RawData() + , SummaryData() + , ZoomWritable(..) + , ZoomWrite(..) + + -- * ZoomCache Types + , TimeStamp(..) + + -- * Raw data iteratees + , zReadInt16 + , zReadInt32 + , zReadInt64 + , zReadFloat64be + , readRational64 + + -- * Binary data helpers + , fromRational64 + , fromIntegral32be + , fromDouble + + -- * Write instance helpers + , writeData + , writeDataVBR +) where + +import Blaze.ByteString.Builder.ZoomCache +import Data.Iteratee.ZoomCache.Utils +import Data.ZoomCache.Common +import Data.ZoomCache.Types +import Data.ZoomCache.Write diff --git a/Data/ZoomCache/Common.hs b/Data/ZoomCache/Common.hs --- a/Data/ZoomCache/Common.hs +++ b/Data/ZoomCache/Common.hs @@ -14,15 +14,13 @@ module Data.ZoomCache.Common ( -- * Types - HeaderType(..) - , TimeStamp(..) + TimeStamp(..) , TrackType(..) , DataRateType(..) , TrackNo -- * Global header , Global(..) - , globalHeader -- * CacheFile , CacheFile(..) @@ -31,239 +29,23 @@ -- * Version , Version(..) - , versionMajor - , versionMinor -- * Track specification , TrackMap , TrackSpec(..) - - -- * Track header - , trackHeader - - -- * Packet header - , packetHeader - - -- * Summary header - , summaryHeader ) where import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString.Lazy.Char8 as LC import Data.IntMap (IntMap) import qualified Data.IntMap as IM ------------------------------------------------------------ -{- - -All fields are big-endian. - -Global header: - - 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 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Version major | Version minor | 8-11 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | No. tracks | 12-15 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Presentationtime numerator | 16-19 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 20-23 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Presentationtime denominator | 24-27 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 28-31 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Basetime numerator | 32-35 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 36-39 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Basetime denominator | 40-43 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 44-47 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | UTC | 48-51 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 52-55 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 56-59 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 60-63 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 64-67 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - -Track header: - - 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 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Type | Flag: 0=CBR, 1=VBR | 12-15 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Datarate numerator | 16-19 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 20-23 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Datarate denominator | 24-27 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 28-31 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Length of name in bytes | 32-35 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Name (UTF-8) ... | 36- - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - -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) - -Raw Data Packet header: - - 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 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Entry Timestamp | 12-15 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | ... | 16-19 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Exit TImestamp | 20-23 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | ... | 24-27 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Payload length in bytes (remainder of packet) | 28-31 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Count of data points COUNT | 32-35 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Data ... | 36-39 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | ... | 40- - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Timestamps ... | TS- - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | ... | - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - -Timestamps block is only present if VBR (datarate numerator is 0) - -TS = 28 + (COUNT * sizeof(Type)) - - -Summary Data Packet header (IEEE754 floating point): - - 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 (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 Data Packet header (signed 32-bit integer) - - 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 - +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - --} - type TrackNo = Int data TimeStamp = TS { unTS :: !Integer } deriving (Eq, Ord, Show) -data HeaderType = GlobalHeader | TrackHeader | PacketHeader | SummaryHeader - data Version = Version Int Int deriving (Eq, Show) @@ -313,31 +95,4 @@ -- | Determine whether all tracks of a 'CacheFile' are specified fiFull :: CacheFile -> Bool fiFull (CacheFile g specs) = IM.size specs == noTracks g - ------------------------------------------------------------- --- Magic - --- | Magic identifier at the beginning of a zoom-cache file. -globalHeader :: L.ByteString -globalHeader = LC.pack "\xe5ZXhe4d\0" - --- | The major version encoded by this library -versionMajor :: Int -versionMajor = 1 - --- | The minor version encoded by this library -versionMinor :: Int -versionMinor = 0 - --- | Identifier for track headers -trackHeader :: L.ByteString -trackHeader = LC.pack "\xe5ZXtRcK\0" - --- | Identifier for packet headers -packetHeader :: L.ByteString -packetHeader = LC.pack "\xe5ZXp4ck\0" - --- | Identifier for summary headers -summaryHeader :: L.ByteString -summaryHeader = LC.pack "\xe5ZX5umm\0" diff --git a/Data/ZoomCache/Double.hs b/Data/ZoomCache/Double.hs new file mode 100644 --- /dev/null +++ b/Data/ZoomCache/Double.hs @@ -0,0 +1,175 @@ +{-# 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 ( + RawData(..) + , SummaryData(..) + , SummaryWork(..) +)where + +import Blaze.ByteString.Builder +import Control.Monad (replicateM) +import Control.Monad.Trans (MonadIO) +import Data.Iteratee (Iteratee) +import Data.Monoid +import Data.Word +import Text.Printf + +import Data.ZoomCache.Codec +import Numeric.FloatMinMax + +---------------------------------------------------------------------- +-- 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 + } + + readSummary = readSummaryDouble + + prettyRawData = prettyPacketDouble + prettySummaryData = prettySummaryDouble + +prettyPacketDouble :: RawData Double -> [String] +prettyPacketDouble (RDDouble ds) = map (printf "%.3f") ds + +readSummaryDouble :: (Functor m, MonadIO m) + => Iteratee [Word8] m (SummaryData Double) +readSummaryDouble = do + [en,ex,mn,mx,avg,rms] <- replicateM 6 zReadFloat64be + return (SummaryDouble en ex mn mx avg rms) + +prettySummaryDouble :: SummaryData Double -> String +prettySummaryDouble SummaryDouble{..} = concat + [ printf "\tentry: %.3f\texit: %.3f\tmin: %.3f\tmax: %.3f\t" + summaryDoubleEntry summaryDoubleExit summaryDoubleMin summaryDoubleMax + , printf "avg: %.3f\trms: %.3f" summaryDoubleAvg summaryDoubleRMS + ] + +{- + typeOfSummaryData = typeOfSummaryDouble + +typeOfSummaryDouble :: SummaryData Double -> TypeRep +typeOfSummaryDouble _ = mkTyConApp tyCon [d,d,d,d] + where + tyCon = mkTyCon3 "zoom-cache" "Data.ZoomCache.Types" "SummaryDouble" + d = typeOf (undefined :: Double) +-} + +---------------------------------------------------------------------- +-- Write + +instance ZoomWrite Double where + write = writeData + +instance ZoomWrite (TimeStamp, Double) where + write = writeDataVBR + +instance ZoomWritable Double where + data SummaryWork Double = SummaryWorkDouble + { ztsdTime :: TimeStamp + , ztsdEntry :: Double + , ztsdExit :: Double + , ztsdMin :: Double + , ztsdMax :: Double + , ztsdSum :: Double + , ztsdSumSq :: Double + } + fromRaw = fromDouble + fromSummaryData = fromSummaryDouble + + initSummaryWork = initSummaryDouble + toSummaryData = mkSummaryDouble + updateSummaryData = updateSummaryDouble + appendSummaryData = appendSummaryDouble + +initSummaryDouble :: TimeStamp -> SummaryWork Double +initSummaryDouble entry = SummaryWorkDouble + { ztsdTime = entry + , ztsdEntry = 0.0 + , ztsdExit = 0.0 + , ztsdMin = floatMax + , ztsdMax = negate floatMax + , ztsdSum = 0.0 + , ztsdSumSq = 0.0 + } + +mkSummaryDouble :: Double -> SummaryWork Double -> SummaryData Double +mkSummaryDouble dur SummaryWorkDouble{..} = SummaryDouble + { summaryDoubleEntry = ztsdEntry + , summaryDoubleExit = ztsdExit + , summaryDoubleMin = ztsdMin + , summaryDoubleMax = ztsdMax + , summaryDoubleAvg = ztsdSum / dur + , summaryDoubleRMS = sqrt $ ztsdSumSq / dur + } + +fromSummaryDouble :: SummaryData Double -> Builder +fromSummaryDouble SummaryDouble{..} = mconcat $ map fromDouble + [ summaryDoubleEntry + , summaryDoubleExit + , summaryDoubleMin + , summaryDoubleMax + , summaryDoubleAvg + , summaryDoubleRMS + ] + +updateSummaryDouble :: Int -> TimeStamp -> Double -> SummaryWork Double + -> SummaryWork Double +updateSummaryDouble count t d SummaryWorkDouble{..} = SummaryWorkDouble + { ztsdTime = t + , ztsdEntry = if count == 0 then d else ztsdEntry + , ztsdExit = d + , ztsdMin = min ztsdMin d + , ztsdMax = max ztsdMax d + , ztsdSum = ztsdSum + (d * dur) + , ztsdSumSq = ztsdSumSq + (d*d * dur) + } + where + dur = fromIntegral $ (unTS t) - (unTS ztsdTime) + +appendSummaryDouble :: Double -> SummaryData Double + -> Double -> SummaryData Double + -> SummaryData Double +appendSummaryDouble dur1 s1 dur2 s2 = SummaryDouble + { summaryDoubleEntry = summaryDoubleEntry s1 + , summaryDoubleExit = summaryDoubleExit s2 + , summaryDoubleMin = min (summaryDoubleMin s1) (summaryDoubleMin s2) + , summaryDoubleMax = max (summaryDoubleMax s1) (summaryDoubleMax s2) + , summaryDoubleAvg = ((summaryDoubleAvg s1 * dur1) + + (summaryDoubleAvg s2 * dur2)) / + durSum + , summaryDoubleRMS = sqrt $ ((summaryDoubleRMS s1 * summaryDoubleRMS s1 * dur1) + + (summaryDoubleRMS s2 * summaryDoubleRMS s2 * dur2)) / + durSum + } + where + durSum = dur1 + dur2 + diff --git a/Data/ZoomCache/Dump.hs b/Data/ZoomCache/Dump.hs new file mode 100644 --- /dev/null +++ b/Data/ZoomCache/Dump.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# OPTIONS -Wall #-} +---------------------------------------------------------------------- +-- | +-- Module : Data.ZoomCache.Dump +-- Copyright : Conrad Parker +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Conrad Parker +-- Stability : unstable +-- Portability : unknown +-- +-- Reading of ZoomCache files. +---------------------------------------------------------------------- + +module Data.ZoomCache.Dump ( + -- * Functions + zoomDumpFile + , zoomDumpSummary + , zoomDumpSummaryLevel + , zoomInfoFile +) where + +import Control.Applicative ((<$>)) +import Data.Int +import qualified Data.IntMap as IM +import qualified Data.Iteratee as I +import Text.Printf + +import Data.ZoomCache + +------------------------------------------------------------ + +zoomInfoFile :: FilePath -> IO () +zoomInfoFile path = I.fileDriverRandom iterHeaders path >>= info + +zoomDumpFile :: TrackNo -> FilePath -> IO () +zoomDumpFile trackNo = I.fileDriverRandom (mapStream (dumpData trackNo)) + +zoomDumpSummary :: TrackNo -> FilePath -> IO () +zoomDumpSummary trackNo = I.fileDriverRandom (mapStream (dumpSummary trackNo)) + +zoomDumpSummaryLevel :: TrackNo -> Int -> FilePath -> IO () +zoomDumpSummaryLevel trackNo lvl = I.fileDriverRandom (mapStream (dumpSummaryLevel trackNo lvl)) + +---------------------------------------------------------------------- + +info :: CacheFile -> IO () +info CacheFile{..} = do + putStrLn . prettyGlobal $ cfGlobal + mapM_ (putStrLn . uncurry prettyTrackSpec) . IM.assocs $ cfSpecs + +streamRate :: Stream -> Maybe Rational +streamRate StreamNull = Nothing +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 () + where + pretty = case streamRate s of + Just r -> prettyTimeStamp r + Nothing -> show . unTS + tds = zip (map pretty (packetTimeStamps strmPacket)) vals + vals = f (packetData strmPacket) + f (ZoomRaw a) = prettyRawData a +dumpData _ _ = return () + +dumpSummary :: TrackNo -> Stream -> IO () +dumpSummary trackNo s@StreamSummary{..} + | strmTrack == trackNo = case streamRate s of + Just r -> putStrLn $ f r strmSummary + Nothing -> return () + | otherwise = return () + where + f r (ZoomSummary a) = prettySummary r a +dumpSummary _ _ = return () + +dumpSummaryLevel :: TrackNo -> Int -> Stream -> IO () +dumpSummaryLevel trackNo level s@StreamSummary{..} + | level == opLevel strmSummary && strmTrack == trackNo = dumpSummary trackNo s + | otherwise = return () + where opLevel (ZoomSummary a) = summaryLevel a +dumpSummaryLevel _ _ _ = return () + diff --git a/Data/ZoomCache/Format.hs b/Data/ZoomCache/Format.hs new file mode 100644 --- /dev/null +++ b/Data/ZoomCache/Format.hs @@ -0,0 +1,280 @@ +{-# 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 ( + + -- * Global header + globalHeader + , versionMajor + , versionMinor + + -- * Track header + , trackHeader + + -- * Packet header + , packetHeader + + -- * Summary header + , summaryHeader +) where + +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Lazy.Char8 as LC + +{- | + +Global header: + +@ + 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 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Version major | Version minor | 8-11 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | No. tracks | 12-15 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Presentationtime numerator | 16-19 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 20-23 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Presentationtime denominator | 24-27 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 28-31 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Basetime numerator | 32-35 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 36-39 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Basetime denominator | 40-43 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 44-47 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | UTC | 48-51 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 52-55 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 56-59 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 60-63 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 64-67 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +@ +-} + +-- | Magic identifier at the beginning of a zoom-cache file. +globalHeader :: L.ByteString +globalHeader = LC.pack "\xe5ZXhe4d\0" + +-- | The major version encoded by this library +versionMajor :: Int +versionMajor = 1 + +-- | The minor version encoded by this library +versionMinor :: Int +versionMinor = 0 + +{- | + +Track header: + +@ + 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 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Type | Flag: 0=CBR, 1=VBR | 12-15 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Datarate numerator | 16-19 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 20-23 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Datarate denominator | 24-27 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 28-31 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Length of name in bytes | 32-35 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Name (UTF-8) ... | 36- + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +@ + +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 +trackHeader :: L.ByteString +trackHeader = LC.pack "\xe5ZXtRcK\0" + + +{- | + +Raw Data Packet header: + +@ + 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 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Entry Timestamp | 12-15 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | ... | 16-19 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Exit TImestamp | 20-23 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | ... | 24-27 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Payload length in bytes (remainder of packet) | 28-31 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Count of data points COUNT | 32-35 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Data ... | 36-39 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | ... | 40- + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Timestamps ... | TS- + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | ... | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +@ + +Timestamps block is only present if VBR (datarate numerator is 0) + +TS = 28 + (COUNT * sizeof(Type)) +-} +-- | Identifier for packet headers +packetHeader :: L.ByteString +packetHeader = LC.pack "\xe5ZXp4ck\0" + + +{- | + +Summary Data Packet header (IEEE754 floating point): + +@ + 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 (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 Data Packet header (signed 32-bit integer) + +@ + 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 +summaryHeader :: L.ByteString +summaryHeader = LC.pack "\xe5ZX5umm\0" + diff --git a/Data/ZoomCache/Int.hs b/Data/ZoomCache/Int.hs new file mode 100644 --- /dev/null +++ b/Data/ZoomCache/Int.hs @@ -0,0 +1,177 @@ +{-# 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 ( + RawData(..) + , SummaryData(..) + , SummaryWork(..) +)where + +import Blaze.ByteString.Builder +import Control.Monad (replicateM) +import Control.Monad.Trans (MonadIO) +import Data.Iteratee (Iteratee) +import Data.Monoid +import Data.Word +import Text.Printf + +import Data.ZoomCache.Codec + +---------------------------------------------------------------------- +-- 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 + } + + readSummary = readSummaryInt + + prettyRawData = prettyPacketInt + prettySummaryData = prettySummaryInt + +prettyPacketInt :: RawData Int -> [String] +prettyPacketInt (RDInt ds) = map show ds + +readSummaryInt :: (Functor m, MonadIO m) + => Iteratee [Word8] m (SummaryData Int) +readSummaryInt = do + [en,ex,mn,mx] <- replicateM 4 zReadInt32 + [avg,rms] <- replicateM 2 zReadFloat64be + return (SummaryInt en ex mn mx avg rms) + +prettySummaryInt :: SummaryData Int -> String +prettySummaryInt SummaryInt{..} = concat + [ printf "\tentry: %d\texit: %df\tmin: %d\tmax: %d\t" + summaryIntEntry summaryIntExit summaryIntMin summaryIntMax + , printf "avg: %.3f\trms: %.3f" summaryIntAvg summaryIntRMS + ] + +{- + typeOfSummaryData = typeOfSummaryInt + +typeOfSummaryInt :: SummaryData Int -> TypeRep +typeOfSummaryInt _ = mkTyConApp tyCon [i,i,i,i] + where + tyCon = mkTyCon3 "zoom-cache" "Data.ZoomCache.Types" "SummaryInt" + i = typeOf (undefined :: Int) +-} + +---------------------------------------------------------------------- +-- Write + +instance ZoomWrite Int where + write = writeData + +instance ZoomWrite (TimeStamp, Int) where + write = writeDataVBR + +instance ZoomWritable Int where + data SummaryWork Int = SummaryWorkInt + { ztsiTime :: TimeStamp + , ztsiEntry :: Int + , ztsiExit :: Int + , ztsiMin :: Int + , ztsiMax :: Int + , ztsiSum :: Int + , ztsiSumSq :: Double + } + + fromRaw = fromIntegral32be + fromSummaryData = fromSummaryInt + + initSummaryWork = initSummaryInt + toSummaryData = mkSummaryInt + updateSummaryData = updateSummaryInt + appendSummaryData = appendSummaryInt + +initSummaryInt :: TimeStamp -> SummaryWork Int +initSummaryInt entry = SummaryWorkInt + { ztsiTime = entry + , ztsiEntry = 0 + , ztsiExit = 0 + , ztsiMin = maxBound + , ztsiMax = minBound + , ztsiSum = 0 + , ztsiSumSq = 0 + } + +mkSummaryInt :: Double -> SummaryWork Int -> SummaryData Int +mkSummaryInt dur SummaryWorkInt{..} = SummaryInt + { summaryIntEntry = ztsiEntry + , summaryIntExit = ztsiExit + , summaryIntMin = ztsiMin + , summaryIntMax = ztsiMax + , summaryIntAvg = fromIntegral ztsiSum / dur + , summaryIntRMS = sqrt $ ztsiSumSq / dur + } + +fromSummaryInt :: SummaryData Int -> Builder +fromSummaryInt SummaryInt{..} = mconcat $ map fromIntegral32be + [ summaryIntEntry + , summaryIntExit + , summaryIntMin + , summaryIntMax + ] ++ map fromDouble + [ summaryIntAvg + , summaryIntRMS + ] + +updateSummaryInt :: Int -> TimeStamp -> Int -> SummaryWork Int + -> SummaryWork Int +updateSummaryInt count t i SummaryWorkInt{..} = SummaryWorkInt + { ztsiTime = t + , ztsiEntry = if count == 0 then i else ztsiEntry + , ztsiExit = i + , ztsiMin = min ztsiMin i + , ztsiMax = max ztsiMax i + , ztsiSum = ztsiSum + (i * dur) + , ztsiSumSq = ztsiSumSq + fromIntegral (i*i * dur) + } + where + dur = fromIntegral $ (unTS t) - (unTS ztsiTime) + +appendSummaryInt :: Double -> SummaryData Int + -> Double -> SummaryData Int + -> SummaryData Int +appendSummaryInt dur1 s1 dur2 s2 = SummaryInt + { summaryIntEntry = summaryIntEntry s1 + , summaryIntExit = summaryIntExit s2 + , summaryIntMin = min (summaryIntMin s1) (summaryIntMin s2) + , summaryIntMax = max (summaryIntMax s1) (summaryIntMax s2) + , summaryIntAvg = ((summaryIntAvg s1 * dur1) + + (summaryIntAvg s2 * dur2)) / + durSum + , summaryIntRMS = sqrt $ ((summaryIntRMS s1 * summaryIntRMS s1 * dur1) + + (summaryIntRMS s2 * summaryIntRMS s2 * dur2)) / + durSum + } + where + durSum = dur1 + dur2 + diff --git a/Data/ZoomCache/Packet.hs b/Data/ZoomCache/Packet.hs deleted file mode 100644 --- a/Data/ZoomCache/Packet.hs +++ /dev/null @@ -1,36 +0,0 @@ -{-# OPTIONS -Wall #-} ----------------------------------------------------------------------- --- | --- Module : Data.ZoomCache.Write --- Copyright : Conrad Parker --- License : BSD3-style (see LICENSE) --- --- Maintainer : Conrad Parker --- Stability : unstable --- Portability : unknown --- --- ZoomCache packet definition ----------------------------------------------------------------------- - -module Data.ZoomCache.Packet ( - -- * Types - Packet(..) - , PacketData(..) -) where - -import Data.ZoomCache.Common - ------------------------------------------------------------- - -data PacketData = PDDouble [Double] | PDInt [Int] - -data Packet = Packet - { packetTrack :: TrackNo - , packetEntryTime :: TimeStamp - , packetExitTime :: TimeStamp - , packetCount :: Int - , packetData :: PacketData - , packetTimeStamps :: [TimeStamp] - } - ------------------------------------------------------------- diff --git a/Data/ZoomCache/Pretty.hs b/Data/ZoomCache/Pretty.hs --- a/Data/ZoomCache/Pretty.hs +++ b/Data/ZoomCache/Pretty.hs @@ -25,7 +25,7 @@ import Text.Printf import Data.ZoomCache.Common -import Data.ZoomCache.Summary +import Data.ZoomCache.Types ---------------------------------------------------------------------- @@ -67,33 +67,21 @@ (hrs, minN) = quotRem minT 60 -- | Pretty-print a 'Summary', given a datarate -prettySummary :: Rational -> Summary -> String -prettySummary r s@SummaryDouble{..} = concat - [ prettySummaryTimes r s - , prettySummaryLevel s - , printf "\tentry: %.3f\texit: %.3f\tmin: %.3f\tmax: %.3f\t" - summaryDoubleEntry summaryDoubleExit summaryDoubleMin summaryDoubleMax - , prettySummaryAvgRMS s - ] -prettySummary r s@SummaryInt{..} = concat +prettySummary :: ZoomReadable a => Rational -> Summary a -> String +prettySummary r s = concat [ prettySummaryTimes r s , prettySummaryLevel s - , printf "\tentry: %d\texit: %df\tmin: %d\tmax: %d\t" - summaryIntEntry summaryIntExit summaryIntMin summaryIntMax - , prettySummaryAvgRMS s + , prettySummaryData (summaryData s) ] -prettySummaryTimes :: Rational -> Summary -> String +prettySummaryTimes :: Rational -> Summary a -> String prettySummaryTimes r s = concat [ "[", (prettyTimeStamp r $ summaryEntryTime s) , "-", (prettyTimeStamp r $ summaryExitTime s), "] " ] -prettySummaryLevel :: Summary -> String +prettySummaryLevel :: Summary a -> String prettySummaryLevel s = printf "lvl: %d" (summaryLevel s) - -prettySummaryAvgRMS :: Summary -> String -prettySummaryAvgRMS s = printf "avg: %.3f\trms: %.3f" (summaryAvg s) (summaryRMS s) ---------------------------------------------------------------------- diff --git a/Data/ZoomCache/Read.hs b/Data/ZoomCache/Read.hs deleted file mode 100644 --- a/Data/ZoomCache/Read.hs +++ /dev/null @@ -1,89 +0,0 @@ -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RecordWildCards #-} -{-# OPTIONS -Wall #-} ----------------------------------------------------------------------- --- | --- Module : Data.ZoomCache.Write --- Copyright : Conrad Parker --- License : BSD3-style (see LICENSE) --- --- Maintainer : Conrad Parker --- Stability : unstable --- Portability : unknown --- --- Reading of ZoomCache files. ----------------------------------------------------------------------- - -module Data.ZoomCache.Read ( - -- * Functions - zoomDumpFile - , zoomDumpSummary - , zoomDumpSummaryLevel - , zoomInfoFile -) where - -import Control.Applicative ((<$>)) -import Data.Int -import qualified Data.IntMap as IM -import qualified Data.Iteratee as I -import Text.Printf - -import Data.Iteratee.ZoomCache -import Data.ZoomCache.Common -import Data.ZoomCache.Packet -import Data.ZoomCache.Pretty -import Data.ZoomCache.Summary - ------------------------------------------------------------- - -zoomInfoFile :: FilePath -> IO () -zoomInfoFile path = I.fileDriverRandom iterHeaders path >>= info - -zoomDumpFile :: TrackNo -> FilePath -> IO () -zoomDumpFile trackNo = I.fileDriverRandom (mapStream (dumpData trackNo)) - -zoomDumpSummary :: TrackNo -> FilePath -> IO () -zoomDumpSummary trackNo = I.fileDriverRandom (mapStream (dumpSummary trackNo)) - -zoomDumpSummaryLevel :: TrackNo -> Int -> FilePath -> IO () -zoomDumpSummaryLevel trackNo lvl = I.fileDriverRandom (mapStream (dumpSummaryLevel trackNo lvl)) - ----------------------------------------------------------------------- - -info :: CacheFile -> IO () -info CacheFile{..} = do - putStrLn . prettyGlobal $ cfGlobal - mapM_ (putStrLn . uncurry prettyTrackSpec) . IM.assocs $ cfSpecs - -streamRate :: Stream -> Maybe Rational -streamRate StreamNull = Nothing -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 () - where - pretty = case streamRate s of - Just r -> prettyTimeStamp r - Nothing -> show . unTS - tds = zip (map pretty (packetTimeStamps strmPacket)) vals - vals = case packetData strmPacket of - PDDouble ds -> map (printf "%.3f") ds - PDInt is -> map show is -dumpData _ _ = return () - -dumpSummary :: TrackNo -> Stream -> IO () -dumpSummary trackNo s@StreamSummary{..} - | strmTrack == trackNo = case streamRate s of - Just r -> putStrLn $ prettySummary r strmSummary - Nothing -> return () - | otherwise = return () -dumpSummary _ _ = return () - -dumpSummaryLevel :: TrackNo -> Int -> Stream -> IO () -dumpSummaryLevel trackNo level s@StreamSummary{..} - | level == summaryLevel strmSummary && strmTrack == trackNo = dumpSummary trackNo s - | otherwise = return () -dumpSummaryLevel _ _ _ = return () - diff --git a/Data/ZoomCache/Summary.hs b/Data/ZoomCache/Summary.hs deleted file mode 100644 --- a/Data/ZoomCache/Summary.hs +++ /dev/null @@ -1,97 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} -{-# OPTIONS -Wall #-} ----------------------------------------------------------------------- --- | --- Module : Data.ZoomCache.Write --- Copyright : Conrad Parker --- License : BSD3-style (see LICENSE) --- --- Maintainer : Conrad Parker --- Stability : unstable --- Portability : unknown --- --- ZoomCache Summary definition ----------------------------------------------------------------------- - -module Data.ZoomCache.Summary ( - -- * Types - Summary(..) - , summaryDuration - , appendSummary -) where - -import Data.ZoomCache.Common - ----------------------------------------------------------------------- - --- | A recorded block of summary data -data Summary = SummaryDouble - { summaryTrack :: TrackNo - , summaryLevel :: Int - , summaryEntryTime :: TimeStamp - , summaryExitTime :: TimeStamp - , summaryDoubleEntry :: Double - , summaryDoubleExit :: Double - , summaryDoubleMin :: Double - , summaryDoubleMax :: Double - , summaryAvg :: Double - , summaryRMS :: Double - } - | SummaryInt - { summaryTrack :: TrackNo - , summaryLevel :: Int - , summaryEntryTime :: TimeStamp - , summaryExitTime :: TimeStamp - , summaryIntEntry :: Int - , summaryIntExit :: Int - , summaryIntMin :: Int - , summaryIntMax :: Int - , summaryAvg :: Double - , summaryRMS :: Double - } - deriving (Show) - --- | The duration covered by a summary, in units of 1 / the track's datarate -summaryDuration :: Summary -> Integer -summaryDuration s = (unTS $ summaryExitTime s) - (unTS $ summaryEntryTime s) - --- | Append two Summaries, merging statistical summary data. --- XXX: summaries are only compatible if tracks and levels are equal -appendSummary :: Summary -> Summary -> Summary -appendSummary s1@SummaryDouble{} s2@SummaryDouble{} = SummaryDouble - { summaryTrack = summaryTrack s1 - , summaryLevel = summaryLevel s1 - , summaryEntryTime = summaryEntryTime s1 - , summaryExitTime = summaryExitTime s2 - , summaryDoubleEntry = summaryDoubleEntry s1 - , summaryDoubleExit = summaryDoubleExit s2 - , summaryDoubleMin = min (summaryDoubleMin s1) (summaryDoubleMin s2) - , summaryDoubleMax = max (summaryDoubleMax s1) (summaryDoubleMax s2) - , summaryAvg = ((summaryAvg s1 * dur s1) + - (summaryAvg s2 * dur s2)) / - (dur s1 + dur s2) - , summaryRMS = sqrt $ ((summaryRMS s1 * summaryRMS s1 * dur s1) + - (summaryRMS s2 * summaryRMS s2 * dur s2)) / - (dur s1 + dur s2) - } - where - dur = fromIntegral . summaryDuration -appendSummary s1@SummaryInt{} s2@SummaryInt{} = SummaryInt - { summaryTrack = summaryTrack s1 - , summaryLevel = summaryLevel s1 - , summaryEntryTime = summaryEntryTime s1 - , summaryExitTime = summaryExitTime s2 - , summaryIntEntry = summaryIntEntry s1 - , summaryIntExit = summaryIntExit s2 - , summaryIntMin = min (summaryIntMin s1) (summaryIntMin s2) - , summaryIntMax = max (summaryIntMax s1) (summaryIntMax s2) - , summaryAvg = ((summaryAvg s1 * dur s1) + - (summaryAvg s2 * dur s2)) / - (dur s1 + dur s2) - , summaryRMS = sqrt $ ((summaryRMS s1 * summaryRMS s1 * dur s1) + - (summaryRMS s2 * summaryRMS s2 * dur s2)) / - (dur s1 + dur s2) - } - where - dur = fromIntegral . summaryDuration -appendSummary _ _ = error "Incompatible summaries" diff --git a/Data/ZoomCache/Types.hs b/Data/ZoomCache/Types.hs new file mode 100644 --- /dev/null +++ b/Data/ZoomCache/Types.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS -Wall #-} +---------------------------------------------------------------------- +-- | +-- Module : Data.ZoomCache.Types +-- Copyright : Conrad Parker +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Conrad Parker +-- Stability : unstable +-- Portability : unknown +-- +-- ZoomCache packet and summary types and interfaces +---------------------------------------------------------------------- + +module Data.ZoomCache.Types ( + -- * Classes + ZoomReadable(..) + , RawData() + , ZoomWritable(..) + + , ZoomRaw(..) + + , ZoomSummary(..) + + , ZoomWork(..) + + -- * Types + , Packet(..) + , Summary(..) + , SummaryData() + + , summaryDuration +) where + +import Blaze.ByteString.Builder +import Control.Monad.Trans (MonadIO) +import Data.Dynamic +import Data.IntMap (IntMap) +import Data.Iteratee (Iteratee) +import Data.Word + +import Data.ZoomCache.Common + +------------------------------------------------------------ + +data Packet = Packet + { packetTrack :: TrackNo + , packetEntryTime :: TimeStamp + , packetExitTime :: TimeStamp + , packetCount :: Int + , packetData :: ZoomRaw + , packetTimeStamps :: [TimeStamp] + } + +------------------------------------------------------------ +-- | A recorded block of summary data +data Summary a = Summary + { summaryTrack :: TrackNo + , summaryLevel :: Int + , summaryEntryTime :: TimeStamp + , summaryExitTime :: TimeStamp + , summaryData :: SummaryData a + } + +-- | The duration covered by a summary, in units of 1 / the track's datarate +summaryDuration :: Summary a -> Integer +summaryDuration s = (unTS $ summaryExitTime s) - (unTS $ summaryEntryTime s) + +------------------------------------------------------------ +-- Read + +class ZoomReadable a where + data RawData a :: * + readRaw :: (Functor m, MonadIO m) + => Iteratee [Word8] m a + fromList :: [a] -> RawData a + + data SummaryData a :: * + readSummary :: (Functor m, MonadIO m) + => Iteratee [Word8] m (SummaryData a) + + prettyRawData :: RawData a -> [String] + prettySummaryData :: SummaryData a -> String + -- typeOfSummaryData :: SummaryData a -> TypeRep + +data ZoomRaw = forall a . ZoomReadable a => ZoomRaw (RawData a) + +data ZoomSummary = forall a . ZoomReadable a => ZoomSummary (Summary a) + +------------------------------------------------------------ +-- Write + +class ZoomWritable a where + data SummaryWork a :: * + + fromRaw :: a -> Builder + fromSummaryData :: SummaryData a -> Builder + + initSummaryWork :: TimeStamp -> SummaryWork a + toSummaryData :: Double -> SummaryWork a -> SummaryData a + updateSummaryData :: Int -> TimeStamp -> a + -> SummaryWork a + -> SummaryWork a + appendSummaryData :: Double -> SummaryData a + -> Double -> SummaryData a + -> SummaryData a + +data ZoomWork = forall a . (Typeable a, ZoomWritable a) => ZoomWork + { levels :: IntMap (Summary a -> Summary a) + , currWork :: Maybe (SummaryWork a) + } diff --git a/Data/ZoomCache/Write.hs b/Data/ZoomCache/Write.hs --- a/Data/ZoomCache/Write.hs +++ b/Data/ZoomCache/Write.hs @@ -2,6 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} {-# OPTIONS -Wall #-} ---------------------------------------------------------------------- -- | @@ -20,6 +21,10 @@ -- * The ZoomWrite class ZoomWrite(..) + -- * Instance helpers + , writeData + , writeDataVBR + -- * The ZoomW monad , ZoomW , withFileWrite @@ -42,16 +47,18 @@ import Control.Monad.State import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as LC +import Data.Dynamic import qualified Data.Foldable as Fold import Data.IntMap (IntMap) import qualified Data.IntMap as IM import Data.Monoid import System.IO -import Data.ZoomCache.Binary +import Blaze.ByteString.Builder.ZoomCache +import Blaze.ByteString.Builder.ZoomCache.Internal import Data.ZoomCache.Common -import Data.ZoomCache.Summary -import Numeric.FloatMinMax +import Data.ZoomCache.Format +import Data.ZoomCache.Types ------------------------------------------------------------ @@ -62,24 +69,12 @@ -- | Write a value to an open ZoomCache file. write :: TrackNo -> t -> ZoomW () -instance ZoomWrite Double where - write = writeDouble - -instance ZoomWrite Int where - write = writeInt - -instance ZoomWrite (TimeStamp, Double) where - write = writeDoubleVBR - -instance ZoomWrite (TimeStamp, Int) where - write = writeIntVBR - ------------------------------------------------------------ data ZoomWHandle = ZoomWHandle { whHandle :: Handle , whTrackWork :: IntMap TrackWork - , whDeferred :: IntMap [Summary] + , whDeferred :: IntMap Builder , whWriteData :: Bool } @@ -89,29 +84,9 @@ , twTSBuilder :: Builder , twCount :: Int , twWatermark :: Int - , twLevels :: IntMap (Maybe Summary) , twEntryTime :: TimeStamp , twExitTime :: TimeStamp - , twData :: ZTSData - } - -data ZTSData = ZTSDouble - { ztsTime :: TimeStamp - , ztsdEntry :: Double - , ztsdExit :: Double - , ztsdMin :: Double - , ztsdMax :: Double - , ztsdSum :: Double - , ztsSumSq :: Double - } - | ZTSInt - { ztsTime :: TimeStamp - , ztsiEntry :: Int - , ztsiExit :: Int - , ztsiMin :: Int - , ztsiMax :: Int - , ztsiSum :: Int - , ztsSumSq :: Double + , twWriter :: Maybe ZoomWork } ---------------------------------------------------------------------- @@ -144,17 +119,17 @@ when doRaw $ liftIO $ Fold.mapM_ (L.hPut h) $ IM.mapWithKey bsFromTrack tracks mapM_ (uncurry flushSummary) (IM.assocs tracks) - pending <- concat . IM.elems <$> gets whDeferred - mapM_ writeSummary pending + pending <- mconcat . IM.elems <$> gets whDeferred + liftIO . L.hPut h . toLazyByteString $ pending modify $ \z -> z { whTrackWork = IM.map flushTrack (whTrackWork z) , whDeferred = IM.empty } where flushTrack :: TrackWork -> TrackWork - flushTrack tw = d{twLevels = twLevels tw} + flushTrack tw = d{twWriter = clearWork <$> (twWriter tw)} where - d = mkTrackState (twSpec tw) (twExitTime tw) (twWatermark tw) + d = mkTrackWork (twSpec tw) (twExitTime tw) (twWatermark tw) -- | Open a new ZoomCache file for writing, using a specified 'TrackMap'. openWrite :: TrackMap @@ -175,7 +150,7 @@ -> IntMap TrackWork addTrack trackNo spec = IM.insert trackNo trackState where - trackState = mkTrackState spec (TS 0) 1024 + trackState = mkTrackWork spec (TS 0) 1024 -- | Create a track map for a stream of a given type, as track no. 1 oneTrack :: TrackType -> DataRateType -> Rational -> L.ByteString -> TrackMap @@ -214,7 +189,7 @@ , fromTrackType specType , fromDataRateType specDRType , fromRational64 specRate - , encInt . LC.length $ specName + , fromIntegral32be . LC.length $ specName ] , specName ] @@ -249,84 +224,39 @@ flushNeeded :: TrackWork -> Bool flushNeeded TrackWork{..} = twCount >= twWatermark -writeData :: (ZoomWrite a) - => (a -> Builder) - -> (Int -> TimeStamp -> a -> ZTSData -> ZTSData) - -> TrackNo -> a -> ZoomW () -writeData builder updater trackNo d = do +writeData :: (Typeable a, ZoomWrite a, ZoomWritable a) + => TrackNo -> a -> ZoomW () +writeData trackNo d = do incTime trackNo doRaw <- gets whWriteData when doRaw $ - modifyTrack trackNo $ \z -> z { twBuilder = twBuilder z <> builder d } + modifyTrack trackNo $ \z -> z { twBuilder = twBuilder z <> fromRaw d } modifyTrack trackNo $ \z -> z { twCount = twCount z + 1 - , twData = updater (twCount z) (twExitTime z) d (twData z) + , twWriter = updateWork (twCount z) (twExitTime z) d (twWriter z) } flushIfNeeded trackNo -writeDataVBR :: (ZoomWrite a) - => (a -> Builder) - -> (Int -> TimeStamp -> a -> ZTSData -> ZTSData) - -> TrackNo -> (TimeStamp, a) -> ZoomW () -writeDataVBR builder updater trackNo (t, d) = do +writeDataVBR :: (Typeable a, ZoomWrite a, ZoomWritable a) + => TrackNo -> (TimeStamp, a) -> ZoomW () +writeDataVBR trackNo (t, d) = do setTime trackNo t doRaw <- gets whWriteData when doRaw $ modifyTrack trackNo $ \z -> z - { twBuilder = twBuilder z <> builder d - , twTSBuilder = twTSBuilder z <> - (encInt64 . unTS) t + { twBuilder = twBuilder z <> fromRaw d + , twTSBuilder = twTSBuilder z <> fromTimeStamp t } modifyTrack trackNo $ \z -> z { twCount = twCount z + 1 - , twData = updater (twCount z) t d (twData z) + , twWriter = updateWork (twCount z) t d (twWriter z) } flushIfNeeded trackNo -writeDouble :: TrackNo -> Double -> ZoomW () -writeDouble = writeData (fromWord64be . toWord64) updateZTSDouble - -writeDoubleVBR :: TrackNo -> (TimeStamp, Double) -> ZoomW () -writeDoubleVBR = writeDataVBR (fromWord64be . toWord64) updateZTSDouble - -updateZTSDouble :: Int -> TimeStamp -> Double -> ZTSData -> ZTSData -updateZTSDouble count t d ZTSDouble{..} = ZTSDouble - { ztsTime = t - , ztsdEntry = if count == 0 then d else ztsdEntry - , ztsdExit = d - , ztsdMin = min ztsdMin d - , ztsdMax = max ztsdMax d - , ztsdSum = ztsdSum + (d * dur) - , ztsSumSq = ztsSumSq + (d*d * dur) - } - where - dur = fromIntegral $ (unTS t) - (unTS ztsTime) -updateZTSDouble _ _ _ ZTSInt{..} = error "updateZTSDouble on Int data" - -writeInt :: TrackNo -> Int -> ZoomW () -writeInt = writeData encInt updateZTSInt - -writeIntVBR :: TrackNo -> (TimeStamp, Int) -> ZoomW () -writeIntVBR = writeDataVBR encInt updateZTSInt - -updateZTSInt :: Int -> TimeStamp -> Int -> ZTSData -> ZTSData -updateZTSInt count t i ZTSInt{..} = ZTSInt - { ztsTime = t - , ztsiEntry = if count == 0 then i else ztsiEntry - , ztsiExit = i - , ztsiMin = min ztsiMin i - , ztsiMax = max ztsiMax i - , ztsiSum = ztsiSum + (i * dur) - , ztsSumSq = ztsSumSq + fromIntegral (i*i * dur) - } - where - dur = fromIntegral $ (unTS t) - (unTS ztsTime) -updateZTSInt _ _ _ ZTSDouble{..} = error "updateZTSInt on Double data" - ---------------------------------------------------------------------- -- Global @@ -351,112 +281,116 @@ bsFromTrack :: TrackNo -> TrackWork -> L.ByteString bsFromTrack trackNo TrackWork{..} = toLazyByteString $ mconcat [ fromLazyByteString packetHeader - , encInt trackNo - , encInt64 . unTS $ twEntryTime - , encInt64 . unTS $ twExitTime - , encInt (len twBuilder + len twTSBuilder) - , encInt twCount + , fromIntegral32be trackNo + , fromTimeStamp twEntryTime + , fromTimeStamp twExitTime + , fromIntegral32be (len twBuilder + len twTSBuilder) + , fromIntegral32be twCount , twBuilder , twTSBuilder ] where len = L.length . toLazyByteString -mkTrackState :: TrackSpec -> TimeStamp -> Int -> TrackWork -mkTrackState spec entry w = TrackWork +mkTrackWork :: TrackSpec -> TimeStamp -> Int -> TrackWork +mkTrackWork spec entry w = TrackWork { twSpec = spec , twBuilder = mempty , twTSBuilder = mempty , twCount = 0 , twWatermark = w - , twLevels = IM.empty , twEntryTime = entry , twExitTime = entry - , twData = initZTSData (specType spec) + , twWriter = Nothing } + +---------------------------------------------------------------------- +-- Working state + +clearWork :: ZoomWork -> ZoomWork +clearWork (ZoomWork l _) = ZoomWork l Nothing + +updateWork :: (Typeable b, ZoomWritable b) + => Int -> TimeStamp -> b + -> Maybe ZoomWork + -> Maybe ZoomWork + +updateWork count t d Nothing = Just (ZoomWork IM.empty (Just cw)) where - initZTSData ZDouble = ZTSDouble - { ztsTime = entry - , ztsdEntry = 0.0 - , ztsdExit = 0.0 - , ztsdMin = floatMax - , ztsdMax = negate floatMax - , ztsdSum = 0.0 - , ztsSumSq = 0.0 - } - initZTSData ZInt = ZTSInt - { ztsTime = entry - , ztsiEntry = 0 - , ztsiExit = 0 - , ztsiMin = maxBound - , ztsiMax = minBound - , ztsiSum = 0 - , ztsSumSq = 0 - } + cw = updateSummaryData count t d (initSummaryWork t) +updateWork count t d (Just (ZoomWork l Nothing)) = + case cw'm of + Just _ -> Just (ZoomWork l cw'm) + Nothing -> Nothing + where + cw'm = case (fromDynamic . toDyn $ d) of + Just d' -> Just (updateSummaryData count t d' (initSummaryWork t)) + Nothing -> Nothing + +updateWork count t d (Just (ZoomWork l (Just cw))) = + case cw'm of + Just _ -> Just (ZoomWork l cw'm) + Nothing -> Nothing + where + cw'm = case (fromDynamic . toDyn $ d) of + Just d' -> Just (updateSummaryData count t d' cw) + Nothing -> Nothing + ---------------------------------------------------------------------- -- Summary flushSummary :: TrackNo -> TrackWork -> ZoomW () -flushSummary trackNo trackState@TrackWork{..} = - pushSummary trackState (mkSummary trackNo trackState) +flushSummary trackNo TrackWork{..} = case twWriter of + Just writer -> do + let (writer', bs) = flushWork trackNo twEntryTime twExitTime writer + modify $ \z -> z { whDeferred = IM.unionWith mappend (whDeferred z) bs } + modifyTrack trackNo (\ztt -> ztt { twWriter = Just writer' } ) + _ -> return () -mkSummary :: TrackNo -> TrackWork -> Summary -mkSummary trackNo TrackWork{..} = mk (specType twSpec) +flushWork :: TrackNo -> TimeStamp -> TimeStamp + -> ZoomWork -> (ZoomWork, IntMap Builder) +flushWork _ _ _ op@(ZoomWork _ Nothing) = (op, IM.empty) +flushWork trackNo entryTime exitTime (ZoomWork l (Just cw)) = + (ZoomWork l' (Just cw), bs) where - mk ZDouble = SummaryDouble - { summaryTrack = trackNo - , summaryLevel = 1 - , summaryEntryTime = twEntryTime - , summaryExitTime = twExitTime - , summaryDoubleEntry = ztsdEntry twData - , summaryDoubleExit = ztsdExit twData - , summaryDoubleMin = ztsdMin twData - , summaryDoubleMax = ztsdMax twData - , summaryAvg = ztsdSum twData / dur - , summaryRMS = sqrt $ ztsSumSq twData / dur - } - mk ZInt = SummaryInt + (bs, l') = pushSummary s IM.empty l + s = Summary { summaryTrack = trackNo , summaryLevel = 1 - , summaryEntryTime = twEntryTime - , summaryExitTime = twExitTime - , summaryIntEntry = ztsiEntry twData - , summaryIntExit = ztsiExit twData - , summaryIntMin = ztsiMin twData - , summaryIntMax = ztsiMax twData - , summaryAvg = fromIntegral (ztsiSum twData) / dur - , summaryRMS = sqrt $ ztsSumSq twData / dur + , summaryEntryTime = entryTime + , summaryExitTime = exitTime + , summaryData = toSummaryData dur cw } - dur = fromIntegral $ (unTS twExitTime) - (unTS twEntryTime) + dur = fromIntegral $ (unTS exitTime) - (unTS entryTime) -pushSummary :: TrackWork -> Summary -> ZoomW () -pushSummary zt s = do - deferSummary s - case IM.lookup (summaryLevel s) (twLevels zt) of - Just (Just prev) -> do - let new = (prev `appendSummary` s) { summaryLevel = summaryLevel s + 1 } - insert Nothing - pushSummary zt new - _ -> do - insert (Just s) +pushSummary :: (ZoomWritable a) + => Summary a + -> IntMap Builder -> IntMap (Summary a -> Summary a) + -> (IntMap Builder, IntMap (Summary a -> Summary a)) +pushSummary s bs l = do + case IM.lookup (summaryLevel s) l of + Just g -> pushSummary (g s) bs' cleared + Nothing -> (bs', inserted) where - insert :: Maybe Summary -> ZoomW () - insert x = modifyTrack (summaryTrack s) (\ztt -> - ztt { twLevels = IM.insert (summaryLevel s) x (twLevels ztt) } ) + bs' = IM.insert (summaryLevel s) (fromSummary s) bs + f next = (s `appendSummary` next) { summaryLevel = summaryLevel s + 1 } + inserted = IM.insert (summaryLevel s) f l + cleared = IM.delete (summaryLevel s) l -deferSummary :: Summary -> ZoomW () -deferSummary s = do - modify $ \z -> z - { whDeferred = IM.alter f (summaryLevel s) (whDeferred z) } +-- | Append two Summaries, merging statistical summary data. +-- XXX: summaries are only compatible if tracks and levels are equal +appendSummary :: (ZoomWritable a) => Summary a -> Summary a -> Summary a +appendSummary s1 s2 = Summary + { summaryTrack = summaryTrack s1 + , summaryLevel = summaryLevel s1 + , summaryEntryTime = summaryEntryTime s1 + , summaryExitTime = summaryExitTime s2 + , summaryData = appendSummaryData (dur s1) (summaryData s1) + (dur s2) (summaryData s2) + } where - f Nothing = Just [s] - f (Just pending) = Just (pending ++ [s]) - -writeSummary :: Summary -> ZoomW () -writeSummary s = do - h <- gets whHandle - liftIO . L.hPut h . toLazyByteString . fromSummary $ s + dur = fromIntegral . summaryDuration ------------------------------------------------------------ diff --git a/tools/zoom-cache.hs b/tools/zoom-cache.hs --- a/tools/zoom-cache.hs +++ b/tools/zoom-cache.hs @@ -15,9 +15,8 @@ import System.Console.GetOpt import UI.Command -import Data.ZoomCache.Common -import Data.ZoomCache.Read -import Data.ZoomCache.Write +import Data.ZoomCache +import Data.ZoomCache.Dump ------------------------------------------------------------ diff --git a/zoom-cache.cabal b/zoom-cache.cabal --- a/zoom-cache.cabal +++ b/zoom-cache.cabal @@ -7,14 +7,47 @@ -- 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.2.1.1 +Version: 0.3.0.0 -- A short (one-line) description of the package. Synopsis: A streamable, seekable, zoomable cache file format -- A longer description of the package. -Description: This library provides a monadic writing and iteratee reading - interface for zoom-cache files. +Description: + zoom-cache is a fairly simple data file format for storing and summarizing + streams of time-series data. The purpose of this format is to make it easy + to quickly generate plots; /zooming/ refers to being able to render a + window of data, and being able to quickly change the bounds of the window: + to move around and to zoom in and out. + . + This library provides a monadic writing and an iteratee reading interface + for zoom-cache files. + . + What's neat about this format and library? Glad you asked! + . + * While writing a file, summary blocks (such as minimum, maximum, + mean and RMS values) are written out every n samples. The summary blocks + are hierarchical, such that after two have been written, a new one + containing a merged summary of those is written. After two of those Level + 1 summary blocks have been written, a new Level 2 summary block combining + those is written, and so on. + . + * You can write your own zoom-cache codecs for custom data types, or + to implement custom summary functions. In order to do so you provide a + 'Summary' data type, functions for encoding and decoding raw data values + and summaries, and a function for merging 'Summary' blocks. For details, + see "Data.ZoomCache.Codec". + . + * Writing of raw data blocks is optional, under control of the + application. If you already have the raw data stored in an easily + accessible format, your zoom-cache files may just contain the summary + data. On the other hand, if your input data is the result of expensive + calculations you may want to store it along with the summary data so that + plots of any level of detail can be rendered from a single file. + . + When developing applications that read or write zoom-cache files, it should + be sufficient to import only the module "Data.ZoomCache". + . -- The license under which the package is released. License: BSD3 @@ -49,14 +82,21 @@ Library -- Modules exported by the library. - Exposed-modules: Data.ZoomCache.Binary + Exposed-modules: Blaze.ByteString.Builder.ZoomCache + Data.ZoomCache + Data.ZoomCache.Codec Data.ZoomCache.Common - Data.ZoomCache.Packet + Data.ZoomCache.Double + Data.ZoomCache.Dump + Data.ZoomCache.Format + Data.ZoomCache.Int Data.ZoomCache.Pretty - Data.ZoomCache.Read - Data.ZoomCache.Summary + Data.ZoomCache.Types Data.ZoomCache.Write Data.Iteratee.ZoomCache + Data.Iteratee.ZoomCache.Utils + + Other-modules: Blaze.ByteString.Builder.ZoomCache.Internal Numeric.FloatMinMax -- Packages needed in order to build this package.