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 @@ -19,6 +19,7 @@ fromTimeStamp -- * Creating builders from numeric types used by ZoomCache + , fromFloat , fromDouble , fromIntegral32be , fromRational64 @@ -42,6 +43,15 @@ ---------------------------------------------------------------------- -- Creating builders from numeric types used by ZoomCache. + +-- | Serialize a 'Float' in big-endian IEEE 754-2008 binary32 format +-- (IEEE 754-1985 single format). +fromFloat :: Float -> Builder +fromFloat = fromWord32be . toWord32 + where + toWord32 :: Float -> Word32 + toWord32 = unsafeCoerce +{-# INLINE fromFloat #-} -- | Serialize a 'Double' in big-endian IEEE 754-2008 binary64 format -- (IEEE 754-1985 double format). 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 @@ -20,12 +20,12 @@ , fromGlobal , fromSummary , fromTrackNo - , fromTrackType + , fromCodec ) where import Blaze.ByteString.Builder -import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString.Lazy.Char8 as LC +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as C import Data.Monoid import Blaze.ByteString.Builder.ZoomCache @@ -42,25 +42,25 @@ fromGlobal :: Global -> Builder fromGlobal Global{..} = mconcat - [ fromLazyByteString globalHeader + [ fromByteString globalHeader , mconcat $ [ fromVersion version , fromIntegral32be noTracks , fromRational64 presentationTime , fromRational64 baseTime ] - , fromLazyByteString $ LC.pack (replicate 20 '\0') -- UTCTime + , fromByteString $ C.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 + l = fromIntegral32be . B.length . toByteString $ d fromSummaryHeader :: Summary a -> Builder fromSummaryHeader s = mconcat - [ fromLazyByteString summaryHeader + [ fromByteString summaryHeader , fromIntegral32be . summaryTrack $ s , fromIntegral32be . summaryLevel $ s , fromTimeStamp . summaryEntryTime $ s @@ -70,9 +70,8 @@ fromTrackNo :: TrackNo -> Builder fromTrackNo = fromInt32be . fromIntegral -fromTrackType :: TrackType -> Builder -fromTrackType ZDouble = fromLazyByteString trackTypeDouble -fromTrackType ZInt = fromLazyByteString trackTypeInt +fromCodec :: Codec -> Builder +fromCodec (Codec a) = fromByteString $ trackIdentifier a 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 @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RankNTypes #-} @@ -33,16 +34,17 @@ , mapSummaries ) where -import Control.Applicative ((<$>)) -import Control.Monad (replicateM) -import Control.Monad.Trans (MonadIO) -import qualified Data.ByteString.Lazy as L +import Control.Applicative +import Control.Monad (msum, replicateM) +import Control.Monad.Trans (liftIO, MonadIO) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B import Data.Int import Data.IntMap (IntMap) import qualified Data.IntMap as IM import Data.Iteratee (Iteratee) import qualified Data.Iteratee as I -import qualified Data.Iteratee.ListLike as LL +import qualified Data.ListLike as LL import Data.Maybe import Data.Word @@ -51,10 +53,6 @@ import Data.ZoomCache.Format import Data.ZoomCache.Types --- XXX: Remove these -import Data.ZoomCache.Double() -import Data.ZoomCache.Int() - ---------------------------------------------------------------------- data Stream = @@ -70,11 +68,11 @@ } | StreamNull -instance LL.Nullable Stream where +instance I.Nullable Stream where nullC StreamNull = True nullC _ = False -instance LL.NullPoint Stream where +instance I.NullPoint Stream where empty = StreamNull ---------------------------------------------------------------------- @@ -82,25 +80,26 @@ -- | An enumeratee of a zoom-cache file, from the global header onwards. -- The global and track headers will be transparently read, and the -- 'CacheFile' visible in the 'Stream' elements. -enumCacheFile :: (Functor m, MonadIO m) - => I.Enumeratee [Word8] Stream m a -enumCacheFile iter = do - fi <- iterHeaders +enumCacheFile :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) + => [IdentifyCodec] + -> I.Enumeratee s Stream m a +enumCacheFile mappings iter = do + fi <- iterHeaders mappings enumStream fi iter -- | An enumeratee of zoom-cache data, after global and track headers -- have been read, or if the 'CacheFile' has been acquired elsewhere. -enumStream :: (Functor m, MonadIO m) +enumStream :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) => CacheFile - -> I.Enumeratee [Word8] Stream m a + -> I.Enumeratee s Stream m a enumStream = I.unfoldConvStream go where - go :: (Functor m, MonadIO m) + go :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) => CacheFile - -> Iteratee [Word8] m (CacheFile, Stream) + -> Iteratee s m (CacheFile, Stream) go cf = do header <- I.joinI $ I.takeUpTo 8 I.stream2list - case parseHeader (L.pack header) of + case parseHeader (B.pack header) of Just PacketHeader -> do (trackNo, packet) <- readPacket (cfSpecs cf) return (cf, StreamPacket cf trackNo (fromJust packet)) @@ -113,7 +112,7 @@ data HeaderType = GlobalHeader | TrackHeader | PacketHeader | SummaryHeader -parseHeader :: L.ByteString -> Maybe HeaderType +parseHeader :: ByteString -> Maybe HeaderType parseHeader h | h == globalHeader = Just GlobalHeader | h == trackHeader = Just TrackHeader @@ -126,62 +125,63 @@ -- | Parse only the global and track headers of a zoom-cache file, returning -- a 'CacheFile' -iterHeaders :: (Functor m, MonadIO m) - => I.Iteratee [Word8] m CacheFile -iterHeaders = iterGlobal >>= go +iterHeaders :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) + => [IdentifyCodec] + -> I.Iteratee s m CacheFile +iterHeaders mappings = iterGlobal >>= go where - iterGlobal :: (Functor m, MonadIO m) - => Iteratee [Word8] m CacheFile + iterGlobal :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) + => Iteratee s m CacheFile iterGlobal = do header <- I.joinI $ I.takeUpTo 8 I.stream2list - case parseHeader (L.pack header) of + case parseHeader (B.pack header) of Just GlobalHeader -> mkCacheFile <$> readGlobalHeader _ -> error "No global header" - go :: (Functor m, MonadIO m) + go :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) => CacheFile - -> Iteratee [Word8] m CacheFile + -> Iteratee s m CacheFile go fi = do header <- I.joinI $ I.takeUpTo 8 I.stream2list - case parseHeader (L.pack header) of + case parseHeader (B.pack header) of Just TrackHeader -> do - (trackNo, spec) <- readTrackHeader + (trackNo, spec) <- readTrackHeader mappings let fi' = fi{cfSpecs = IM.insert trackNo spec (cfSpecs fi)} if (fiFull fi') then return fi' else go fi' _ -> return fi -readGlobalHeader :: (Functor m, MonadIO m) => Iteratee [Word8] m Global +readGlobalHeader :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) + => Iteratee s m Global readGlobalHeader = do v <- readVersion + liftIO $ print v n <- readInt32be p <- readRational64be b <- readRational64be - _u <- L.pack <$> (I.joinI $ I.takeUpTo 20 I.stream2list) + _u <- B.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 +readTrackHeader :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) + => [IdentifyCodec] + -> Iteratee s m (TrackNo, TrackSpec) +readTrackHeader mappings = do trackNo <- readInt32be - trackType <- readTrackType + trackType <- readCodec mappings drType <- readDataRateType - rate <- readRational64be - byteLength <- readInt32be - name <- L.pack <$> (I.joinI $ I.takeUpTo byteLength I.stream2list) - - let spec = TrackSpec trackType drType rate name + name <- B.pack <$> (I.joinI $ I.takeUpTo byteLength I.stream2list) - return (trackNo, spec) + return (trackNo, TrackSpec trackType drType rate name) ------------------------------------------------------------ -- Packet, Summary reading -readPacket :: (Functor m, MonadIO m) +readPacket :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) => IntMap TrackSpec - -> Iteratee [Word8] m (TrackNo, Maybe Packet) + -> Iteratee s m (TrackNo, Maybe Packet) readPacket specs = do trackNo <- readInt32be entryTime <- TS <$> readInt64be @@ -191,36 +191,37 @@ packet <- case IM.lookup trackNo specs of Just TrackSpec{..} -> do let readTS = readTimeStamps specDRType count entryTime - case specType of - ZDouble -> do - (d :: [Double]) <- replicateM count readRaw - ts <- readTS - return . Just $ - (Packet trackNo entryTime exitTime count - (ZoomRaw d) ts) - ZInt -> do - (d :: [Int]) <- replicateM count readRaw - ts <- readTS - return . Just $ - (Packet trackNo entryTime exitTime count - (ZoomRaw d) ts) + d <- readRawCodec specType count + ts <- readTS + return . Just $ + (Packet trackNo entryTime exitTime count d ts) Nothing -> do I.drop byteLength return Nothing return (trackNo, packet) where - readTimeStamps :: (Functor m, MonadIO m) + readRawCodec :: (I.Nullable s, LL.ListLike s Word8, + Functor m, MonadIO m) + => Codec -> Int -> Iteratee s m ZoomRaw + readRawCodec (Codec a) count = ZoomRaw <$> replicateM count (readRawAs a) + + readRawAs :: (ZoomReadable a, I.Nullable s, LL.ListLike s Word8, + Functor m, MonadIO m) + => a -> Iteratee s m a + readRawAs = const readRaw + + readTimeStamps :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) => DataRateType -> Int -> TimeStamp - -> Iteratee [Word8] m [TimeStamp] + -> Iteratee s m [TimeStamp] readTimeStamps drType count entry = map TS <$> case drType of ConstantDR -> do return $ take count [unTS entry ..] VariableDR -> do replicateM count readInt64be -readSummaryBlock :: (Functor m, MonadIO m) +readSummaryBlock :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) => IntMap TrackSpec - -> Iteratee [Word8] m (TrackNo, Maybe ZoomSummary) + -> Iteratee s m (TrackNo, Maybe ZoomSummary) readSummaryBlock specs = do trackNo <- readInt32be lvl <- readInt32be @@ -230,70 +231,80 @@ summary <- case IM.lookup trackNo specs of Just TrackSpec{..} -> do - case specType of - ZDouble -> do - (sd :: SummaryData Double) <- readSummary - return . Just . ZoomSummary $ - Summary trackNo lvl entryTime exitTime sd - ZInt -> do - (sd :: SummaryData Int) <- readSummary - return . Just . ZoomSummary $ - Summary trackNo lvl entryTime exitTime sd + sd <- readSummaryCodec specType trackNo lvl entryTime exitTime + return $ Just sd Nothing -> do I.drop byteLength return Nothing return (trackNo, summary) + where + readSummaryCodec :: (I.Nullable s, LL.ListLike s Word8, + Functor m, MonadIO m) + => Codec -> TrackNo -> Int -> TimeStamp -> TimeStamp + -> Iteratee s m ZoomSummary + readSummaryCodec (Codec a) trackNo lvl entryTime exitTime = do + ZoomSummary <$> (Summary trackNo lvl entryTime exitTime <$> readSummaryAs a) + readSummaryAs :: (ZoomReadable a, I.Nullable s, LL.ListLike s Word8, + Functor m, MonadIO m) + => a -> Iteratee s m (SummaryData a) + readSummaryAs = const readSummary + + ---------------------------------------------------------------------- -- Convenience functions -- | Map a monadic 'Stream' processing function over an entire zoom-cache file. -mapStream :: (Functor m, MonadIO m) - => (Stream -> m ()) - -> Iteratee [Word8] m () -mapStream = I.joinI . enumCacheFile . I.mapChunksM_ +mapStream :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) + => [IdentifyCodec] + -> (Stream -> m ()) + -> Iteratee s m () +mapStream mappings = I.joinI . enumCacheFile mappings . I.mapChunksM_ +{-# INLINABLE mapStream #-} -- | Map a monadic 'Packet' processing function over an entire zoom-cache file. -mapPackets :: (Functor m, MonadIO m) - => (Packet -> m ()) - -> Iteratee [Word8] m () -mapPackets f = mapStream process +mapPackets :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) + => [IdentifyCodec] + -> (Packet -> m ()) + -> Iteratee s m () +mapPackets mappings f = mapStream mappings process where process StreamPacket{..} = f strmPacket process _ = return () +{-# INLINABLE mapPackets #-} -- | Map a monadic 'Summary' processing function over an entire zoom-cache file. -mapSummaries :: (Functor m, MonadIO m) - => (ZoomSummary -> m ()) - -> Iteratee [Word8] m () -mapSummaries f = mapStream process +mapSummaries :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) + => [IdentifyCodec] + -> (ZoomSummary -> m ()) + -> Iteratee s m () +mapSummaries mappings f = mapStream mappings process where process StreamSummary{..} = f strmSummary process _ = return () +{-# INLINABLE mapSummaries #-} ---------------------------------------------------------------------- -- zoom-cache datatype parsers -readVersion :: (Functor m, MonadIO m) => Iteratee [Word8] m Version -readVersion = do - vMaj <- readInt16be - vMin <- readInt16be - return $ Version vMaj vMin +readVersion :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) + => Iteratee s m Version +readVersion = Version <$> readInt16be <*> readInt16be -readTrackType :: (Functor m, MonadIO m) => Iteratee [Word8] m TrackType -readTrackType = do - tt <- I.joinI $ I.takeUpTo 8 I.stream2list - maybe (error "Unknown track type") return (parseTrackType . L.pack $ tt) +readCodec :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) + => [IdentifyCodec] + -> Iteratee s m Codec +readCodec mappings = do + tt <- B.pack <$> (I.joinI $ I.takeUpTo 8 I.stream2list) + maybe (error "Unknown track type") return (parseCodec mappings tt) -parseTrackType :: L.ByteString -> Maybe TrackType -parseTrackType h - | h == trackTypeDouble = Just ZDouble - | h == trackTypeInt = Just ZInt - | otherwise = Nothing +parseCodec :: [IdentifyCodec] -> IdentifyCodec +parseCodec mappings h = msum . map ($ h) $ mappings -readDataRateType :: (Functor m, MonadIO m) => Iteratee [Word8] m DataRateType +readDataRateType :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) + => Iteratee s m DataRateType readDataRateType = do - n <- readInt16be + (n :: Int16) <- 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 FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS -Wall #-} ---------------------------------------------------------------------- @@ -15,54 +16,96 @@ module Data.Iteratee.ZoomCache.Utils ( -- * Raw data reading iteratees - readInt16be + readInt8 + , readInt16be , readInt32be , readInt64be + , readFloat32be , readDouble64be , readRational64be ) where import Control.Applicative ((<$>)) import Control.Monad.Trans (MonadIO) +import qualified Data.ByteString as B import Data.Int import Data.Iteratee (Iteratee) import qualified Data.Iteratee as I +import qualified Data.ListLike as LL import Data.Ratio import Data.Word import Unsafe.Coerce (unsafeCoerce) --- | Read 2 bytes as a big-endian Int. -readInt16be :: (Functor m, MonadIO m) => Iteratee [Word8] m Int +-- | Read 1 byte as an Integral +readInt8 :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m, Integral a) + => Iteratee s m a +readInt8 = fromIntegral . u8_to_s8 <$> I.head + where + u8_to_s8 :: Word8 -> Int8 + u8_to_s8 = fromIntegral +{-# SPECIALIZE INLINE readInt8 :: (Functor m, MonadIO m) => Iteratee [Word8] m Int8 #-} +{-# SPECIALIZE INLINE readInt8 :: (Functor m, MonadIO m) => Iteratee B.ByteString m Int8 #-} +{-# SPECIALIZE INLINE readInt8 :: (Functor m, MonadIO m) => Iteratee [Word8] m Int #-} +{-# SPECIALIZE INLINE readInt8 :: (Functor m, MonadIO m) => Iteratee B.ByteString m Int #-} + +-- | Read 2 bytes as a big-endian Integral +readInt16be :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m, Integral a) + => Iteratee s m a readInt16be = fromIntegral . u16_to_s16 <$> I.endianRead2 I.MSB where u16_to_s16 :: Word16 -> Int16 u16_to_s16 = fromIntegral +{-# SPECIALIZE INLINE readInt16be :: (Functor m, MonadIO m) => Iteratee [Word8] m Int16 #-} +{-# SPECIALIZE INLINE readInt16be :: (Functor m, MonadIO m) => Iteratee B.ByteString m Int16 #-} +{-# SPECIALIZE INLINE readInt16be :: (Functor m, MonadIO m) => Iteratee [Word8] m Int #-} +{-# SPECIALIZE INLINE readInt16be :: (Functor m, MonadIO m) => Iteratee B.ByteString m Int #-} --- | Read 4 bytes as a big-endian Int. -readInt32be :: (Functor m, MonadIO m) => Iteratee [Word8] m Int +-- | Read 4 bytes as a big-endian Integral +readInt32be :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m, Integral a) + => Iteratee s m a readInt32be = fromIntegral . u32_to_s32 <$> I.endianRead4 I.MSB where u32_to_s32 :: Word32 -> Int32 u32_to_s32 = fromIntegral +{-# SPECIALIZE INLINE readInt32be :: (Functor m, MonadIO m) => Iteratee [Word8] m Int32 #-} +{-# SPECIALIZE INLINE readInt32be :: (Functor m, MonadIO m) => Iteratee B.ByteString m Int32 #-} +{-# SPECIALIZE INLINE readInt32be :: (Functor m, MonadIO m) => Iteratee [Word8] m Int #-} +{-# SPECIALIZE INLINE readInt32be :: (Functor m, MonadIO m) => Iteratee B.ByteString m Int #-} --- | Read 8 bytes as a big-endian Integer -readInt64be :: (Functor m, MonadIO m, Integral a) => Iteratee [Word8] m a +-- | Read 8 bytes as a big-endian Integral +readInt64be :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m, Integral a) + => Iteratee s 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 #-} +{-# SPECIALIZE INLINE readInt64be :: (Functor m, MonadIO m) => Iteratee B.ByteString m Int64 #-} +{-# SPECIALIZE INLINE readInt64be :: (Functor m, MonadIO m) => Iteratee [Word8] m Int #-} +{-# SPECIALIZE INLINE readInt64be :: (Functor m, MonadIO m) => Iteratee B.ByteString m Int #-} +-- | Read 4 bytes as a big-endian Float +readFloat32be :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) + => Iteratee s m Float +readFloat32be = do + n <- I.endianRead4 I.MSB + return (unsafeCoerce n :: Float) +{-# SPECIALIZE INLINE readFloat32be :: (Functor m, MonadIO m) => Iteratee [Word8] m Float #-} +{-# SPECIALIZE INLINE readFloat32be :: (Functor m, MonadIO m) => Iteratee B.ByteString m Float #-} + -- | Read 8 bytes as a big-endian Double -readDouble64be :: (Functor m, MonadIO m) => Iteratee [Word8] m Double +readDouble64be :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) + => Iteratee s m Double readDouble64be = do n <- I.endianRead8 I.MSB return (unsafeCoerce n :: Double) +{-# SPECIALIZE INLINE readDouble64be :: (Functor m, MonadIO m) => Iteratee [Word8] m Double #-} +{-# SPECIALIZE INLINE readDouble64be :: (Functor m, MonadIO m) => Iteratee B.ByteString m Double #-} -- | 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 :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) + => Iteratee s m Rational readRational64be = do (num :: Integer) <- readInt64be (den :: Integer) <- readInt64be diff --git a/Data/ZoomCache.hs b/Data/ZoomCache.hs --- a/Data/ZoomCache.hs +++ b/Data/ZoomCache.hs @@ -16,7 +16,8 @@ -- * Types TimeStamp(..) , TrackNo - , TrackType(..) + , Codec + , IdentifyCodec , DataRateType(..) , CacheFile(..) @@ -40,6 +41,11 @@ , withFileWrite , flush + -- * ZoomWHandle IO functions + , ZoomWHandle + , openWrite + , closeWrite + -- * Watermarks , watermark , setWatermark @@ -47,6 +53,9 @@ -- * TrackSpec helpers , oneTrack + -- * Standard identifiers + , standardIdentifiers + -- * Iteratee parsers , module Data.Iteratee.ZoomCache @@ -54,9 +63,36 @@ , module Data.ZoomCache.Pretty ) where +import Data.Int + import Data.ZoomCache.Write import Data.Iteratee.ZoomCache import Data.ZoomCache.Common +import Data.ZoomCache.Identify import Data.ZoomCache.Pretty import Data.ZoomCache.Types + +-- Track Types +import Data.ZoomCache.Bool() +import Data.ZoomCache.Unit() +import Data.ZoomCache.Numeric.IEEE754() +import Data.ZoomCache.Numeric.Int() + +---------------------------------------------------------------------- + +-- | 'IdentifyTrack' functions provided for standard codecs provided +-- by the zoom-cache library. +standardIdentifiers :: [IdentifyCodec] +standardIdentifiers = + [ identifyCodec (undefined :: Float) + , identifyCodec (undefined :: Double) + , identifyCodec (undefined :: Int) + , identifyCodec (undefined :: Int8) + , identifyCodec (undefined :: Int16) + , identifyCodec (undefined :: Int32) + , identifyCodec (undefined :: Int64) + , identifyCodec (undefined :: ()) + , identifyCodec (undefined :: Bool) + ] + diff --git a/Data/ZoomCache/Bool.hs b/Data/ZoomCache/Bool.hs new file mode 100644 --- /dev/null +++ b/Data/ZoomCache/Bool.hs @@ -0,0 +1,159 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wall -fno-warn-orphans #-} +---------------------------------------------------------------------- +{- | + Module : Data.ZoomCache.Bool + Copyright : Conrad Parker + License : BSD3-style (see LICENSE) + + Maintainer : Conrad Parker + Stability : unstable + Portability : unknown + +Default codec implementation for values of type Bool. Elements of type Bool +are useful for recording observations of binary events. + +This module implements the interfaces documented in "Data.ZoomCache.Codec". + +The table below describes the encoding of SummaryData for Bool. + +@ + | ... | -35 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Expected value (double) | 36-39 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | ... | 40-43 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +@ + +Field encoding formats: + + @double@: big-endian IEEE 754-2008 binary64 (IEEE 754-1985 double) + +-} +---------------------------------------------------------------------- + +module Data.ZoomCache.Bool ( + SummaryData(..) + , SummaryWork(..) +)where + +import Blaze.ByteString.Builder +import Control.Applicative ((<$>)) +import Control.Monad.Trans (MonadIO) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Int +import Data.Iteratee (Iteratee) +import qualified Data.Iteratee as I +import qualified Data.ListLike as LL +import Data.Word +import Text.Printf + +import Data.ZoomCache.Codec + +---------------------------------------------------------------------- + +-- Identifier for track headers +trackTypeBool :: ByteString +trackTypeBool = "ZOOMbool" + +---------------------------------------------------------------------- +-- Read + +instance ZoomReadable Bool where + data SummaryData Bool = SummaryBool + { summaryBoolExpected :: {-# UNPACK #-}!Double + } + + trackIdentifier = const trackTypeBool + + readRaw = readBool + readSummary = readSummaryBool + + prettyRaw = prettyPacketBool + prettySummaryData = prettySummaryBool + +prettyPacketBool :: Bool -> String +prettyPacketBool = show + +readBool :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) + => Iteratee s m Bool +readBool = (/= 0) <$> I.head + +readSummaryBool :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) + => Iteratee s m (SummaryData Bool) +readSummaryBool = SummaryBool <$>readDouble64be +{-# SPECIALIZE INLINE readSummaryBool :: (Functor m, MonadIO m) => Iteratee [Word8] m (SummaryData Bool) #-} +{-# SPECIALIZE INLINE readSummaryBool :: (Functor m, MonadIO m) => Iteratee B.ByteString m (SummaryData Bool) #-} + +prettySummaryBool :: SummaryData Bool -> String +prettySummaryBool SummaryBool{..} = printf "expected: %.3f" summaryBoolExpected + +---------------------------------------------------------------------- +-- Write + +instance ZoomWrite Bool where + write = writeData + +instance ZoomWrite (TimeStamp, Bool) where + write = writeDataVBR + +instance ZoomWritable Bool where + data SummaryWork Bool = SummaryWorkBool + { swBoolTime :: {-# UNPACK #-}!TimeStamp + , swBoolTrueTime :: {-# UNPACK #-}!Int64 + } + + fromRaw = fromBool + fromSummaryData = fromSummaryBool + + initSummaryWork = initSummaryBool + toSummaryData = mkSummaryBool + updateSummaryData = updateSummaryBool + appendSummaryData = appendSummaryBool + +fromBool :: Bool -> Builder +fromBool False = fromInt8 0 +fromBool True = fromInt8 1 + +initSummaryBool :: TimeStamp -> SummaryWork Bool +initSummaryBool entry = SummaryWorkBool + { swBoolTime = entry + , swBoolTrueTime = 0 + } + +mkSummaryBool :: TimeStampDiff -> SummaryWork Bool -> SummaryData Bool +mkSummaryBool (TSDiff dur) SummaryWorkBool{..} = SummaryBool + { summaryBoolExpected = fromIntegral swBoolTrueTime / fromIntegral dur + } + +fromSummaryBool :: SummaryData Bool -> Builder +fromSummaryBool SummaryBool{..} = fromDouble summaryBoolExpected + +updateSummaryBool :: TimeStamp -> Bool -> SummaryWork Bool + -> SummaryWork Bool +updateSummaryBool t False sw = sw { swBoolTime = t } +updateSummaryBool t True SummaryWorkBool{..} = SummaryWorkBool + { swBoolTime = t + , swBoolTrueTime = swBoolTrueTime + dur + } + where + !(TSDiff dur) = timeStampDiff t swBoolTime + +appendSummaryBool :: TimeStampDiff -> SummaryData Bool + -> TimeStampDiff -> SummaryData Bool + -> SummaryData Bool +appendSummaryBool (TSDiff dur1) s1 (TSDiff dur2) s2 = SummaryBool + { summaryBoolExpected = ((summaryBoolExpected s1 * fromIntegral dur1) + + (summaryBoolExpected s2 * fromIntegral dur2)) / + fromIntegral durSum + } + where + !durSum = dur1 + dur2 + diff --git a/Data/ZoomCache/Codec.hs b/Data/ZoomCache/Codec.hs --- a/Data/ZoomCache/Codec.hs +++ b/Data/ZoomCache/Codec.hs @@ -26,10 +26,15 @@ , ZoomWritable(..) , ZoomWrite(..) + -- * Identification + , identifyCodec + -- * Raw data reading iteratees + , readInt8 , readInt16be , readInt32be , readInt64be + , readFloat32be , readDouble64be , readRational64be @@ -40,14 +45,23 @@ -- * Builders , fromRational64 , fromIntegral32be + , fromFloat , fromDouble -- * ZoomCache Types + , Codec , TimeStamp(..) + , TimeStampDiff(..) + , timeStampDiff + + -- * Minimum and maximum floating point + , module Data.ZoomCache.Numeric.FloatMinMax ) where import Blaze.ByteString.Builder.ZoomCache import Data.Iteratee.ZoomCache.Utils import Data.ZoomCache.Common +import Data.ZoomCache.Identify import Data.ZoomCache.Types import Data.ZoomCache.Write +import Data.ZoomCache.Numeric.FloatMinMax diff --git a/Data/ZoomCache/Common.hs b/Data/ZoomCache/Common.hs --- a/Data/ZoomCache/Common.hs +++ b/Data/ZoomCache/Common.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ExistentialQuantification #-} {-# OPTIONS -Wall #-} ---------------------------------------------------------------------- -- | @@ -13,32 +14,23 @@ ---------------------------------------------------------------------- module Data.ZoomCache.Common ( - -- * Types + -- * TimeStamps TimeStamp(..) - , TrackType(..) + , TimeStampDiff(..) + , timeStampDiff + + -- * Types , DataRateType(..) , TrackNo -- * Global header , Global(..) - -- * CacheFile - , CacheFile(..) - , mkCacheFile - , fiFull - -- * Version , Version(..) - - -- * 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 ------------------------------------------------------------ @@ -47,6 +39,13 @@ data TimeStamp = TS { unTS :: {-# UNPACK #-}!Int64 } deriving (Eq, Ord, Show) +data TimeStampDiff = TSDiff { unTSDiff :: {-# UNPACK #-}!Int64 } + deriving (Eq, Ord, Show) + +-- | @timeStampDiff (TS t1) (TS t2) = TSDiff (t1 - t2)@ +timeStampDiff :: TimeStamp -> TimeStamp -> TimeStampDiff +timeStampDiff (TS t1) (TS t2) = TSDiff (t1 - t2) + data Version = Version !Int !Int deriving (Eq, Show) @@ -59,41 +58,10 @@ } deriving (Show) --- | A map of all track numbers to their 'TrackSpec' -type TrackMap = IntMap TrackSpec - --- | A specification of the type and name of each track -data TrackSpec = TrackSpec - { specType :: !TrackType - , specDRType :: !DataRateType - , specRate :: {-# UNPACK #-}!Rational - , specName :: !L.ByteString - } - deriving (Show) - -data TrackType = ZDouble | ZInt - deriving (Eq, Show) - -- | Constant or Variable datarate. -- For constant datarate, timestamps are implied as incrementing by 1/datarate -- For variable datarate, explicit timestamps are attached to each datum, encoded -- as a separate block of timestamps in the Raw Data packet. data DataRateType = ConstantDR | VariableDR deriving (Show) - ------------------------------------------------------------- - --- | Global and track headers for a zoom-cache file -data CacheFile = CacheFile - { cfGlobal :: Global - , cfSpecs :: IntMap TrackSpec - } - --- | Create an empty 'CacheFile' using the given 'Global' -mkCacheFile :: Global -> CacheFile -mkCacheFile g = CacheFile g IM.empty - --- | Determine whether all tracks of a 'CacheFile' are specified -fiFull :: CacheFile -> Bool -fiFull (CacheFile g specs) = IM.size specs == noTracks g diff --git a/Data/ZoomCache/Double.hs b/Data/ZoomCache/Double.hs deleted file mode 100644 --- a/Data/ZoomCache/Double.hs +++ /dev/null @@ -1,208 +0,0 @@ -{-# 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. - -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 ( - 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 SummaryData Double = SummaryDouble - { summaryDoubleEntry :: {-# UNPACK #-}!Double - , summaryDoubleExit :: {-# UNPACK #-}!Double - , summaryDoubleMin :: {-# UNPACK #-}!Double - , summaryDoubleMax :: {-# UNPACK #-}!Double - , summaryDoubleAvg :: {-# UNPACK #-}!Double - , summaryDoubleRMS :: {-# UNPACK #-}!Double - } - - readRaw = readDouble64be - readSummary = readSummaryDouble - - prettyRaw = prettyPacketDouble - prettySummaryData = prettySummaryDouble - -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 readDouble64be - 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 :: {-# UNPACK #-}!TimeStamp - , ztsdEntry :: {-# UNPACK #-}!Double - , ztsdExit :: {-# UNPACK #-}!Double - , ztsdMin :: {-# UNPACK #-}!Double - , ztsdMax :: {-# UNPACK #-}!Double - , ztsdSum :: {-# UNPACK #-}!Double - , ztsdSumSq :: {-# UNPACK #-}!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 --- a/Data/ZoomCache/Dump.hs +++ b/Data/ZoomCache/Dump.hs @@ -24,6 +24,8 @@ ) where import Control.Applicative ((<$>)) +import Control.Monad.Trans (MonadIO) +import Data.ByteString (ByteString) import Data.Int import qualified Data.IntMap as IM import qualified Data.Iteratee as I @@ -33,17 +35,37 @@ ------------------------------------------------------------ -zoomInfoFile :: FilePath -> IO () -zoomInfoFile path = I.fileDriverRandom iterHeaders path >>= info +zoomInfoFile :: [IdentifyCodec] + -> FilePath -> IO () +zoomInfoFile mappings path = + I.fileDriverRandom (iterHeadersBS mappings) path >>= info -zoomDumpFile :: TrackNo -> FilePath -> IO () -zoomDumpFile trackNo = I.fileDriverRandom (mapStream (dumpData trackNo)) +zoomDumpFile :: [IdentifyCodec] + -> TrackNo -> FilePath -> IO () +zoomDumpFile mappings trackNo = + I.fileDriverRandom (mapStreamBS mappings (dumpData trackNo)) -zoomDumpSummary :: TrackNo -> FilePath -> IO () -zoomDumpSummary trackNo = I.fileDriverRandom (mapStream (dumpSummary trackNo)) +zoomDumpSummary :: [IdentifyCodec] + -> TrackNo -> FilePath -> IO () +zoomDumpSummary mappings trackNo = + I.fileDriverRandom (mapStreamBS mappings (dumpSummary trackNo)) -zoomDumpSummaryLevel :: TrackNo -> Int -> FilePath -> IO () -zoomDumpSummaryLevel trackNo lvl = I.fileDriverRandom (mapStream (dumpSummaryLevel trackNo lvl)) +zoomDumpSummaryLevel :: [IdentifyCodec] + -> TrackNo -> Int -> FilePath -> IO () +zoomDumpSummaryLevel mappings trackNo lvl = + I.fileDriverRandom (mapStreamBS mappings (dumpSummaryLevel trackNo lvl)) + +---------------------------------------------------------------------- + +iterHeadersBS :: [IdentifyCodec] + -> I.Iteratee ByteString IO CacheFile +iterHeadersBS = iterHeaders + +mapStreamBS :: (Functor m, MonadIO m) + => [IdentifyCodec] + -> (Stream -> m ()) + -> I.Iteratee ByteString m () +mapStreamBS = mapStream ---------------------------------------------------------------------- diff --git a/Data/ZoomCache/Format.hs b/Data/ZoomCache/Format.hs --- a/Data/ZoomCache/Format.hs +++ b/Data/ZoomCache/Format.hs @@ -29,8 +29,6 @@ -- * Track header , trackHeader - , trackTypeDouble - , trackTypeInt -- * Packet header , packetHeader @@ -39,8 +37,8 @@ , summaryHeader ) where -import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString.Lazy.Char8 as LC +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as C {- | @@ -88,8 +86,8 @@ -} -- Magic identifier at the beginning of a zoom-cache file. -globalHeader :: L.ByteString -globalHeader = LC.pack "\xe5ZXhe4d\0" +globalHeader :: ByteString +globalHeader = C.pack "\xe5ZXhe4d\0" -- | The major version encoded by this library versionMajor :: Int @@ -137,14 +135,8 @@ -} -- 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" +trackHeader :: ByteString +trackHeader = C.pack "\xe5ZXtRcK\0" {- | @@ -187,8 +179,8 @@ TS = 28 + (COUNT * sizeof(Type)) -} -- Identifier for packet headers -packetHeader :: L.ByteString -packetHeader = LC.pack "\xe5ZXp4ck\0" +packetHeader :: ByteString +packetHeader = C.pack "\xe5ZXp4ck\0" {- | @@ -226,6 +218,6 @@ -} -- Identifier for summary headers -summaryHeader :: L.ByteString -summaryHeader = LC.pack "\xe5ZX5umm\0" +summaryHeader :: ByteString +summaryHeader = C.pack "\xe5ZX5umm\0" diff --git a/Data/ZoomCache/Identify.hs b/Data/ZoomCache/Identify.hs new file mode 100644 --- /dev/null +++ b/Data/ZoomCache/Identify.hs @@ -0,0 +1,29 @@ +{-# OPTIONS -Wall #-} +---------------------------------------------------------------------- +-- | +-- Module : Data.ZoomCache.Identify +-- Copyright : Conrad Parker +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Conrad Parker +-- Stability : unstable +-- Portability : unknown +-- +-- Identifiers for track types of ZoomCache files. +---------------------------------------------------------------------- + +module Data.ZoomCache.Identify ( + -- * Identification + identifyCodec +) where + +import Data.ZoomCache.Types + +---------------------------------------------------------------------- + +-- | Generate an 'IdentifyTrack' function for a given type. +identifyCodec :: ZoomReadable a => a -> IdentifyCodec +identifyCodec a h + | h == trackIdentifier a = Just (Codec a) + | otherwise = Nothing + diff --git a/Data/ZoomCache/Int.hs b/Data/ZoomCache/Int.hs deleted file mode 100644 --- a/Data/ZoomCache/Int.hs +++ /dev/null @@ -1,204 +0,0 @@ -{-# 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. - -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 ( - 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 SummaryData Int = SummaryInt - { summaryIntEntry :: {-# UNPACK #-}!Int - , summaryIntExit :: {-# UNPACK #-}!Int - , summaryIntMin :: {-# UNPACK #-}!Int - , summaryIntMax :: {-# UNPACK #-}!Int - , summaryIntAvg :: {-# UNPACK #-}!Double - , summaryIntRMS :: {-# UNPACK #-}!Double - } - - readRaw = readInt32be - readSummary = readSummaryInt - - prettyRaw = prettyPacketInt - prettySummaryData = prettySummaryInt - -prettyPacketInt :: Int -> String -prettyPacketInt = show - -readSummaryInt :: (Functor m, MonadIO m) - => Iteratee [Word8] m (SummaryData Int) -readSummaryInt = do - [en,ex,mn,mx] <- replicateM 4 readInt32be - [avg,rms] <- replicateM 2 readDouble64be - 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 :: {-# UNPACK #-}!TimeStamp - , ztsiEntry :: {-# UNPACK #-}!Int - , ztsiExit :: {-# UNPACK #-}!Int - , ztsiMin :: {-# UNPACK #-}!Int - , ztsiMax :: {-# UNPACK #-}!Int - , ztsiSum :: {-# UNPACK #-}!Int - , ztsiSumSq :: {-# UNPACK #-}!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/Numeric/FloatMinMax.hs b/Data/ZoomCache/Numeric/FloatMinMax.hs new file mode 100644 --- /dev/null +++ b/Data/ZoomCache/Numeric/FloatMinMax.hs @@ -0,0 +1,38 @@ +-- | The minimum and maximum positive, finite floats. + +module Data.ZoomCache.Numeric.FloatMinMax +( floatMin +, floatMaxDenorm +, floatMinNorm +, floatMax +) +where + +import Control.Applicative +import Data.Function + +-- | The minimum positive, denormalized float. +floatMin :: RealFloat a => a +floatMin = fix $ do d <- floatDigits + (e,_) <- floatRange + pure $ encodeFloat 1 (e-d) +{-# INLINE floatMin #-} + +-- | The maximum denormalized float. +floatMaxDenorm :: RealFloat a => a +floatMaxDenorm = floatMinNorm - floatMin +{-# INLINE floatMaxDenorm #-} + +-- | The minimum positive, normalized float. +floatMinNorm :: RealFloat a => a +floatMinNorm = fix $ do (e,_) <- floatRange + pure $ encodeFloat 1 (e-1) +{-# INLINE floatMinNorm #-} + +-- | The maximum finite float. +floatMax :: RealFloat a => a +floatMax = fix $ do r <- floatRadix + d <- floatDigits + (_,e) <- floatRange + pure $ encodeFloat (r^d-1) (e-d) +{-# INLINE floatMax #-} diff --git a/Data/ZoomCache/Numeric/IEEE754.hs b/Data/ZoomCache/Numeric/IEEE754.hs new file mode 100644 --- /dev/null +++ b/Data/ZoomCache/Numeric/IEEE754.hs @@ -0,0 +1,262 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wall -fno-warn-orphans #-} +---------------------------------------------------------------------- +{- | + Module : Data.ZoomCache.Numeric.IEEE754 + Copyright : Conrad Parker + License : BSD3-style (see LICENSE) + + Maintainer : Conrad Parker + Stability : unstable + Portability : unknown + +Default codec implementation for values of type Float and 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 Float. + +@ + | ... | -35 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Entry (float) | 36-39 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Exit (float) | 40-43 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Min (float) | 44-47 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Max (float) | 48-51 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Avg (float) | 52-55 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | RMS (float) | 56-59 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +@ + +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: + + @float@: big-endian IEEE 754-2008 binary32 (IEEE 754-1985 single) + @double@: big-endian IEEE 754-2008 binary64 (IEEE 754-1985 double) + +-} +---------------------------------------------------------------------- + +module Data.ZoomCache.Numeric.IEEE754 ( + SummaryData(..) + , SummaryWork(..) +)where + +import Blaze.ByteString.Builder +import Control.Monad.Trans (MonadIO) +import Data.ByteString (ByteString) +import Data.Iteratee (Iteratee) +import Data.Word +import Text.Printf + +import Data.ZoomCache.Codec +import Data.ZoomCache.Numeric.Internal +import Data.ZoomCache.Numeric.Types + +---------------------------------------------------------------------- +-- Float + +instance ZoomReadable Float where + data SummaryData Float = SummaryFloat + { summaryFloatEntry :: {-# UNPACK #-}!Float + , summaryFloatExit :: {-# UNPACK #-}!Float + , summaryFloatMin :: {-# UNPACK #-}!Float + , summaryFloatMax :: {-# UNPACK #-}!Float + , summaryFloatAvg :: {-# UNPACK #-}!Double + , summaryFloatRMS :: {-# UNPACK #-}!Double + } + + trackIdentifier = const "ZOOMf32b" + + readRaw = readFloat32be + readSummary = readSummaryNum + + prettyRaw = prettyPacketFloat + prettySummaryData = prettySummaryFloat + +{-# SPECIALIZE readSummaryNum :: (Functor m, MonadIO m) => Iteratee [Word8] m (SummaryData Float) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, MonadIO m) => Iteratee ByteString m (SummaryData Float) #-} + +instance ZoomWrite Float where + write = writeData + +instance ZoomWrite (TimeStamp, Float) where + write = writeDataVBR + +instance ZoomWritable Float where + data SummaryWork Float = SummaryWorkFloat + { swFloatTime :: {-# UNPACK #-}!TimeStamp + , swFloatEntry :: !(Maybe Float) + , swFloatExit :: {-# UNPACK #-}!Float + , swFloatMin :: {-# UNPACK #-}!Float + , swFloatMax :: {-# UNPACK #-}!Float + , swFloatSum :: {-# UNPACK #-}!Double + , swFloatSumSq :: {-# UNPACK #-}!Double + } + fromRaw = fromFloat + fromSummaryData = fromSummaryNum + + initSummaryWork = initSummaryFloat + toSummaryData = mkSummaryNum + updateSummaryData = updateSummaryNum + appendSummaryData = appendSummaryNum + +instance ZoomNum Float where + numEntry = summaryFloatEntry + numExit = summaryFloatExit + numMin = summaryFloatMin + numMax = summaryFloatMax + numAvg = summaryFloatAvg + numRMS = summaryFloatRMS + + numWorkTime = swFloatTime + numWorkEntry = swFloatEntry + numWorkExit = swFloatExit + numWorkMin = swFloatMin + numWorkMax = swFloatMax + numWorkSum = swFloatSum + numWorkSumSq = swFloatSumSq + + numMkSummary = SummaryFloat + numMkSummaryWork = SummaryWorkFloat + +{-# SPECIALIZE fromSummaryNum :: SummaryData Float -> Builder #-} +{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Float -> SummaryData Float #-} +{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Float -> TimeStampDiff -> SummaryData Float -> SummaryData Float #-} +{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Float -> SummaryWork Float -> SummaryWork Float #-} + +---------------------------------------------------------------------- +-- Double + +instance ZoomReadable Double where + data SummaryData Double = SummaryDouble + { summaryDoubleEntry :: {-# UNPACK #-}!Double + , summaryDoubleExit :: {-# UNPACK #-}!Double + , summaryDoubleMin :: {-# UNPACK #-}!Double + , summaryDoubleMax :: {-# UNPACK #-}!Double + , summaryDoubleAvg :: {-# UNPACK #-}!Double + , summaryDoubleRMS :: {-# UNPACK #-}!Double + } + + trackIdentifier = const "ZOOMf64b" + + readRaw = readDouble64be + readSummary = readSummaryNum + + prettyRaw = prettyPacketFloat + prettySummaryData = prettySummaryFloat + +{-# SPECIALIZE readSummaryNum :: (Functor m, MonadIO m) => Iteratee [Word8] m (SummaryData Double) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, MonadIO m) => Iteratee ByteString m (SummaryData Double) #-} + +instance ZoomWrite Double where + write = writeData + +instance ZoomWrite (TimeStamp, Double) where + write = writeDataVBR + +instance ZoomWritable Double where + data SummaryWork Double = SummaryWorkDouble + { swDoubleTime :: {-# UNPACK #-}!TimeStamp + , swDoubleEntry :: !(Maybe Double) + , swDoubleExit :: {-# UNPACK #-}!Double + , swDoubleMin :: {-# UNPACK #-}!Double + , swDoubleMax :: {-# UNPACK #-}!Double + , swDoubleSum :: {-# UNPACK #-}!Double + , swDoubleSumSq :: {-# UNPACK #-}!Double + } + fromRaw = fromDouble + fromSummaryData = fromSummaryNum + + initSummaryWork = initSummaryFloat + toSummaryData = mkSummaryNum + updateSummaryData = updateSummaryNum + appendSummaryData = appendSummaryNum + +instance ZoomNum Double where + numEntry = summaryDoubleEntry + numExit = summaryDoubleExit + numMin = summaryDoubleMin + numMax = summaryDoubleMax + numAvg = summaryDoubleAvg + numRMS = summaryDoubleRMS + + numWorkTime = swDoubleTime + numWorkEntry = swDoubleEntry + numWorkExit = swDoubleExit + numWorkMin = swDoubleMin + numWorkMax = swDoubleMax + numWorkSum = swDoubleSum + numWorkSumSq = swDoubleSumSq + + numMkSummary = SummaryDouble + numMkSummaryWork = SummaryWorkDouble + +{-# SPECIALIZE fromSummaryNum :: SummaryData Double -> Builder #-} +{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Double -> SummaryData Double #-} +{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Double -> TimeStampDiff -> SummaryData Double -> SummaryData Double #-} +{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Double -> SummaryWork Double -> SummaryWork Double #-} + +---------------------------------------------------------------------- + +prettyPacketFloat :: PrintfArg a => a -> String +prettyPacketFloat = printf "%.3f" + +prettySummaryFloat :: (PrintfArg a, ZoomNum a) + => SummaryData a -> String +prettySummaryFloat s = concat + [ printf "\tentry: %.3f\texit: %.3f\tmin: %.3f\tmax: %.3f\t" + (numEntry s) (numExit s) (numMin s) (numMax s) + , printf "avg: %.3f\trms: %.3f" (numAvg s) (numRMS s) + ] + +initSummaryFloat :: (RealFloat a, ZoomNum a) + => TimeStamp -> SummaryWork a +initSummaryFloat entry = numMkSummaryWork + entry + Nothing + 0.0 + floatMax + (negate floatMax) + 0.0 + 0.0 diff --git a/Data/ZoomCache/Numeric/Int.hs b/Data/ZoomCache/Numeric/Int.hs new file mode 100644 --- /dev/null +++ b/Data/ZoomCache/Numeric/Int.hs @@ -0,0 +1,521 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wall -fno-warn-orphans #-} +---------------------------------------------------------------------- +{- | + Module : Data.ZoomCache.Numeric.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 Int8: + +@ + | ... | -35 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Entry (int8) | Exit (int8) | Min (int8) | Max (int8) | 36-39 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Avg (double) | 40-43 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 44-47 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | RMS (double) | 48-51 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +@ + +The table below describes the encoding of SummaryData for Int16: + +@ + | ... | -35 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Entry (int16) | Exit (int16) | 36-39 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Min (int16) | Max (int16) | 40-43 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Avg (double) | 44-47 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 48-51 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | RMS (double) | 52-55 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 56-59 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +@ + +The table below describes the encoding of SummaryData for Int and Int32: + +@ + | ... | -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 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +@ + +The table below describes the encoding of SummaryData for Int64: + +@ + | ... | -35 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Entry (int64) | 36-39 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 40-43 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Exit (int64) | 44-47 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 48-51 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Min (int64) | 52-55 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 56-59 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Max (int64) | 60-63 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 64-67 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Avg (int64) | 68-71 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 72-75 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | RMS (int64) | 76-79 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 80-83 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +@ + +Field encoding formats: + + @int8@: 8bit signed integer + + @int16@: 16bit big endian signed integer + + @int32@: 32bit big endian signed integer + + @int64@: 32bit big endian signed integer + + @double@: big-endian IEEE 754-2008 binary64 (IEEE 754-1985 double) + +-} +---------------------------------------------------------------------- + +module Data.ZoomCache.Numeric.Int ( + SummaryData(..) + , SummaryWork(..) +)where + +import Blaze.ByteString.Builder +import Control.Monad.Trans (MonadIO) +import Data.ByteString (ByteString) +import Data.Int +import Data.Iteratee (Iteratee) +import Data.Word +import Text.Printf + +import Data.ZoomCache.Codec +import Data.ZoomCache.Numeric.Internal +import Data.ZoomCache.Numeric.Types + +---------------------------------------------------------------------- +-- Int + +instance ZoomReadable Int where + data SummaryData Int = SummaryInt + { summaryIntEntry :: {-# UNPACK #-}!Int + , summaryIntExit :: {-# UNPACK #-}!Int + , summaryIntMin :: {-# UNPACK #-}!Int + , summaryIntMax :: {-# UNPACK #-}!Int + , summaryIntAvg :: {-# UNPACK #-}!Double + , summaryIntRMS :: {-# UNPACK #-}!Double + } + + trackIdentifier = const "ZOOMi32b" + + readRaw = readInt32be + readSummary = readSummaryNum + + prettyRaw = show + prettySummaryData = prettySummaryInt + +{-# SPECIALIZE readSummaryNum :: (Functor m, MonadIO m) => Iteratee [Word8] m (SummaryData Int) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, MonadIO m) => Iteratee ByteString m (SummaryData Int) #-} + +instance ZoomWrite Int where + write = writeData + +instance ZoomWrite (TimeStamp, Int) where + write = writeDataVBR + +instance ZoomWritable Int where + data SummaryWork Int = SummaryWorkInt + { swIntTime :: {-# UNPACK #-}!TimeStamp + , swIntEntry :: !(Maybe Int) + , swIntExit :: {-# UNPACK #-}!Int + , swIntMin :: {-# UNPACK #-}!Int + , swIntMax :: {-# UNPACK #-}!Int + , swIntSum :: {-# UNPACK #-}!Double + , swIntSumSq :: {-# UNPACK #-}!Double + } + + fromRaw = fromIntegral32be + fromSummaryData = fromSummaryNum + + initSummaryWork = initSummaryNumBounded + toSummaryData = mkSummaryNum + updateSummaryData = updateSummaryNum + appendSummaryData = appendSummaryNum + +instance ZoomNum Int where + numEntry = summaryIntEntry + numExit = summaryIntExit + numMin = summaryIntMin + numMax = summaryIntMax + numAvg = summaryIntAvg + numRMS = summaryIntRMS + + numWorkTime = swIntTime + numWorkEntry = swIntEntry + numWorkExit = swIntExit + numWorkMin = swIntMin + numWorkMax = swIntMax + numWorkSum = swIntSum + numWorkSumSq = swIntSumSq + + numMkSummary = SummaryInt + numMkSummaryWork = SummaryWorkInt + +{-# SPECIALIZE fromSummaryNum :: SummaryData Int -> Builder #-} +{-# SPECIALIZE initSummaryNumBounded :: TimeStamp -> SummaryWork Int #-} +{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Int -> SummaryData Int #-} +{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Int -> TimeStampDiff -> SummaryData Int -> SummaryData Int #-} +{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Int -> SummaryWork Int -> SummaryWork Int #-} + +---------------------------------------------------------------------- +-- Int8 + +instance ZoomReadable Int8 where + data SummaryData Int8 = SummaryInt8 + { summaryInt8Entry :: {-# UNPACK #-}!Int8 + , summaryInt8Exit :: {-# UNPACK #-}!Int8 + , summaryInt8Min :: {-# UNPACK #-}!Int8 + , summaryInt8Max :: {-# UNPACK #-}!Int8 + , summaryInt8Avg :: {-# UNPACK #-}!Double + , summaryInt8RMS :: {-# UNPACK #-}!Double + } + + trackIdentifier = const "ZOOMiS8b" + + readRaw = readInt8 + readSummary = readSummaryNum + + prettyRaw = show + prettySummaryData = prettySummaryInt + +{-# SPECIALIZE readSummaryNum :: (Functor m, MonadIO m) => Iteratee [Word8] m (SummaryData Int8) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, MonadIO m) => Iteratee ByteString m (SummaryData Int8) #-} + +instance ZoomWrite Int8 where + write = writeData + +instance ZoomWrite (TimeStamp, Int8) where + write = writeDataVBR + +instance ZoomWritable Int8 where + data SummaryWork Int8 = SummaryWorkInt8 + { swInt8Time :: {-# UNPACK #-}!TimeStamp + , swInt8Entry :: !(Maybe Int8) + , swInt8Exit :: {-# UNPACK #-}!Int8 + , swInt8Min :: {-# UNPACK #-}!Int8 + , swInt8Max :: {-# UNPACK #-}!Int8 + , swInt8Sum :: {-# UNPACK #-}!Double + , swInt8SumSq :: {-# UNPACK #-}!Double + } + + fromRaw = fromInt8 + fromSummaryData = fromSummaryNum + + initSummaryWork = initSummaryNumBounded + toSummaryData = mkSummaryNum + updateSummaryData = updateSummaryNum + appendSummaryData = appendSummaryNum + +instance ZoomNum Int8 where + numEntry = summaryInt8Entry + numExit = summaryInt8Exit + numMin = summaryInt8Min + numMax = summaryInt8Max + numAvg = summaryInt8Avg + numRMS = summaryInt8RMS + + numWorkTime = swInt8Time + numWorkEntry = swInt8Entry + numWorkExit = swInt8Exit + numWorkMin = swInt8Min + numWorkMax = swInt8Max + numWorkSum = swInt8Sum + numWorkSumSq = swInt8SumSq + + numMkSummary = SummaryInt8 + numMkSummaryWork = SummaryWorkInt8 + +{-# SPECIALIZE fromSummaryNum :: SummaryData Int8 -> Builder #-} +{-# SPECIALIZE initSummaryNumBounded :: TimeStamp -> SummaryWork Int8 #-} +{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Int8 -> SummaryData Int8 #-} +{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Int8 -> TimeStampDiff -> SummaryData Int8 -> SummaryData Int8 #-} +{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Int8 -> SummaryWork Int8 -> SummaryWork Int8 #-} + +---------------------------------------------------------------------- +-- Int16 + +instance ZoomReadable Int16 where + data SummaryData Int16 = SummaryInt16 + { summaryInt16Entry :: {-# UNPACK #-}!Int16 + , summaryInt16Exit :: {-# UNPACK #-}!Int16 + , summaryInt16Min :: {-# UNPACK #-}!Int16 + , summaryInt16Max :: {-# UNPACK #-}!Int16 + , summaryInt16Avg :: {-# UNPACK #-}!Double + , summaryInt16RMS :: {-# UNPACK #-}!Double + } + + trackIdentifier = const "ZOOMi16b" + + readRaw = readInt16be + readSummary = readSummaryNum + + prettyRaw = show + prettySummaryData = prettySummaryInt + +{-# SPECIALIZE readSummaryNum :: (Functor m, MonadIO m) => Iteratee [Word8] m (SummaryData Int16) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, MonadIO m) => Iteratee ByteString m (SummaryData Int16) #-} + +instance ZoomWrite Int16 where + write = writeData + +instance ZoomWrite (TimeStamp, Int16) where + write = writeDataVBR + +instance ZoomWritable Int16 where + data SummaryWork Int16 = SummaryWorkInt16 + { swInt16Time :: {-# UNPACK #-}!TimeStamp + , swInt16Entry :: !(Maybe Int16) + , swInt16Exit :: {-# UNPACK #-}!Int16 + , swInt16Min :: {-# UNPACK #-}!Int16 + , swInt16Max :: {-# UNPACK #-}!Int16 + , swInt16Sum :: {-# UNPACK #-}!Double + , swInt16SumSq :: {-# UNPACK #-}!Double + } + + fromRaw = fromInt16be + fromSummaryData = fromSummaryNum + + initSummaryWork = initSummaryNumBounded + toSummaryData = mkSummaryNum + updateSummaryData = updateSummaryNum + appendSummaryData = appendSummaryNum + +instance ZoomNum Int16 where + numEntry = summaryInt16Entry + numExit = summaryInt16Exit + numMin = summaryInt16Min + numMax = summaryInt16Max + numAvg = summaryInt16Avg + numRMS = summaryInt16RMS + + numWorkTime = swInt16Time + numWorkEntry = swInt16Entry + numWorkExit = swInt16Exit + numWorkMin = swInt16Min + numWorkMax = swInt16Max + numWorkSum = swInt16Sum + numWorkSumSq = swInt16SumSq + + numMkSummary = SummaryInt16 + numMkSummaryWork = SummaryWorkInt16 + +{-# SPECIALIZE fromSummaryNum :: SummaryData Int16 -> Builder #-} +{-# SPECIALIZE initSummaryNumBounded :: TimeStamp -> SummaryWork Int16 #-} +{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Int16 -> SummaryData Int16 #-} +{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Int16 -> TimeStampDiff -> SummaryData Int16 -> SummaryData Int16 #-} +{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Int16 -> SummaryWork Int16 -> SummaryWork Int16 #-} + +---------------------------------------------------------------------- +-- Int32 + +instance ZoomReadable Int32 where + data SummaryData Int32 = SummaryInt32 + { summaryInt32Entry :: {-# UNPACK #-}!Int32 + , summaryInt32Exit :: {-# UNPACK #-}!Int32 + , summaryInt32Min :: {-# UNPACK #-}!Int32 + , summaryInt32Max :: {-# UNPACK #-}!Int32 + , summaryInt32Avg :: {-# UNPACK #-}!Double + , summaryInt32RMS :: {-# UNPACK #-}!Double + } + + trackIdentifier = const "ZOOMi32b" + + readRaw = readInt32be + readSummary = readSummaryNum + + prettyRaw = show + prettySummaryData = prettySummaryInt + +{-# SPECIALIZE readSummaryNum :: (Functor m, MonadIO m) => Iteratee [Word8] m (SummaryData Int32) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, MonadIO m) => Iteratee ByteString m (SummaryData Int32) #-} + +instance ZoomWrite Int32 where + write = writeData + +instance ZoomWrite (TimeStamp, Int32) where + write = writeDataVBR + +instance ZoomWritable Int32 where + data SummaryWork Int32 = SummaryWorkInt32 + { swInt32Time :: {-# UNPACK #-}!TimeStamp + , swInt32Entry :: !(Maybe Int32) + , swInt32Exit :: {-# UNPACK #-}!Int32 + , swInt32Min :: {-# UNPACK #-}!Int32 + , swInt32Max :: {-# UNPACK #-}!Int32 + , swInt32Sum :: {-# UNPACK #-}!Double + , swInt32SumSq :: {-# UNPACK #-}!Double + } + + fromRaw = fromIntegral32be + fromSummaryData = fromSummaryNum + + initSummaryWork = initSummaryNumBounded + toSummaryData = mkSummaryNum + updateSummaryData = updateSummaryNum + appendSummaryData = appendSummaryNum + +instance ZoomNum Int32 where + numEntry = summaryInt32Entry + numExit = summaryInt32Exit + numMin = summaryInt32Min + numMax = summaryInt32Max + numAvg = summaryInt32Avg + numRMS = summaryInt32RMS + + numWorkTime = swInt32Time + numWorkEntry = swInt32Entry + numWorkExit = swInt32Exit + numWorkMin = swInt32Min + numWorkMax = swInt32Max + numWorkSum = swInt32Sum + numWorkSumSq = swInt32SumSq + + numMkSummary = SummaryInt32 + numMkSummaryWork = SummaryWorkInt32 + +{-# SPECIALIZE fromSummaryNum :: SummaryData Int32 -> Builder #-} +{-# SPECIALIZE initSummaryNumBounded :: TimeStamp -> SummaryWork Int32 #-} +{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Int32 -> SummaryData Int32 #-} +{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Int32 -> TimeStampDiff -> SummaryData Int32 -> SummaryData Int32 #-} +{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Int32 -> SummaryWork Int32 -> SummaryWork Int32 #-} + +---------------------------------------------------------------------- +-- Int64 + +instance ZoomReadable Int64 where + data SummaryData Int64 = SummaryInt64 + { summaryInt64Entry :: {-# UNPACK #-}!Int64 + , summaryInt64Exit :: {-# UNPACK #-}!Int64 + , summaryInt64Min :: {-# UNPACK #-}!Int64 + , summaryInt64Max :: {-# UNPACK #-}!Int64 + , summaryInt64Avg :: {-# UNPACK #-}!Double + , summaryInt64RMS :: {-# UNPACK #-}!Double + } + + trackIdentifier = const "ZOOMi64b" + + readRaw = readInt64be + readSummary = readSummaryNum + + prettyRaw = show + prettySummaryData = prettySummaryInt + +{-# SPECIALIZE readSummaryNum :: (Functor m, MonadIO m) => Iteratee [Word8] m (SummaryData Int64) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, MonadIO m) => Iteratee ByteString m (SummaryData Int64) #-} + +instance ZoomWrite Int64 where + write = writeData + +instance ZoomWrite (TimeStamp, Int64) where + write = writeDataVBR + +instance ZoomWritable Int64 where + data SummaryWork Int64 = SummaryWorkInt64 + { swInt64Time :: {-# UNPACK #-}!TimeStamp + , swInt64Entry :: !(Maybe Int64) + , swInt64Exit :: {-# UNPACK #-}!Int64 + , swInt64Min :: {-# UNPACK #-}!Int64 + , swInt64Max :: {-# UNPACK #-}!Int64 + , swInt64Sum :: {-# UNPACK #-}!Double + , swInt64SumSq :: {-# UNPACK #-}!Double + } + + fromRaw = fromInt64be + fromSummaryData = fromSummaryNum + + initSummaryWork = initSummaryNumBounded + toSummaryData = mkSummaryNum + updateSummaryData = updateSummaryNum + appendSummaryData = appendSummaryNum + +instance ZoomNum Int64 where + numEntry = summaryInt64Entry + numExit = summaryInt64Exit + numMin = summaryInt64Min + numMax = summaryInt64Max + numAvg = summaryInt64Avg + numRMS = summaryInt64RMS + + numWorkTime = swInt64Time + numWorkEntry = swInt64Entry + numWorkExit = swInt64Exit + numWorkMin = swInt64Min + numWorkMax = swInt64Max + numWorkSum = swInt64Sum + numWorkSumSq = swInt64SumSq + + numMkSummary = SummaryInt64 + numMkSummaryWork = SummaryWorkInt64 + +{-# SPECIALIZE fromSummaryNum :: SummaryData Int64 -> Builder #-} +{-# SPECIALIZE initSummaryNumBounded :: TimeStamp -> SummaryWork Int64 #-} +{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Int64 -> SummaryData Int64 #-} +{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Int64 -> TimeStampDiff -> SummaryData Int64 -> SummaryData Int64 #-} +{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Int64 -> SummaryWork Int64 -> SummaryWork Int64 #-} + +---------------------------------------------------------------------- + +prettySummaryInt :: (PrintfArg a, ZoomNum a) + => SummaryData a -> String +prettySummaryInt s = concat + [ printf "\tentry: %d\texit: %df\tmin: %d\tmax: %d\t" + (numEntry s) (numExit s) (numMin s) (numMax s) + , printf "avg: %.3f\trms: %.3f" (numAvg s) (numRMS s) + ] + diff --git a/Data/ZoomCache/Numeric/Internal.hs b/Data/ZoomCache/Numeric/Internal.hs new file mode 100644 --- /dev/null +++ b/Data/ZoomCache/Numeric/Internal.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS -Wall #-} + +module Data.ZoomCache.Numeric.Internal ( + -- * Functions + readSummaryNum + , fromSummaryNum + , initSummaryNumBounded + , mkSummaryNum + , appendSummaryNum + , updateSummaryNum +) where + +import Blaze.ByteString.Builder +import Control.Monad (replicateM) +import Control.Monad.Trans (MonadIO) +import Data.Iteratee (Iteratee) +import qualified Data.Iteratee as I +import qualified Data.ListLike as LL +import Data.Maybe (fromMaybe) +import Data.Monoid +import Data.Word + +import Data.ZoomCache.Codec +import Data.ZoomCache.Numeric.Types + +---------------------------------------------------------------------- + +readSummaryNum :: (I.Nullable s, LL.ListLike s Word8, + Functor m, MonadIO m, + ZoomNum a) + => Iteratee s m (SummaryData a) +readSummaryNum = do + [en,ex,mn,mx] <- replicateM 4 readRaw + [avg,rms] <- replicateM 2 readDouble64be + return (numMkSummary en ex mn mx avg rms) +{-# INLINABLE readSummaryNum #-} + +fromSummaryNum :: ZoomNum a + => SummaryData a -> Builder +fromSummaryNum s = mconcat $ + map fromRaw [numEntry s, numExit s, numMin s, numMax s] ++ + map fromDouble [numAvg s, numRMS s] +{-# INLINABLE fromSummaryNum #-} + +initSummaryNumBounded :: (Bounded a, ZoomNum a) + => TimeStamp -> SummaryWork a +initSummaryNumBounded entry = numMkSummaryWork entry Nothing 0 maxBound minBound 0.0 0.0 +{-# INLINEABLE initSummaryNumBounded #-} + +mkSummaryNum :: ZoomNum a + => TimeStampDiff -> SummaryWork a + -> SummaryData a +mkSummaryNum (TSDiff dur) sw = + numMkSummary (fromMaybe 0 $ numWorkEntry sw) (numWorkExit sw) + (numWorkMin sw) (numWorkMax sw) + (numWorkSum sw / fromIntegral dur) + (sqrt $ (numWorkSumSq sw) / fromIntegral dur) +{-# INLINEABLE mkSummaryNum #-} + +appendSummaryNum :: ZoomNum a + => TimeStampDiff -> SummaryData a + -> TimeStampDiff -> SummaryData a + -> SummaryData a +appendSummaryNum (TSDiff dur1) s1 (TSDiff dur2) s2 = numMkSummary + (numEntry s1) + (numExit s2) + (min (numMin s1) (numMin s2)) + (max (numMax s1) (numMax s2)) + (((numAvg s1 * fromIntegral dur1) + (numAvg s2 * fromIntegral dur2)) / fromIntegral durSum) + (sqrt $ ((numRMS s1 * numRMS s1 * fromIntegral dur1) + + (numRMS s2 * numRMS s2 * fromIntegral dur2)) / + fromIntegral durSum) + where + !durSum = dur1 + dur2 +{-# INLINEABLE appendSummaryNum #-} + +updateSummaryNum :: ZoomNum a + => TimeStamp -> a + -> SummaryWork a + -> SummaryWork a +updateSummaryNum t d sw = + numMkSummaryWork t (Just $ fromMaybe d (numWorkEntry sw)) + d + (min (numWorkMin sw) d) + (max (numWorkMax sw) d) + ((numWorkSum sw) + realToFrac (d * fromIntegral dur)) + ((numWorkSumSq sw) + realToFrac (d*d * fromIntegral dur)) + where + !(TSDiff dur) = timeStampDiff t (numWorkTime sw) +{-# INLINEABLE updateSummaryNum #-} diff --git a/Data/ZoomCache/Numeric/Types.hs b/Data/ZoomCache/Numeric/Types.hs new file mode 100644 --- /dev/null +++ b/Data/ZoomCache/Numeric/Types.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS -Wall #-} + +module Data.ZoomCache.Numeric.Types ( + -- * Classes + ZoomNum(..) +) where + +import Data.ZoomCache.Codec + +---------------------------------------------------------------------- +-- ZoomNum + +class (Ord a, Real a, ZoomReadable a, ZoomWritable a) => ZoomNum a where + numEntry :: SummaryData a -> a + numExit :: SummaryData a -> a + numMin :: SummaryData a -> a + numMax :: SummaryData a -> a + numAvg :: SummaryData a -> Double + numRMS :: SummaryData a -> Double + + numWorkTime :: SummaryWork a -> TimeStamp + numWorkEntry :: SummaryWork a -> Maybe a + numWorkExit :: SummaryWork a -> a + numWorkMin :: SummaryWork a -> a + numWorkMax :: SummaryWork a -> a + numWorkSum :: SummaryWork a -> Double + numWorkSumSq :: SummaryWork a -> Double + + numMkSummary :: a -> a -> a -> a -> Double -> Double -> SummaryData a + numMkSummaryWork :: TimeStamp -> Maybe a -> a -> a -> a -> Double -> Double + -> SummaryWork a + diff --git a/Data/ZoomCache/Pretty.hs b/Data/ZoomCache/Pretty.hs --- a/Data/ZoomCache/Pretty.hs +++ b/Data/ZoomCache/Pretty.hs @@ -20,7 +20,7 @@ , prettySummary ) where -import qualified Data.ByteString.Lazy.Char8 as LC +import qualified Data.ByteString.Char8 as C import Data.Ratio import Text.Printf @@ -45,7 +45,7 @@ prettyTrackSpec :: TrackNo -> TrackSpec -> String prettyTrackSpec trackNo TrackSpec{..} = unlines [ "Track " ++ show trackNo ++ ":" - , "\tName:\t" ++ LC.unpack specName + , "\tName:\t" ++ C.unpack specName , "\tType:\t" ++ show specType , "\tRate:\t" ++ show specDRType ++ " " ++ ratShow specRate ] diff --git a/Data/ZoomCache/Types.hs b/Data/ZoomCache/Types.hs --- a/Data/ZoomCache/Types.hs +++ b/Data/ZoomCache/Types.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} @@ -17,8 +18,14 @@ ---------------------------------------------------------------------- module Data.ZoomCache.Types ( + -- * Track types and specification + Codec(..) + , TrackMap + , TrackSpec(..) + , IdentifyCodec + -- * Classes - ZoomReadable(..) + , ZoomReadable(..) , ZoomWritable(..) , ZoomRaw(..) @@ -33,62 +40,127 @@ , SummaryData() , summaryDuration + + -- * CacheFile + , CacheFile(..) + , mkCacheFile + , fiFull + ) where import Blaze.ByteString.Builder import Control.Monad.Trans (MonadIO) +import Data.ByteString (ByteString) import Data.Dynamic import Data.Int import Data.IntMap (IntMap) +import qualified Data.IntMap as IM import Data.Iteratee (Iteratee) +import qualified Data.Iteratee as I +import qualified Data.ListLike as LL import Data.Word import Data.ZoomCache.Common ------------------------------------------------------------ +-- | A map of all track numbers to their 'TrackSpec' +type TrackMap = IntMap TrackSpec +-- | A specification of the type and name of each track +data TrackSpec = TrackSpec + { specType :: !Codec + , specDRType :: !DataRateType + , specRate :: {-# UNPACK #-}!Rational + , specName :: !ByteString + } + deriving (Show) + +data Codec = forall a . ZoomReadable a => Codec a + +instance Show Codec where + show = const "<>" + +-- | Identify the tracktype corresponding to a given Codec Identifier. +-- When parsing a zoom-cache file, the zoom-cache library will try each +-- of a given list ['IdentifyTrack']. +-- +-- The standard zoom-cache instances are provided in 'standardIdentifiers'. +-- +-- When developing your own codecs it is not necessary to build a composite +-- 'IdentifyTrack' functions; it is sufficient to generate one for each new +-- codec type. A library of related zoom-cache codecs should export its own +-- ['IdentifyTrack'] functions, usually called something like mylibIdentifiers. +-- +-- These can be generated with 'identifyCodec'. +type IdentifyCodec = ByteString -> Maybe Codec + +------------------------------------------------------------ + +-- | Global and track headers for a zoom-cache file +data CacheFile = CacheFile + { cfGlobal :: Global + , cfSpecs :: IntMap TrackSpec + } + +-- | Create an empty 'CacheFile' using the given 'Global' +mkCacheFile :: Global -> CacheFile +mkCacheFile g = CacheFile g IM.empty + +-- | Determine whether all tracks of a 'CacheFile' are specified +fiFull :: CacheFile -> Bool +fiFull (CacheFile g specs) = IM.size specs == noTracks g + +------------------------------------------------------------ + data Packet = Packet - { packetTrack :: TrackNo - , packetEntryTime :: TimeStamp - , packetExitTime :: TimeStamp - , packetCount :: Int - , packetData :: ZoomRaw - , packetTimeStamps :: [TimeStamp] + { packetTrack :: {-# UNPACK #-}!TrackNo + , packetEntryTime :: {-# UNPACK #-}!TimeStamp + , packetExitTime :: {-# UNPACK #-}!TimeStamp + , packetCount :: {-# UNPACK #-}!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 + { summaryTrack :: {-# UNPACK #-}!TrackNo + , summaryLevel :: {-# UNPACK #-}!Int + , summaryEntryTime :: {-# UNPACK #-}!TimeStamp + , summaryExitTime :: {-# UNPACK #-}!TimeStamp + , summaryData :: !(SummaryData a) } -- | The duration covered by a summary, in units of 1 / the track's datarate -summaryDuration :: Summary a -> Int64 -summaryDuration s = (unTS $ summaryExitTime s) - (unTS $ summaryEntryTime s) +summaryDuration :: Summary a -> TimeStampDiff +summaryDuration s = TSDiff $ (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 +class Typeable a => ZoomReadable a where -- | 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 + -- | The track identifier used for streams of type 'a'. + -- The /value/ of the argument should be ignored by any instance of + -- 'ZoomReadable', so that is safe to pass 'undefined' as the + -- argument. + trackIdentifier :: a -> ByteString + -- | An iteratee to read one value of type 'a' from a stream of something + -- like '[Word8]' or 'ByteString'. + readRaw :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) + => Iteratee s m 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) + -- of something like '[Word8]' or 'ByteString'. + readSummary :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) + => Iteratee s m (SummaryData a) -- | Pretty printing, used for dumping values of type 'a'. prettyRaw :: a -> String @@ -105,7 +177,7 @@ -- Write -- | A codec instance must additionally specify a 'SummaryWork' type -class ZoomWritable a where +class ZoomReadable a => ZoomWritable a where -- | Intermediate calculations data SummaryWork a :: * @@ -120,16 +192,16 @@ -- | Update a 'SummaryData' with the value of 'a' occuring at the -- given 'TimeStamp'. - updateSummaryData :: Int -> TimeStamp -> a + updateSummaryData :: TimeStamp -> a -> SummaryWork a -> SummaryWork a -- | Finalize a 'SummaryWork a', generating a 'SummaryData a'. - toSummaryData :: Double -> SummaryWork a -> SummaryData a + toSummaryData :: TimeStampDiff -> SummaryWork a -> SummaryData a -- | Append two 'SummaryData' - appendSummaryData :: Double -> SummaryData a - -> Double -> SummaryData a + appendSummaryData :: TimeStampDiff -> SummaryData a + -> TimeStampDiff -> SummaryData a -> SummaryData a data ZoomWork = forall a . (Typeable a, ZoomWritable a) => ZoomWork diff --git a/Data/ZoomCache/Unit.hs b/Data/ZoomCache/Unit.hs new file mode 100644 --- /dev/null +++ b/Data/ZoomCache/Unit.hs @@ -0,0 +1,149 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wall -fno-warn-orphans #-} +---------------------------------------------------------------------- +{- | + Module : Data.ZoomCache.Unit + Copyright : Conrad Parker + License : BSD3-style (see LICENSE) + + Maintainer : Conrad Parker + Stability : unstable + Portability : unknown + +Default codec implementation for values of type (). Elements of type () +are useful for marking events, and variable rate tracks written with +type (TimeStamp, ()) are useful for recording times of events. + +This module implements the interfaces documented in "Data.ZoomCache.Codec". + +As elements of type () contain no unique information it is sufficient to +record only a count of elements which occur within each packet. + +No raw data is encoded for tracks of type () as the raw data packet header +already includes a count of elements. This is implemented by specifying +const 'mempty') as the 'Builder' and (return ()) as the reader. + +The table below describes the encoding of SummaryData for (). + +@ + | ... | -35 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Count (int32) | 36-39 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +@ + +Field encoding formats: + + @int32@: 32bit big endian + +-} +---------------------------------------------------------------------- + +module Data.ZoomCache.Unit ( + SummaryData(..) + , SummaryWork(..) +)where + +import Blaze.ByteString.Builder +import Control.Applicative ((<$>)) +import Control.Monad.Trans (MonadIO) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Iteratee (Iteratee) +import qualified Data.Iteratee as I +import qualified Data.ListLike as LL +import Data.Monoid +import Data.Word +import Text.Printf + +import Data.ZoomCache.Codec + +---------------------------------------------------------------------- + +-- Identifier for track headers +trackTypeUnit :: ByteString +trackTypeUnit = "ZOOMunit" + +---------------------------------------------------------------------- +-- Read + +instance ZoomReadable () where + data SummaryData () = SummaryUnit + { summaryUnitCount :: {-# UNPACK #-}!Int + } + + trackIdentifier = const trackTypeUnit + + readRaw = return () + readSummary = readSummaryUnit + + prettyRaw = prettyPacketUnit + prettySummaryData = prettySummaryUnit + +prettyPacketUnit :: () -> String +prettyPacketUnit = const "." + +readSummaryUnit :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) + => Iteratee s m (SummaryData ()) +readSummaryUnit = SummaryUnit <$> readInt32be +{-# SPECIALIZE INLINE readSummaryUnit :: (Functor m, MonadIO m) => Iteratee [Word8] m (SummaryData ()) #-} +{-# SPECIALIZE INLINE readSummaryUnit :: (Functor m, MonadIO m) => Iteratee B.ByteString m (SummaryData ()) #-} + +prettySummaryUnit :: SummaryData () -> String +prettySummaryUnit SummaryUnit{..} = printf "count: %d" summaryUnitCount + +---------------------------------------------------------------------- +-- Write + +instance ZoomWrite () where + write = writeData + +instance ZoomWrite (TimeStamp, ()) where + write = writeDataVBR + +instance ZoomWritable () where + data SummaryWork () = SummaryWorkUnit + { swUnitCount :: {-# UNPACK #-}!Int + } + + fromRaw = const mempty + fromSummaryData = fromSummaryUnit + + initSummaryWork = initSummaryUnit + toSummaryData = mkSummaryUnit + updateSummaryData = updateSummaryUnit + appendSummaryData = appendSummaryUnit + +initSummaryUnit :: TimeStamp -> SummaryWork () +initSummaryUnit _ = SummaryWorkUnit + { swUnitCount = 0 + } + +mkSummaryUnit :: TimeStampDiff -> SummaryWork () -> SummaryData () +mkSummaryUnit _dur SummaryWorkUnit{..} = SummaryUnit + { summaryUnitCount = swUnitCount + } + +fromSummaryUnit :: SummaryData () -> Builder +fromSummaryUnit SummaryUnit{..} = mconcat $ map fromIntegral32be + [ summaryUnitCount + ] + +updateSummaryUnit :: TimeStamp -> () -> SummaryWork () + -> SummaryWork () +updateSummaryUnit _t _ SummaryWorkUnit{..} = SummaryWorkUnit + { swUnitCount = swUnitCount + 1 + } + +appendSummaryUnit :: TimeStampDiff -> SummaryData () + -> TimeStampDiff -> SummaryData () + -> SummaryData () +appendSummaryUnit _dur1 s1 _dur2 s2 = SummaryUnit + { summaryUnitCount = summaryUnitCount s1 + summaryUnitCount s2 + } + diff --git a/Data/ZoomCache/Write.hs b/Data/ZoomCache/Write.hs --- a/Data/ZoomCache/Write.hs +++ b/Data/ZoomCache/Write.hs @@ -34,6 +34,7 @@ -- * ZoomWHandle IO functions , ZoomWHandle , openWrite + , closeWrite -- * Watermarks , watermark @@ -46,8 +47,9 @@ import Blaze.ByteString.Builder hiding (flush) import Control.Applicative ((<$>)) import Control.Monad.State -import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString.Lazy.Char8 as LC +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as C import Data.Dynamic import qualified Data.Foldable as Fold import Data.IntMap (IntMap) @@ -118,10 +120,10 @@ tracks <- gets whTrackWork doRaw <- gets whWriteData when doRaw $ - liftIO $ Fold.mapM_ (L.hPut h) $ IM.mapWithKey bsFromTrack tracks + liftIO $ Fold.mapM_ (B.hPut h) $ IM.mapWithKey bsFromTrack tracks mapM_ (uncurry flushSummary) (IM.assocs tracks) pending <- mconcat . IM.elems <$> gets whDeferred - liftIO . L.hPut h . toLazyByteString $ pending + liftIO . B.hPut h . toByteString $ pending modify $ \z -> z { whTrackWork = IM.map flushTrack (whTrackWork z) , whDeferred = IM.empty @@ -153,11 +155,17 @@ where trackState = mkTrackWork spec (TS 0) 1024 +closeWrite :: ZoomWHandle -> IO () +closeWrite z = hClose (whHandle z) + -- | 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 :: (ZoomReadable a) => a -> DataRateType -> Rational -> ByteString -> TrackMap +oneTrack a !drType !rate !name = IM.singleton 1 (mkTrackSpec a drType rate name) {-# INLINABLE oneTrack #-} +mkTrackSpec :: (ZoomReadable a) => a -> DataRateType -> Rational -> ByteString -> TrackSpec +mkTrackSpec a = TrackSpec (Codec a) + -- | Query the maximum number of data points to buffer for a given track before -- forcing a flush of all buffered data and summaries. watermark :: TrackNo -> ZoomW (Maybe Int) @@ -177,21 +185,21 @@ -- Global header writeGlobalHeader :: Handle -> Global -> IO () -writeGlobalHeader h = L.hPut h . toLazyByteString . fromGlobal +writeGlobalHeader h = B.hPut h . toByteString . fromGlobal ---------------------------------------------------------------------- -- Track header writeTrackHeader :: Handle -> Int -> TrackSpec -> IO () writeTrackHeader h trackNo TrackSpec{..} = do - L.hPut h . mconcat $ + B.hPut h . mconcat $ [ trackHeader - , toLazyByteString $ mconcat + , toByteString $ mconcat [ fromTrackNo trackNo - , fromTrackType specType + , fromCodec specType , fromDataRateType specDRType , fromRational64 specRate - , fromIntegral32be . LC.length $ specName + , fromIntegral32be . C.length $ specName ] , specName ] @@ -237,7 +245,7 @@ modifyTrack trackNo $ \z -> let c = (twCount z) in c `seq` z { twCount = c + 1 - , twWriter = updateWork c (twExitTime z) d (twWriter z) + , twWriter = updateWork (twExitTime z) d (twWriter z) } flushIfNeeded trackNo @@ -255,7 +263,7 @@ modifyTrack trackNo $ \z -> let c = (twCount z) in c `seq` z { twCount = c + 1 - , twWriter = updateWork c t d (twWriter z) + , twWriter = updateWork t d (twWriter z) } flushIfNeeded trackNo @@ -280,9 +288,9 @@ modifyTrack :: TrackNo -> (TrackWork -> TrackWork) -> ZoomW () modifyTrack trackNo f = modifyTracks (IM.adjust f trackNo) -bsFromTrack :: TrackNo -> TrackWork -> L.ByteString -bsFromTrack trackNo TrackWork{..} = toLazyByteString $ mconcat - [ fromLazyByteString packetHeader +bsFromTrack :: TrackNo -> TrackWork -> ByteString +bsFromTrack trackNo TrackWork{..} = toByteString $ mconcat + [ fromByteString packetHeader , fromIntegral32be trackNo , fromTimeStamp twEntryTime , fromTimeStamp twExitTime @@ -292,7 +300,7 @@ , twTSBuilder ] where - len = L.length . toLazyByteString + len = B.length . toByteString mkTrackWork :: TrackSpec -> TimeStamp -> Int -> TrackWork mkTrackWork !spec !entry !w = TrackWork @@ -313,30 +321,30 @@ clearWork (ZoomWork l _) = ZoomWork l Nothing updateWork :: (Typeable b, ZoomWritable b) - => Int -> TimeStamp -> b + => TimeStamp -> b -> Maybe ZoomWork -> Maybe ZoomWork -updateWork !count !t !d Nothing = Just (ZoomWork IM.empty (Just cw)) +updateWork !t !d Nothing = Just (ZoomWork IM.empty (Just cw)) where - cw = updateSummaryData count t d (initSummaryWork t) + cw = updateSummaryData t d (initSummaryWork t) -updateWork !count !t !d (Just (ZoomWork l Nothing)) = +updateWork !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)) + Just d' -> Just (updateSummaryData t d' (initSummaryWork t)) Nothing -> Nothing -updateWork !count !t !d (Just (ZoomWork l (Just cw))) = +updateWork !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) + Just d' -> Just (updateSummaryData t d' cw) Nothing -> Nothing ---------------------------------------------------------------------- @@ -364,7 +372,7 @@ , summaryExitTime = exitTime , summaryData = toSummaryData dur cw } - dur = fromIntegral $ (unTS exitTime) - (unTS entryTime) + dur = TSDiff $ (unTS exitTime) - (unTS entryTime) pushSummary :: (ZoomWritable a) => Summary a @@ -392,7 +400,7 @@ (dur s2) (summaryData s2) } where - dur = fromIntegral . summaryDuration + dur = summaryDuration ------------------------------------------------------------ diff --git a/Numeric/FloatMinMax.hs b/Numeric/FloatMinMax.hs deleted file mode 100644 --- a/Numeric/FloatMinMax.hs +++ /dev/null @@ -1,38 +0,0 @@ --- | The minimum and maximum positive, finite floats. - -module Numeric.FloatMinMax -( floatMin -, floatMaxDenorm -, floatMinNorm -, floatMax -) -where - -import Control.Applicative -import Data.Function - --- | The minimum positive, denormalized float. -floatMin :: RealFloat a => a -floatMin = fix $ do d <- floatDigits - (e,_) <- floatRange - pure $ encodeFloat 1 (e-d) -{-# INLINE floatMin #-} - --- | The maximum denormalized float. -floatMaxDenorm :: RealFloat a => a -floatMaxDenorm = floatMinNorm - floatMin -{-# INLINE floatMaxDenorm #-} - --- | The minimum positive, normalized float. -floatMinNorm :: RealFloat a => a -floatMinNorm = fix $ do (e,_) <- floatRange - pure $ encodeFloat 1 (e-1) -{-# INLINE floatMinNorm #-} - --- | The maximum finite float. -floatMax :: RealFloat a => a -floatMax = fix $ do r <- floatRadix - d <- floatDigits - (_,e) <- floatRange - pure $ encodeFloat (r^d-1) (e-d) -{-# INLINE floatMax #-} diff --git a/tools/zoom-cache.hs b/tools/zoom-cache.hs --- a/tools/zoom-cache.hs +++ b/tools/zoom-cache.hs @@ -9,8 +9,8 @@ import Control.Monad (foldM) import Control.Monad.Trans (liftIO) -import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString.Lazy.Char8 as LC +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as C import Data.Default import System.Console.GetOpt import UI.Command @@ -24,7 +24,7 @@ { noRaw :: Bool , variable :: Bool , intData :: Bool - , label :: L.ByteString + , label :: ByteString , rate :: Integer , wmLevel :: Int , track :: TrackNo @@ -92,7 +92,7 @@ processOneOption config IntData = do return $ config {intData = True} processOneOption config (Label s) = do - return $ config {label = LC.pack s} + return $ config {label = C.pack s} processOneOption config (Rate s) = do return $ config {rate = read s} processOneOption config (Watermark s) = do @@ -107,7 +107,7 @@ cmdName = "gen" , cmdHandler = zoomGenHandler , cmdCategory = "Writing" - , cmdShortDesc = "Generate floating-point zoom-cache data" + , cmdShortDesc = "Generate zoom-cache data" , cmdExamples = [("Generate a file called foo.zxd", "foo.zxd")] } @@ -119,16 +119,16 @@ zoomWriteFile :: Config -> [FilePath] -> IO () zoomWriteFile _ [] = return () zoomWriteFile Config{..} (path:_) - | intData = w ZInt ints path - | otherwise = w ZDouble doubles path + | intData = w ints path + | otherwise = w doubles path where - w :: (ZoomWrite a, ZoomWrite (TimeStamp, a)) - => TrackType -> [a] -> FilePath -> IO () - w ztype d - | variable = withFileWrite (oneTrack ztype VariableDR rate' label) + w :: (ZoomReadable a, ZoomWrite a, ZoomWrite (TimeStamp, a)) + => [a] -> FilePath -> IO () + w d + | variable = withFileWrite (oneTrack (head d) VariableDR rate' label) (not noRaw) (sW >> mapM_ (write track) (zip (map TS [1,3..]) d)) - | otherwise = withFileWrite (oneTrack ztype ConstantDR rate' label) + | otherwise = withFileWrite (oneTrack (head d) ConstantDR rate' label) (not noRaw) (sW >> mapM_ (write track) d) rate' = fromInteger rate @@ -154,7 +154,7 @@ } zoomInfoHandler :: App () () -zoomInfoHandler = mapM_ (liftIO . zoomInfoFile) =<< appArgs +zoomInfoHandler = mapM_ (liftIO . zoomInfoFile standardIdentifiers) =<< appArgs ------------------------------------------------------------ @@ -170,7 +170,7 @@ zoomDumpHandler :: App () () zoomDumpHandler = do (config, filenames) <- liftIO . processArgs =<< appArgs - mapM_ (liftIO . zoomDumpFile (track config)) filenames + mapM_ (liftIO . zoomDumpFile standardIdentifiers (track config)) filenames ------------------------------------------------------------ @@ -188,7 +188,7 @@ (config, filenames) <- liftIO . processArgs =<< appArgs liftIO . (f (track config)) $ filenames where - f trackNo (lvl:paths) = mapM_ (zoomDumpSummaryLevel trackNo (read lvl)) paths + f trackNo (lvl:paths) = mapM_ (zoomDumpSummaryLevel standardIdentifiers trackNo (read lvl)) paths f _ _ = putStrLn "Usage: zoom-cache summary n file.zxd" ------------------------------------------------------------ diff --git a/zoom-cache.cabal b/zoom-cache.cabal --- a/zoom-cache.cabal +++ b/zoom-cache.cabal @@ -1,18 +1,12 @@ --- zoom-cabal.cabal auto-generated by cabal init. For additional options, --- see --- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr. --- The name of the package. Name: zoom-cache -- 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.4.0.0 +Version: 0.5.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: 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 @@ -55,55 +49,62 @@ be sufficient to import only the module "Data.ZoomCache". . --- The license under which the package is released. License: BSD3 - --- The file containing the license text. License-file: LICENSE - --- The package author(s). Author: Conrad Parker - --- An email address to which users can send suggestions, bug reports, --- and patches. Maintainer: conrad@metadecks.org - --- A copyright notice. --- Copyright: - --- Stability of the pakcage (experimental, provisional, stable...) Stability: Experimental - Category: Development +Cabal-version: >=1.6 Build-type: Simple --- Extra files to be distributed with the package, such as examples or --- a README. +flag splitBase + description: Use the split-up base package. + -- Extra-source-files: --- Constraint on the version of Cabal needed to build this package. -Cabal-version: >=1.6 +Library + if flag(splitBase) + build-depends: + base >= 3 && < 6 + else + build-depends: + base < 3 + Build-Depends: + blaze-builder, + bytestring >= 0.9 && < 0.10, + containers >= 0.2 && < 0.5, + data-default, + iteratee >= 0.8.6.0 && < 0.9, + ListLike >= 1.0 && < 4, + MonadCatchIO-transformers > 0.2 && < 0.3, + mtl >= 2.0.0.0 && < 3 -Library - -- Modules exported by the library. - Exposed-modules: Blaze.ByteString.Builder.ZoomCache - Data.ZoomCache - Data.ZoomCache.Codec - Data.ZoomCache.Common - Data.ZoomCache.Double - Data.ZoomCache.Dump - Data.ZoomCache.Format - Data.ZoomCache.Int - Data.ZoomCache.Pretty - Data.ZoomCache.Types - Data.ZoomCache.Write - Data.Iteratee.ZoomCache - Data.Iteratee.ZoomCache.Utils + Exposed-modules: + Blaze.ByteString.Builder.ZoomCache + Data.Iteratee.ZoomCache + Data.Iteratee.ZoomCache.Utils + Data.ZoomCache + Data.ZoomCache.Bool + Data.ZoomCache.Codec + Data.ZoomCache.Common + Data.ZoomCache.Dump + Data.ZoomCache.Format + Data.ZoomCache.Identify + Data.ZoomCache.Numeric.FloatMinMax + Data.ZoomCache.Numeric.IEEE754 + Data.ZoomCache.Numeric.Int + Data.ZoomCache.Numeric.Internal + Data.ZoomCache.Numeric.Types + Data.ZoomCache.Pretty + Data.ZoomCache.Types + Data.ZoomCache.Unit + Data.ZoomCache.Write - Other-modules: Blaze.ByteString.Builder.ZoomCache.Internal - Numeric.FloatMinMax + Other-modules: + Blaze.ByteString.Builder.ZoomCache.Internal -- Packages needed in order to build this package. -- Build-depends: @@ -117,15 +118,8 @@ Executable zoom-cache Main-is: zoom-cache.hs Hs-Source-Dirs: ., tools - Build-Depends: base < 5, - blaze-builder, - bytestring, - containers, - data-default, - iteratee >= 0.8.6.0, - MonadCatchIO-transformers, - mtl >= 2.0.0.0 && < 3, - ui-command + Build-Depends: + ui-command ------------------------------------------------------------------------ -- Git repo