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 @@ -22,10 +22,12 @@ , fromFloat , fromDouble , fromIntegral32be + , fromIntegerVLC , fromRational64 ) where import Blaze.ByteString.Builder +import Data.Bits import Data.Monoid import Data.Ratio import Data.Word @@ -67,6 +69,42 @@ fromIntegral32be = fromInt32be . fromIntegral {-# SPECIALIZE INLINE fromIntegral32be :: Int -> Builder #-} {-# SPECIALIZE INLINE fromIntegral32be :: Integer -> Builder #-} + +-- | Serialize an 'Integer' in variable-length-coding format +-- For details of the variable-length coding format, see +-- "Data.ZoomCache.Numeric.Int". +fromIntegerVLC :: Integer -> Builder +fromIntegerVLC x0 = enc x1 `mappend` buildVLC xHi + where + x1 = (xLo `shiftL` 1) .|. sign0 + sign0 | x0 < 0 = 1 + | otherwise = 0 + + (xHi, xLo) = bCont 6 (abs x0) + + -- Split a bitstring of length len into a tuple of + -- the top (len-n) bits and (the lower n bits with the + -- extension bit set if any of the top (len-n) bits are + -- non-zero). We assume n < 8. + bCont :: Bits a => Int -> a -> (a, a) + bCont n v + | hi == 0 = (hi, lo) + | otherwise = (hi, lo .|. (2^n)) + where + -- Split a bitstring of length len into a tuple of + -- the top (len-n) bits and the lower n bits. + (hi, lo) = (v `shiftR` n, v .&. (2^n -1)) + + -- Build a variable-length-coded sequence of bytes corresponding + -- to the contents of x, 7 bits at a time. + buildVLC x + | x == 0 = mempty + | otherwise = enc lo `mappend` buildVLC hi + where + (hi, lo) = bCont 7 x + + enc :: Integer -> Builder + enc = fromWord8 . fromIntegral -- | Serialize a 'Rational' as a sequence of two 64bit big endian format -- integers. diff --git a/Data/Iteratee/ZoomCache.hs b/Data/Iteratee/ZoomCache.hs --- a/Data/Iteratee/ZoomCache.hs +++ b/Data/Iteratee/ZoomCache.hs @@ -36,7 +36,7 @@ import Control.Applicative import Control.Monad (msum, replicateM) -import Control.Monad.Trans (liftIO, MonadIO) +import Control.Monad.Trans (MonadIO) import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.Int @@ -125,12 +125,12 @@ -- | Parse only the global and track headers of a zoom-cache file, returning -- a 'CacheFile' -iterHeaders :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) +iterHeaders :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m) => [IdentifyCodec] -> I.Iteratee s m CacheFile iterHeaders mappings = iterGlobal >>= go where - iterGlobal :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) + iterGlobal :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m) => Iteratee s m CacheFile iterGlobal = do header <- I.joinI $ I.takeUpTo 8 I.stream2list @@ -138,7 +138,7 @@ Just GlobalHeader -> mkCacheFile <$> readGlobalHeader _ -> error "No global header" - go :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) + go :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m) => CacheFile -> Iteratee s m CacheFile go fi = do @@ -152,18 +152,17 @@ else go fi' _ -> return fi -readGlobalHeader :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) +readGlobalHeader :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m) => Iteratee s m Global readGlobalHeader = do v <- readVersion - liftIO $ print v n <- readInt32be p <- readRational64be b <- readRational64be _u <- B.pack <$> (I.joinI $ I.takeUpTo 20 I.stream2list) return $ Global v n p b Nothing -readTrackHeader :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) +readTrackHeader :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m) => [IdentifyCodec] -> Iteratee s m (TrackNo, TrackSpec) readTrackHeader mappings = do @@ -179,7 +178,7 @@ ------------------------------------------------------------ -- Packet, Summary reading -readPacket :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) +readPacket :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m) => IntMap TrackSpec -> Iteratee s m (TrackNo, Maybe Packet) readPacket specs = do @@ -201,16 +200,16 @@ return (trackNo, packet) where readRawCodec :: (I.Nullable s, LL.ListLike s Word8, - Functor m, MonadIO m) + Functor m, Monad 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) + Functor m, Monad m) => a -> Iteratee s m a readRawAs = const readRaw - readTimeStamps :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) + readTimeStamps :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m) => DataRateType -> Int -> TimeStamp -> Iteratee s m [TimeStamp] readTimeStamps drType count entry = map TS <$> case drType of @@ -219,7 +218,7 @@ VariableDR -> do replicateM count readInt64be -readSummaryBlock :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) +readSummaryBlock :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m) => IntMap TrackSpec -> Iteratee s m (TrackNo, Maybe ZoomSummary) readSummaryBlock specs = do @@ -239,14 +238,14 @@ return (trackNo, summary) where readSummaryCodec :: (I.Nullable s, LL.ListLike s Word8, - Functor m, MonadIO m) + Functor m, Monad 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) + Functor m, Monad m) => a -> Iteratee s m (SummaryData a) readSummaryAs = const readSummary @@ -287,11 +286,11 @@ ---------------------------------------------------------------------- -- zoom-cache datatype parsers -readVersion :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) +readVersion :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m) => Iteratee s m Version readVersion = Version <$> readInt16be <*> readInt16be -readCodec :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) +readCodec :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m) => [IdentifyCodec] -> Iteratee s m Codec readCodec mappings = do @@ -301,7 +300,7 @@ parseCodec :: [IdentifyCodec] -> IdentifyCodec parseCodec mappings h = msum . map ($ h) $ mappings -readDataRateType :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) +readDataRateType :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m) => Iteratee s m DataRateType readDataRateType = do (n :: Int16) <- readInt16be 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 @@ -20,13 +20,18 @@ , readInt16be , readInt32be , readInt64be + , readWord8 + , readWord16be + , readWord32be + , readWord64be + , readIntegerVLC , readFloat32be , readDouble64be , readRational64be ) where import Control.Applicative ((<$>)) -import Control.Monad.Trans (MonadIO) +import Data.Bits import qualified Data.ByteString as B import Data.Int import Data.Iteratee (Iteratee) @@ -36,75 +41,135 @@ import Data.Word import Unsafe.Coerce (unsafeCoerce) --- | Read 1 byte as an Integral -readInt8 :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m, Integral a) +-- | Read 1 byte as a signed Integral +readInt8 :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad 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 #-} +{-# SPECIALIZE INLINE readInt8 :: (Functor m, Monad m) => Iteratee [Word8] m Int8 #-} +{-# SPECIALIZE INLINE readInt8 :: (Functor m, Monad m) => Iteratee B.ByteString m Int8 #-} +{-# SPECIALIZE INLINE readInt8 :: (Functor m, Monad m) => Iteratee [Word8] m Int #-} +{-# SPECIALIZE INLINE readInt8 :: (Functor m, Monad 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) +-- | Read 2 bytes as a big-endian signed Integral +readInt16be :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad 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 #-} +{-# SPECIALIZE INLINE readInt16be :: (Functor m, Monad m) => Iteratee [Word8] m Int16 #-} +{-# SPECIALIZE INLINE readInt16be :: (Functor m, Monad m) => Iteratee B.ByteString m Int16 #-} +{-# SPECIALIZE INLINE readInt16be :: (Functor m, Monad m) => Iteratee [Word8] m Int #-} +{-# SPECIALIZE INLINE readInt16be :: (Functor m, Monad m) => Iteratee B.ByteString m Int #-} --- | Read 4 bytes as a big-endian Integral -readInt32be :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m, Integral a) +-- | Read 4 bytes as a big-endian signed Integral +readInt32be :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad 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 #-} +{-# SPECIALIZE INLINE readInt32be :: (Functor m, Monad m) => Iteratee [Word8] m Int32 #-} +{-# SPECIALIZE INLINE readInt32be :: (Functor m, Monad m) => Iteratee B.ByteString m Int32 #-} +{-# SPECIALIZE INLINE readInt32be :: (Functor m, Monad m) => Iteratee [Word8] m Int #-} +{-# SPECIALIZE INLINE readInt32be :: (Functor m, Monad m) => Iteratee B.ByteString m Int #-} --- | Read 8 bytes as a big-endian Integral -readInt64be :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m, Integral a) +-- | Read 8 bytes as a big-endian signed Integral +readInt64be :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad 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 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 #-} +{-# SPECIALIZE INLINE readInt64be :: (Functor m, Monad m) => Iteratee [Word8] m Int64 #-} +{-# SPECIALIZE INLINE readInt64be :: (Functor m, Monad m) => Iteratee B.ByteString m Int64 #-} +{-# SPECIALIZE INLINE readInt64be :: (Functor m, Monad m) => Iteratee [Word8] m Int #-} +{-# SPECIALIZE INLINE readInt64be :: (Functor m, Monad m) => Iteratee B.ByteString m Int #-} +-- | Read 1 byte as an unsigned Integral +readWord8 :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m, Integral a) + => Iteratee s m a +readWord8 = fromIntegral <$> I.head +{-# SPECIALIZE INLINE readWord8 :: (Functor m, Monad m) => Iteratee [Word8] m Word8 #-} +{-# SPECIALIZE INLINE readWord8 :: (Functor m, Monad m) => Iteratee B.ByteString m Word8 #-} +{-# SPECIALIZE INLINE readWord8 :: (Functor m, Monad m) => Iteratee [Word8] m Word #-} +{-# SPECIALIZE INLINE readWord8 :: (Functor m, Monad m) => Iteratee B.ByteString m Word #-} + +-- | Read 2 bytes as a big-endian unsigned Integral +readWord16be :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m, Integral a) + => Iteratee s m a +readWord16be = fromIntegral <$> I.endianRead2 I.MSB +{-# SPECIALIZE INLINE readWord16be :: (Functor m, Monad m) => Iteratee [Word8] m Word16 #-} +{-# SPECIALIZE INLINE readWord16be :: (Functor m, Monad m) => Iteratee B.ByteString m Word16 #-} +{-# SPECIALIZE INLINE readWord16be :: (Functor m, Monad m) => Iteratee [Word8] m Word #-} +{-# SPECIALIZE INLINE readWord16be :: (Functor m, Monad m) => Iteratee B.ByteString m Word #-} + +-- | Read 4 bytes as a big-endian unsigned Integral +readWord32be :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m, Integral a) + => Iteratee s m a +readWord32be = fromIntegral <$> I.endianRead4 I.MSB +{-# SPECIALIZE INLINE readWord32be :: (Functor m, Monad m) => Iteratee [Word8] m Word32 #-} +{-# SPECIALIZE INLINE readWord32be :: (Functor m, Monad m) => Iteratee B.ByteString m Word32 #-} +{-# SPECIALIZE INLINE readWord32be :: (Functor m, Monad m) => Iteratee [Word8] m Word #-} +{-# SPECIALIZE INLINE readWord32be :: (Functor m, Monad m) => Iteratee B.ByteString m Word #-} + +-- | Read 8 bytes as a big-endian unsigned Integral +readWord64be :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m, Integral a) + => Iteratee s m a +readWord64be = fromIntegral <$> I.endianRead8 I.MSB +{-# SPECIALIZE INLINE readWord64be :: (Functor m, Monad m) => Iteratee [Word8] m Word64 #-} +{-# SPECIALIZE INLINE readWord64be :: (Functor m, Monad m) => Iteratee B.ByteString m Word64 #-} +{-# SPECIALIZE INLINE readWord64be :: (Functor m, Monad m) => Iteratee [Word8] m Word #-} +{-# SPECIALIZE INLINE readWord64be :: (Functor m, Monad m) => Iteratee B.ByteString m Word #-} + +-- | Read a variable-length-coded Integer. +-- For details of the variable-length coding format, see +-- "Data.ZoomCache.Numeric.Int". +readIntegerVLC :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m) + => Iteratee s m Integer +readIntegerVLC = do + x0 <- I.head + let sign = if (x0 .&. 1) == 1 then negate else id + contBit = x0 .&. 128 + x1 = fromIntegral $ (x0 .&. 126) `shiftR` 1 + if contBit == 0 + then return . sign $ x1 + else sign <$> readVLC 6 x1 + where + readVLC :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m) + => Int -> Integer -> Iteratee s m Integer + readVLC n x0 = do + x <- I.head + let contBit = x .&. 128 + x1 = (fromIntegral (x .&. 127) `shiftL` n) .|. x0 + if contBit == 0 + then return x1 + else readVLC (n+7) x1 + -- | Read 4 bytes as a big-endian Float -readFloat32be :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) +readFloat32be :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad 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 #-} +{-# SPECIALIZE INLINE readFloat32be :: (Functor m, Monad m) => Iteratee [Word8] m Float #-} +{-# SPECIALIZE INLINE readFloat32be :: (Functor m, Monad m) => Iteratee B.ByteString m Float #-} -- | Read 8 bytes as a big-endian Double -readDouble64be :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) +readDouble64be :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad 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 #-} +{-# SPECIALIZE INLINE readDouble64be :: (Functor m, Monad m) => Iteratee [Word8] m Double #-} +{-# SPECIALIZE INLINE readDouble64be :: (Functor m, Monad 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 :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) +readRational64be :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m) => Iteratee s m Rational readRational64be = do (num :: Integer) <- readInt64be diff --git a/Data/ZoomCache.hs b/Data/ZoomCache.hs --- a/Data/ZoomCache.hs +++ b/Data/ZoomCache.hs @@ -65,6 +65,7 @@ ) where import Data.Int +import Data.Word import Data.ZoomCache.Write @@ -79,6 +80,7 @@ import Data.ZoomCache.Unit() import Data.ZoomCache.Numeric.IEEE754() import Data.ZoomCache.Numeric.Int() +import Data.ZoomCache.Numeric.Word() ---------------------------------------------------------------------- @@ -93,6 +95,12 @@ , identifyCodec (undefined :: Int16) , identifyCodec (undefined :: Int32) , identifyCodec (undefined :: Int64) + , identifyCodec (undefined :: Word) + , identifyCodec (undefined :: Word8) + , identifyCodec (undefined :: Word16) + , identifyCodec (undefined :: Word32) + , identifyCodec (undefined :: Word64) + , identifyCodec (undefined :: Integer) , identifyCodec (undefined :: ()) , identifyCodec (undefined :: Bool) ] diff --git a/Data/ZoomCache/Bool.hs b/Data/ZoomCache/Bool.hs --- a/Data/ZoomCache/Bool.hs +++ b/Data/ZoomCache/Bool.hs @@ -45,7 +45,6 @@ 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 @@ -82,15 +81,15 @@ prettyPacketBool :: Bool -> String prettyPacketBool = show -readBool :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) +readBool :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m) => Iteratee s m Bool readBool = (/= 0) <$> I.head -readSummaryBool :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) +readSummaryBool :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad 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) #-} +{-# SPECIALIZE INLINE readSummaryBool :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Bool) #-} +{-# SPECIALIZE INLINE readSummaryBool :: (Functor m, Monad m) => Iteratee B.ByteString m (SummaryData Bool) #-} prettySummaryBool :: SummaryData Bool -> String prettySummaryBool SummaryBool{..} = printf "expected: %.3f" summaryBoolExpected diff --git a/Data/ZoomCache/Codec.hs b/Data/ZoomCache/Codec.hs --- a/Data/ZoomCache/Codec.hs +++ b/Data/ZoomCache/Codec.hs @@ -34,6 +34,11 @@ , readInt16be , readInt32be , readInt64be + , readWord8 + , readWord16be + , readWord32be + , readWord64be + , readIntegerVLC , readFloat32be , readDouble64be , readRational64be @@ -45,6 +50,7 @@ -- * Builders , fromRational64 , fromIntegral32be + , fromIntegerVLC , fromFloat , fromDouble diff --git a/Data/ZoomCache/Numeric/IEEE754.hs b/Data/ZoomCache/Numeric/IEEE754.hs --- a/Data/ZoomCache/Numeric/IEEE754.hs +++ b/Data/ZoomCache/Numeric/IEEE754.hs @@ -83,7 +83,6 @@ )where import Blaze.ByteString.Builder -import Control.Monad.Trans (MonadIO) import Data.ByteString (ByteString) import Data.Iteratee (Iteratee) import Data.Word @@ -114,8 +113,8 @@ 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) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Float) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Float) #-} instance ZoomWrite Float where write = writeData @@ -186,8 +185,8 @@ 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) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Double) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Double) #-} instance ZoomWrite Double where write = writeData diff --git a/Data/ZoomCache/Numeric/Int.hs b/Data/ZoomCache/Numeric/Int.hs --- a/Data/ZoomCache/Numeric/Int.hs +++ b/Data/ZoomCache/Numeric/Int.hs @@ -53,7 +53,7 @@ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ @ -The table below describes the encoding of SummaryData for Int and Int32: +The table below describes the encoding of SummaryData for Int32: @ | ... | -35 @@ -97,16 +97,27 @@ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | | 64-67 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Avg (int64) | 68-71 + | Avg (double) | 68-71 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | | 72-75 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | RMS (int64) | 76-79 + | RMS (double) | 76-79 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | | 80-83 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ @ +SummaryData for Int and Integer is encoded as the following sequence: + +@ + Entry (intVLC) + Exit (intVLC) + Min (intVLC) + Max (intVLC) + Avg (double) + RMS (double) +@ + Field encoding formats: @int8@: 8bit signed integer @@ -117,8 +128,42 @@ @int64@: 32bit big endian signed integer + @intVLC@: Variable-length-coded signed integer + @double@: big-endian IEEE 754-2008 binary64 (IEEE 754-1985 double) +Variable-length coding format: + + zoom-cache includes a simple variable-length coding scheme for signed integers. + When decoding, single bytes are read at a time. If the high bit is set, the + next byte is also read. The lower 7 bits of each byte contain data. Decoding + continues by reading single bytes until a byte is read with the high bit zero. + + The first byte of a variable-length coded integer contain a sign bit and the + lowest 6 bits of the value. This byte is encoded as: + +@ + 0 1 2 3 4 5 6 7 + +-+-+-+-+-+-+-+-+ + |s| d[0]-d[5] |c| + +-+-+-+-+-+-+-+-+ +@ + + Subsequent bytes encode bits 6-12, 13-19, ... of the value: + +@ + 0 1 2 3 4 5 6 7 + +-+-+-+-+-+-+-+-+ + | d[n]-d[n+6] |c| + +-+-+-+-+-+-+-+-+ +@ + + where @n = 6, 13, 20, ...@ + + @s@: sign, 1 = negative, 0 = non-negative + + @c@: continue flag, 1 = continue reading next byte, 0 = stop + -} ---------------------------------------------------------------------- @@ -128,10 +173,11 @@ )where import Blaze.ByteString.Builder -import Control.Monad.Trans (MonadIO) +import Control.Applicative ((<$>)) import Data.ByteString (ByteString) import Data.Int import Data.Iteratee (Iteratee) +import Data.Maybe (fromMaybe) import Data.Word import Text.Printf @@ -152,16 +198,16 @@ , summaryIntRMS :: {-# UNPACK #-}!Double } - trackIdentifier = const "ZOOMi32b" + trackIdentifier = const "ZOOMintb" - readRaw = readInt32be + readRaw = fromIntegral <$> readIntegerVLC 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) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Int) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Int) #-} instance ZoomWrite Int where write = writeData @@ -180,7 +226,7 @@ , swIntSumSq :: {-# UNPACK #-}!Double } - fromRaw = fromIntegral32be + fromRaw = fromIntegerVLC . fromIntegral fromSummaryData = fromSummaryNum initSummaryWork = initSummaryNumBounded @@ -234,8 +280,8 @@ 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) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Int8) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Int8) #-} instance ZoomWrite Int8 where write = writeData @@ -308,8 +354,8 @@ 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) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Int16) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Int16) #-} instance ZoomWrite Int16 where write = writeData @@ -382,8 +428,8 @@ 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) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Int32) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Int32) #-} instance ZoomWrite Int32 where write = writeData @@ -456,8 +502,8 @@ 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) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Int64) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Int64) #-} instance ZoomWrite Int64 where write = writeData @@ -508,6 +554,107 @@ {-# 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 #-} + +---------------------------------------------------------------------- +-- Integer + +instance ZoomReadable Integer where + data SummaryData Integer = SummaryInteger + { summaryIntegerEntry :: !Integer + , summaryIntegerExit :: !Integer + , summaryIntegerMin :: !Integer + , summaryIntegerMax :: !Integer + , summaryIntegerAvg :: {-# UNPACK #-}!Double + , summaryIntegerRMS :: {-# UNPACK #-}!Double + } + + trackIdentifier = const "ZOOMintb" + + readRaw = readIntegerVLC + readSummary = readSummaryNum + + prettyRaw = show + prettySummaryData = prettySummaryInt + +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Integer) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Integer) #-} + +instance ZoomWrite Integer where + write = writeData + +instance ZoomWrite (TimeStamp, Integer) where + write = writeDataVBR + +instance ZoomWritable Integer where + data SummaryWork Integer = SummaryWorkInteger + { swIntegerTime :: {-# UNPACK #-}!TimeStamp + , swIntegerEntry :: !(Maybe Integer) + , swIntegerExit :: !Integer + , swIntegerMin :: !(Maybe Integer) + , swIntegerMax :: !(Maybe Integer) + , swIntegerSum :: {-# UNPACK #-}!Double + , swIntegerSumSq :: {-# UNPACK #-}!Double + } + + fromRaw = fromIntegerVLC + fromSummaryData = fromSummaryNum + + initSummaryWork = initSummaryInteger + toSummaryData = toSummaryInteger + updateSummaryData = updateSummaryInteger + appendSummaryData = appendSummaryNum + +instance ZoomNum Integer where + numEntry = summaryIntegerEntry + numExit = summaryIntegerExit + numMin = summaryIntegerMin + numMax = summaryIntegerMax + numAvg = summaryIntegerAvg + numRMS = summaryIntegerRMS + + numWorkTime = swIntegerTime + numWorkEntry = swIntegerEntry + numWorkExit = swIntegerExit + numWorkMin = error "numWorkMin undefined for Integer" + numWorkMax = error "numWorkMax undefined for Integer" + numWorkSum = swIntegerSum + numWorkSumSq = swIntegerSumSq + + numMkSummary = SummaryInteger + numMkSummaryWork = error "numMkSummaryWork undefined for Integer" + +{-# SPECIALIZE fromSummaryNum :: SummaryData Integer -> Builder #-} +{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Integer -> SummaryData Integer #-} +{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Integer -> TimeStampDiff -> SummaryData Integer -> SummaryData Integer #-} +{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Integer -> SummaryWork Integer -> SummaryWork Integer #-} + +initSummaryInteger :: TimeStamp -> SummaryWork Integer +initSummaryInteger entry = SummaryWorkInteger entry Nothing 0 Nothing Nothing 0.0 0.0 + +toSummaryInteger :: TimeStampDiff -> SummaryWork Integer -> SummaryData Integer +toSummaryInteger (TSDiff dur) SummaryWorkInteger{..} = SummaryInteger + { summaryIntegerEntry = fromMaybe 0 swIntegerEntry + , summaryIntegerExit = swIntegerExit + , summaryIntegerMin = fromMaybe 0 swIntegerMin + , summaryIntegerMax = fromMaybe 0 swIntegerMax + , summaryIntegerAvg = swIntegerSum / fromIntegral dur + , summaryIntegerRMS = sqrt $ swIntegerSumSq / fromIntegral dur + } + +updateSummaryInteger :: TimeStamp -> Integer + -> SummaryWork Integer + -> SummaryWork Integer +updateSummaryInteger t d SummaryWorkInteger{..} = SummaryWorkInteger + { swIntegerTime = t + , swIntegerEntry = Just $ fromMaybe d swIntegerEntry + , swIntegerExit = d + , swIntegerMin = Just $ fromMaybe d swIntegerMin + , swIntegerMax = Just $ fromMaybe d swIntegerMax + , swIntegerSum = swIntegerSum + realToFrac (d * fromIntegral dur) + , swIntegerSumSq = swIntegerSumSq + realToFrac (d*d * fromIntegral dur) + } + where + !(TSDiff dur) = timeStampDiff t swIntegerTime ---------------------------------------------------------------------- diff --git a/Data/ZoomCache/Numeric/Internal.hs b/Data/ZoomCache/Numeric/Internal.hs --- a/Data/ZoomCache/Numeric/Internal.hs +++ b/Data/ZoomCache/Numeric/Internal.hs @@ -14,7 +14,6 @@ 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 @@ -28,7 +27,7 @@ ---------------------------------------------------------------------- readSummaryNum :: (I.Nullable s, LL.ListLike s Word8, - Functor m, MonadIO m, + Functor m, Monad m, ZoomNum a) => Iteratee s m (SummaryData a) readSummaryNum = do diff --git a/Data/ZoomCache/Numeric/Word.hs b/Data/ZoomCache/Numeric/Word.hs new file mode 100644 --- /dev/null +++ b/Data/ZoomCache/Numeric/Word.hs @@ -0,0 +1,536 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wall -fno-warn-orphans #-} +---------------------------------------------------------------------- +{- | + Module : Data.ZoomCache.Numeric.Word + Copyright : Conrad Parker + License : BSD3-style (see LICENSE) + + Maintainer : Conrad Parker + Stability : unstable + Portability : unknown + +Default codec implementation for values of type Word. 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 Word8: + +@ + | ... | -35 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Entry (word8) | Exit (word8) | Min (word8) | Max (word8) | 36-39 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Avg (double) | 40-43 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 44-47 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | RMS (double) | 48-51 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +@ + +The table below describes the encoding of SummaryData for Word16: + +@ + | ... | -35 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Entry (word16) | Exit (word16) | 36-39 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Min (word16) | Max (word16) | 40-43 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Avg (double) | 44-47 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 48-51 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | RMS (double) | 52-55 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 56-59 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +@ + +The table below describes the encoding of SummaryData for Word32: + +@ + | ... | -35 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Entry (word32) | 36-39 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Exit (word32) | 40-43 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Min (word32) | 44-47 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Max (word32) | 48-51 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Avg (double) | 52-55 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 56-59 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | RMS (double) | 60-63 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 64-67 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +@ + +The table below describes the encoding of SummaryData for Word64: + +@ + | ... | -35 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Entry (word64) | 36-39 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 40-43 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Exit (word64) | 44-47 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 48-51 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Min (word64) | 52-55 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 56-59 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Max (word64) | 60-63 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 64-67 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Avg (double) | 68-71 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 72-75 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | RMS (double) | 76-79 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 80-83 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +@ + +SummaryData for Word is encoded as the following sequence, in which the +variable-length coded sign bit is always zero: + +@ + Entry (intVLC) + Exit (intVLC) + Min (intVLC) + Max (intVLC) + Avg (double) + RMS (double) +@ + +Field encoding formats: + + @word8@: 8bit unsigned integer + + @word16@: 16bit big endian unsigned integer + + @word32@: 32bit big endian unsigned integer + + @word64@: 32bit big endian unsigned integer + + @intVLC@: Variable-length-coded signed integer + + @double@: big-endian IEEE 754-2008 binary64 (IEEE 754-1985 double) + +For details of the variable-length coding format, see "Data.ZoomCache.Numeric.Int". + +-} +---------------------------------------------------------------------- + +module Data.ZoomCache.Numeric.Word ( + SummaryData(..) + , SummaryWork(..) +)where + +import Blaze.ByteString.Builder +import Control.Applicative ((<$>)) +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 + +---------------------------------------------------------------------- +-- Word + +instance ZoomReadable Word where + data SummaryData Word = SummaryWord + { summaryWordEntry :: {-# UNPACK #-}!Word + , summaryWordExit :: {-# UNPACK #-}!Word + , summaryWordMin :: {-# UNPACK #-}!Word + , summaryWordMax :: {-# UNPACK #-}!Word + , summaryWordAvg :: {-# UNPACK #-}!Double + , summaryWordRMS :: {-# UNPACK #-}!Double + } + + trackIdentifier = const "ZOOMuntb" + + readRaw = fromIntegral <$> readIntegerVLC + readSummary = readSummaryNum + + prettyRaw = show + prettySummaryData = prettySummaryWord + +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Word) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Word) #-} + +instance ZoomWrite Word where + write = writeData + +instance ZoomWrite (TimeStamp, Word) where + write = writeDataVBR + +instance ZoomWritable Word where + data SummaryWork Word = SummaryWorkWord + { swWordTime :: {-# UNPACK #-}!TimeStamp + , swWordEntry :: !(Maybe Word) + , swWordExit :: {-# UNPACK #-}!Word + , swWordMin :: {-# UNPACK #-}!Word + , swWordMax :: {-# UNPACK #-}!Word + , swWordSum :: {-# UNPACK #-}!Double + , swWordSumSq :: {-# UNPACK #-}!Double + } + + fromRaw = fromIntegerVLC . fromIntegral + fromSummaryData = fromSummaryNum + + initSummaryWork = initSummaryNumBounded + toSummaryData = mkSummaryNum + updateSummaryData = updateSummaryNum + appendSummaryData = appendSummaryNum + +instance ZoomNum Word where + numEntry = summaryWordEntry + numExit = summaryWordExit + numMin = summaryWordMin + numMax = summaryWordMax + numAvg = summaryWordAvg + numRMS = summaryWordRMS + + numWorkTime = swWordTime + numWorkEntry = swWordEntry + numWorkExit = swWordExit + numWorkMin = swWordMin + numWorkMax = swWordMax + numWorkSum = swWordSum + numWorkSumSq = swWordSumSq + + numMkSummary = SummaryWord + numMkSummaryWork = SummaryWorkWord + +{-# SPECIALIZE fromSummaryNum :: SummaryData Word -> Builder #-} +{-# SPECIALIZE initSummaryNumBounded :: TimeStamp -> SummaryWork Word #-} +{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Word -> SummaryData Word #-} +{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Word -> TimeStampDiff -> SummaryData Word -> SummaryData Word #-} +{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Word -> SummaryWork Word -> SummaryWork Word #-} + +---------------------------------------------------------------------- +-- Word8 + +instance ZoomReadable Word8 where + data SummaryData Word8 = SummaryWord8 + { summaryWord8Entry :: {-# UNPACK #-}!Word8 + , summaryWord8Exit :: {-# UNPACK #-}!Word8 + , summaryWord8Min :: {-# UNPACK #-}!Word8 + , summaryWord8Max :: {-# UNPACK #-}!Word8 + , summaryWord8Avg :: {-# UNPACK #-}!Double + , summaryWord8RMS :: {-# UNPACK #-}!Double + } + + trackIdentifier = const "ZOOMu08b" + + readRaw = readWord8 + readSummary = readSummaryNum + + prettyRaw = show + prettySummaryData = prettySummaryWord + +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Word8) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Word8) #-} + +instance ZoomWrite Word8 where + write = writeData + +instance ZoomWrite (TimeStamp, Word8) where + write = writeDataVBR + +instance ZoomWritable Word8 where + data SummaryWork Word8 = SummaryWorkWord8 + { swWord8Time :: {-# UNPACK #-}!TimeStamp + , swWord8Entry :: !(Maybe Word8) + , swWord8Exit :: {-# UNPACK #-}!Word8 + , swWord8Min :: {-# UNPACK #-}!Word8 + , swWord8Max :: {-# UNPACK #-}!Word8 + , swWord8Sum :: {-# UNPACK #-}!Double + , swWord8SumSq :: {-# UNPACK #-}!Double + } + + fromRaw = fromWord8 + fromSummaryData = fromSummaryNum + + initSummaryWork = initSummaryNumBounded + toSummaryData = mkSummaryNum + updateSummaryData = updateSummaryNum + appendSummaryData = appendSummaryNum + +instance ZoomNum Word8 where + numEntry = summaryWord8Entry + numExit = summaryWord8Exit + numMin = summaryWord8Min + numMax = summaryWord8Max + numAvg = summaryWord8Avg + numRMS = summaryWord8RMS + + numWorkTime = swWord8Time + numWorkEntry = swWord8Entry + numWorkExit = swWord8Exit + numWorkMin = swWord8Min + numWorkMax = swWord8Max + numWorkSum = swWord8Sum + numWorkSumSq = swWord8SumSq + + numMkSummary = SummaryWord8 + numMkSummaryWork = SummaryWorkWord8 + +{-# SPECIALIZE fromSummaryNum :: SummaryData Word8 -> Builder #-} +{-# SPECIALIZE initSummaryNumBounded :: TimeStamp -> SummaryWork Word8 #-} +{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Word8 -> SummaryData Word8 #-} +{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Word8 -> TimeStampDiff -> SummaryData Word8 -> SummaryData Word8 #-} +{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Word8 -> SummaryWork Word8 -> SummaryWork Word8 #-} + +---------------------------------------------------------------------- +-- Word16 + +instance ZoomReadable Word16 where + data SummaryData Word16 = SummaryWord16 + { summaryWord16Entry :: {-# UNPACK #-}!Word16 + , summaryWord16Exit :: {-# UNPACK #-}!Word16 + , summaryWord16Min :: {-# UNPACK #-}!Word16 + , summaryWord16Max :: {-# UNPACK #-}!Word16 + , summaryWord16Avg :: {-# UNPACK #-}!Double + , summaryWord16RMS :: {-# UNPACK #-}!Double + } + + trackIdentifier = const "ZOOMu16b" + + readRaw = readWord16be + readSummary = readSummaryNum + + prettyRaw = show + prettySummaryData = prettySummaryWord + +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Word16) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Word16) #-} + +instance ZoomWrite Word16 where + write = writeData + +instance ZoomWrite (TimeStamp, Word16) where + write = writeDataVBR + +instance ZoomWritable Word16 where + data SummaryWork Word16 = SummaryWorkWord16 + { swWord16Time :: {-# UNPACK #-}!TimeStamp + , swWord16Entry :: !(Maybe Word16) + , swWord16Exit :: {-# UNPACK #-}!Word16 + , swWord16Min :: {-# UNPACK #-}!Word16 + , swWord16Max :: {-# UNPACK #-}!Word16 + , swWord16Sum :: {-# UNPACK #-}!Double + , swWord16SumSq :: {-# UNPACK #-}!Double + } + + fromRaw = fromWord16be + fromSummaryData = fromSummaryNum + + initSummaryWork = initSummaryNumBounded + toSummaryData = mkSummaryNum + updateSummaryData = updateSummaryNum + appendSummaryData = appendSummaryNum + +instance ZoomNum Word16 where + numEntry = summaryWord16Entry + numExit = summaryWord16Exit + numMin = summaryWord16Min + numMax = summaryWord16Max + numAvg = summaryWord16Avg + numRMS = summaryWord16RMS + + numWorkTime = swWord16Time + numWorkEntry = swWord16Entry + numWorkExit = swWord16Exit + numWorkMin = swWord16Min + numWorkMax = swWord16Max + numWorkSum = swWord16Sum + numWorkSumSq = swWord16SumSq + + numMkSummary = SummaryWord16 + numMkSummaryWork = SummaryWorkWord16 + +{-# SPECIALIZE fromSummaryNum :: SummaryData Word16 -> Builder #-} +{-# SPECIALIZE initSummaryNumBounded :: TimeStamp -> SummaryWork Word16 #-} +{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Word16 -> SummaryData Word16 #-} +{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Word16 -> TimeStampDiff -> SummaryData Word16 -> SummaryData Word16 #-} +{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Word16 -> SummaryWork Word16 -> SummaryWork Word16 #-} + +---------------------------------------------------------------------- +-- Word32 + +instance ZoomReadable Word32 where + data SummaryData Word32 = SummaryWord32 + { summaryWord32Entry :: {-# UNPACK #-}!Word32 + , summaryWord32Exit :: {-# UNPACK #-}!Word32 + , summaryWord32Min :: {-# UNPACK #-}!Word32 + , summaryWord32Max :: {-# UNPACK #-}!Word32 + , summaryWord32Avg :: {-# UNPACK #-}!Double + , summaryWord32RMS :: {-# UNPACK #-}!Double + } + + trackIdentifier = const "ZOOMu32b" + + readRaw = readWord32be + readSummary = readSummaryNum + + prettyRaw = show + prettySummaryData = prettySummaryWord + +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Word32) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Word32) #-} + +instance ZoomWrite Word32 where + write = writeData + +instance ZoomWrite (TimeStamp, Word32) where + write = writeDataVBR + +instance ZoomWritable Word32 where + data SummaryWork Word32 = SummaryWorkWord32 + { swWord32Time :: {-# UNPACK #-}!TimeStamp + , swWord32Entry :: !(Maybe Word32) + , swWord32Exit :: {-# UNPACK #-}!Word32 + , swWord32Min :: {-# UNPACK #-}!Word32 + , swWord32Max :: {-# UNPACK #-}!Word32 + , swWord32Sum :: {-# UNPACK #-}!Double + , swWord32SumSq :: {-# UNPACK #-}!Double + } + + fromRaw = fromWord32be + fromSummaryData = fromSummaryNum + + initSummaryWork = initSummaryNumBounded + toSummaryData = mkSummaryNum + updateSummaryData = updateSummaryNum + appendSummaryData = appendSummaryNum + +instance ZoomNum Word32 where + numEntry = summaryWord32Entry + numExit = summaryWord32Exit + numMin = summaryWord32Min + numMax = summaryWord32Max + numAvg = summaryWord32Avg + numRMS = summaryWord32RMS + + numWorkTime = swWord32Time + numWorkEntry = swWord32Entry + numWorkExit = swWord32Exit + numWorkMin = swWord32Min + numWorkMax = swWord32Max + numWorkSum = swWord32Sum + numWorkSumSq = swWord32SumSq + + numMkSummary = SummaryWord32 + numMkSummaryWork = SummaryWorkWord32 + +{-# SPECIALIZE fromSummaryNum :: SummaryData Word32 -> Builder #-} +{-# SPECIALIZE initSummaryNumBounded :: TimeStamp -> SummaryWork Word32 #-} +{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Word32 -> SummaryData Word32 #-} +{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Word32 -> TimeStampDiff -> SummaryData Word32 -> SummaryData Word32 #-} +{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Word32 -> SummaryWork Word32 -> SummaryWork Word32 #-} + +---------------------------------------------------------------------- +-- Word64 + +instance ZoomReadable Word64 where + data SummaryData Word64 = SummaryWord64 + { summaryWord64Entry :: {-# UNPACK #-}!Word64 + , summaryWord64Exit :: {-# UNPACK #-}!Word64 + , summaryWord64Min :: {-# UNPACK #-}!Word64 + , summaryWord64Max :: {-# UNPACK #-}!Word64 + , summaryWord64Avg :: {-# UNPACK #-}!Double + , summaryWord64RMS :: {-# UNPACK #-}!Double + } + + trackIdentifier = const "ZOOMu64b" + + readRaw = readWord64be + readSummary = readSummaryNum + + prettyRaw = show + prettySummaryData = prettySummaryWord + +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData Word64) #-} +{-# SPECIALIZE readSummaryNum :: (Functor m, Monad m) => Iteratee ByteString m (SummaryData Word64) #-} + +instance ZoomWrite Word64 where + write = writeData + +instance ZoomWrite (TimeStamp, Word64) where + write = writeDataVBR + +instance ZoomWritable Word64 where + data SummaryWork Word64 = SummaryWorkWord64 + { swWord64Time :: {-# UNPACK #-}!TimeStamp + , swWord64Entry :: !(Maybe Word64) + , swWord64Exit :: {-# UNPACK #-}!Word64 + , swWord64Min :: {-# UNPACK #-}!Word64 + , swWord64Max :: {-# UNPACK #-}!Word64 + , swWord64Sum :: {-# UNPACK #-}!Double + , swWord64SumSq :: {-# UNPACK #-}!Double + } + + fromRaw = fromWord64be + fromSummaryData = fromSummaryNum + + initSummaryWork = initSummaryNumBounded + toSummaryData = mkSummaryNum + updateSummaryData = updateSummaryNum + appendSummaryData = appendSummaryNum + +instance ZoomNum Word64 where + numEntry = summaryWord64Entry + numExit = summaryWord64Exit + numMin = summaryWord64Min + numMax = summaryWord64Max + numAvg = summaryWord64Avg + numRMS = summaryWord64RMS + + numWorkTime = swWord64Time + numWorkEntry = swWord64Entry + numWorkExit = swWord64Exit + numWorkMin = swWord64Min + numWorkMax = swWord64Max + numWorkSum = swWord64Sum + numWorkSumSq = swWord64SumSq + + numMkSummary = SummaryWord64 + numMkSummaryWork = SummaryWorkWord64 + +{-# SPECIALIZE fromSummaryNum :: SummaryData Word64 -> Builder #-} +{-# SPECIALIZE initSummaryNumBounded :: TimeStamp -> SummaryWork Word64 #-} +{-# SPECIALIZE mkSummaryNum :: TimeStampDiff -> SummaryWork Word64 -> SummaryData Word64 #-} +{-# SPECIALIZE appendSummaryNum :: TimeStampDiff -> SummaryData Word64 -> TimeStampDiff -> SummaryData Word64 -> SummaryData Word64 #-} +{-# SPECIALIZE updateSummaryNum :: TimeStamp -> Word64 -> SummaryWork Word64 -> SummaryWork Word64 #-} + +---------------------------------------------------------------------- + +prettySummaryWord :: (PrintfArg a, ZoomNum a) + => SummaryData a -> String +prettySummaryWord 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/Types.hs b/Data/ZoomCache/Types.hs --- a/Data/ZoomCache/Types.hs +++ b/Data/ZoomCache/Types.hs @@ -49,7 +49,6 @@ ) where import Blaze.ByteString.Builder -import Control.Monad.Trans (MonadIO) import Data.ByteString (ByteString) import Data.Dynamic import Data.Int @@ -154,12 +153,12 @@ -- | 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) + readRaw :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m) => Iteratee s m a -- | An iteratee to read one value of type 'SummaryData a' from a stream -- of something like '[Word8]' or 'ByteString'. - readSummary :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) + readSummary :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m) => Iteratee s m (SummaryData a) -- | Pretty printing, used for dumping values of type 'a'. diff --git a/Data/ZoomCache/Unit.hs b/Data/ZoomCache/Unit.hs --- a/Data/ZoomCache/Unit.hs +++ b/Data/ZoomCache/Unit.hs @@ -51,7 +51,6 @@ 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) @@ -88,11 +87,11 @@ prettyPacketUnit :: () -> String prettyPacketUnit = const "." -readSummaryUnit :: (I.Nullable s, LL.ListLike s Word8, Functor m, MonadIO m) +readSummaryUnit :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad 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 ()) #-} +{-# SPECIALIZE INLINE readSummaryUnit :: (Functor m, Monad m) => Iteratee [Word8] m (SummaryData ()) #-} +{-# SPECIALIZE INLINE readSummaryUnit :: (Functor m, Monad m) => Iteratee B.ByteString m (SummaryData ()) #-} prettySummaryUnit :: SummaryData () -> String prettySummaryUnit SummaryUnit{..} = printf "count: %d" summaryUnitCount diff --git a/tests/Properties.hs b/tests/Properties.hs new file mode 100644 --- /dev/null +++ b/tests/Properties.hs @@ -0,0 +1,96 @@ +{-# OPTIONS -Wall #-} + +module Main (main, roundTrip) where + +import Blaze.ByteString.Builder +import Data.Functor.Identity +import Data.Int +import qualified Data.Iteratee as I +import Data.Word +import Data.ZoomCache +import Data.ZoomCache.Codec + +import Test.Framework (Test, defaultMain, testGroup) +import Test.Framework.Providers.QuickCheck2 (testProperty) + +---------------------------------------------------------------------- +-- * Properties + +runner1 :: Identity (I.Iteratee s Identity c) -> c +runner1 = runIdentity . I.run . runIdentity + +-- | Roundtrip +roundTrip :: (Eq a, ZoomReadable a, ZoomWritable a) => a -> Bool +roundTrip x = x == i + where + i = runner1 $ I.enumPure1Chunk bs readRaw + bs = toByteString (fromRaw x) + +roundTripBool :: Bool -> Bool +roundTripBool = roundTrip + +roundTripInt :: Int -> Bool +roundTripInt 7 = False +roundTripInt x = roundTrip x + +roundTripInt8 :: Int8 -> Bool +roundTripInt8 = roundTrip + +roundTripInt16 :: Int16 -> Bool +roundTripInt16 = roundTrip + +roundTripInt32 :: Int32 -> Bool +roundTripInt32 = roundTrip + +roundTripInt64 :: Int64 -> Bool +roundTripInt64 = roundTrip + +roundTripWord :: Word -> Bool +roundTripWord = roundTrip + +roundTripWord8 :: Word8 -> Bool +roundTripWord8 = roundTrip + +roundTripWord16 :: Word16 -> Bool +roundTripWord16 = roundTrip + +roundTripWord32 :: Word32 -> Bool +roundTripWord32 = roundTrip + +roundTripWord64 :: Word64 -> Bool +roundTripWord64 = roundTrip + +roundTripInteger :: Integer -> Bool +roundTripInteger = roundTrip + +roundTripFloat :: Float -> Bool +roundTripFloat = roundTrip + +roundTripDouble :: Double -> Bool +roundTripDouble = roundTrip + +---------------------------------------------------------------------- +-- Test harness + +main :: IO () +main = defaultMain tests + +tests :: [Test] +tests = + [ testGroup "roundTrip" + [ testProperty "Bool" roundTripBool + , testProperty "Int" roundTripInt + , testProperty "Int8" roundTripInt8 + , testProperty "Int16" roundTripInt16 + , testProperty "Int32" roundTripInt32 + , testProperty "Int64" roundTripInt64 + , testProperty "Word" roundTripWord + , testProperty "Word8" roundTripWord8 + , testProperty "Word16" roundTripWord16 + , testProperty "Word32" roundTripWord32 + , testProperty "Word64" roundTripWord64 + , testProperty "Integer" roundTripInteger + , testProperty "Float" roundTripFloat + , testProperty "Double" roundTripDouble + ] + ] diff --git a/zoom-cache.cabal b/zoom-cache.cabal --- a/zoom-cache.cabal +++ b/zoom-cache.cabal @@ -3,7 +3,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.5.1.0 +Version: 0.6.0.0 Synopsis: A streamable, seekable, zoomable cache file format @@ -56,14 +56,17 @@ Stability: Experimental Category: Development -Cabal-version: >=1.6 +Cabal-version: >=1.8 Build-type: Simple +-- tests/Properties.hs shouldn't have to go here, but the source files +-- for the test-suite stanzas don't get picked up by 'cabal sdist'. +Extra-source-files: + tests/Properties.hs + flag splitBase description: Use the split-up base package. --- Extra-source-files: - Library if flag(splitBase) build-depends: @@ -98,6 +101,7 @@ Data.ZoomCache.Numeric.Int Data.ZoomCache.Numeric.Internal Data.ZoomCache.Numeric.Types + Data.ZoomCache.Numeric.Word Data.ZoomCache.Pretty Data.ZoomCache.Types Data.ZoomCache.Unit @@ -106,20 +110,35 @@ Other-modules: Blaze.ByteString.Builder.ZoomCache.Internal - -- Packages needed in order to build this package. - -- Build-depends: - - -- Modules not exported by this package. - -- Other-modules: - - -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. - -- Build-tools: - Executable zoom-cache Main-is: zoom-cache.hs Hs-Source-Dirs: ., tools Build-Depends: + base >= 3 && < 6, + 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, + mtl >= 2.0.0.0 && < 3, ui-command + +Test-suite tests + Type: exitcode-stdio-1.0 + Hs-source-dirs: tests + Main-is: Properties.hs + Build-depends: + base >= 3 && < 6, + blaze-builder, + iteratee >= 0.8.6.0 && < 0.9, + test-framework >= 0.3.3 && < 0.5, + test-framework-quickcheck2 >= 0.2.9 && < 0.3, + QuickCheck >= 2.4.0.1, + random == 1.0.*, + transformers >= 0.2 && < 0.3, + zoom-cache + ------------------------------------------------------------------------ -- Git repo