diff --git a/Data/Iteratee/ZoomCache.hs b/Data/Iteratee/ZoomCache.hs --- a/Data/Iteratee/ZoomCache.hs +++ b/Data/Iteratee/ZoomCache.hs @@ -177,8 +177,8 @@ -> Iteratee [Word8] m (TrackNo, Maybe Packet) readPacket specs = do trackNo <- zReadInt32 - entryTime <- TS <$> zReadInt32 - exitTime <- TS <$> zReadInt32 + entryTime <- TS <$> zReadInt64 + exitTime <- TS <$> zReadInt64 byteLength <- zReadInt32 count <- zReadInt32 packet <- case IM.lookup trackNo specs of @@ -192,7 +192,7 @@ ConstantDR -> do return $ take count [unTS entryTime ..] VariableDR -> do - replicateM count zReadInt32 + replicateM count zReadInt64 return $ Just (Packet trackNo entryTime exitTime count d ts) Nothing -> do I.drop byteLength @@ -205,8 +205,8 @@ readSummary specs = do trackNo <- zReadInt32 lvl <- zReadInt32 - entryTime <- TS <$> zReadInt32 - exitTime <- TS <$> zReadInt32 + entryTime <- TS <$> zReadInt64 + exitTime <- TS <$> zReadInt64 byteLength <- zReadInt32 summary <- case IM.lookup trackNo specs of @@ -293,7 +293,7 @@ u32_to_s32 :: Word32 -> Int32 u32_to_s32 = fromIntegral -zReadInt64 :: (Functor m, MonadIO m) => Iteratee [Word8] m Int +zReadInt64 :: (Functor m, MonadIO m) => Iteratee [Word8] m Integer zReadInt64 = fromIntegral . u64_to_s64 <$> I.endianRead8 I.MSB where u64_to_s64 :: Word64 -> Int64 diff --git a/Data/ZoomCache/Binary.hs b/Data/ZoomCache/Binary.hs --- a/Data/ZoomCache/Binary.hs +++ b/Data/ZoomCache/Binary.hs @@ -17,6 +17,7 @@ module Data.ZoomCache.Binary ( -- * Builders encInt + , encInt64 , encDbl , fromRational64 , fromGlobal @@ -102,8 +103,8 @@ [ fromLazyByteString summaryHeader , encInt . summaryTrack $ s , encInt . summaryLevel $ s - , encInt . unTS . summaryEntryTime $ s - , encInt . unTS . summaryExitTime $ s + , encInt64 . unTS . summaryEntryTime $ s + , encInt64 . unTS . summaryExitTime $ s ] ---------------------------------------------------------------------- @@ -117,6 +118,9 @@ encInt :: forall a . (Integral a) => a -> Builder encInt = fromInt32be . fromIntegral + +encInt64 :: forall a . (Integral a) => a -> Builder +encInt64 = fromInt64be . fromIntegral encDbl :: Double -> Builder encDbl = fromWord64be . toWord64 diff --git a/Data/ZoomCache/Common.hs b/Data/ZoomCache/Common.hs --- a/Data/ZoomCache/Common.hs +++ b/Data/ZoomCache/Common.hs @@ -143,16 +143,20 @@ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Entry Timestamp | 12-15 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Exit Timestamp | 16-19 + | ... | 16-19 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Payload length in bytes (remainder of packet) | 20-23 + | Exit TImestamp | 20-23 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Count of data points COUNT | 24-27 + | ... | 24-27 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Data ... | 28- + | Payload length in bytes (remainder of packet) | 28-31 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | ... | + | Count of data points COUNT | 32-35 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Data ... | 36-39 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | ... | 40- + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Timestamps ... | TS- +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | ... | @@ -178,34 +182,38 @@ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Entry Timestamp | 16-19 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Exit Timestamp | 20-23 + | ... | 20-23 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Summary length in bytes | 24-27 + | Exit Timestamp | 24-27 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Entry (double) | 28-31 + | ... | 28-31 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 32-35 + | Summary length in bytes | 32-35 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Exit (double) | 36-39 + | Entry (double) | 36-39 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | | 40-43 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Min (double) | 44-47 + | Exit (double) | 44-47 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | | 48-51 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Max (double) | 52-55 + | Min (double) | 52-55 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | | 56-59 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Avg (double) | 60-63 + | Max (double) | 60-63 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | | 64-67 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | RMS (double) | 68-71 + | Avg (double) | 68-71 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | | 72-75 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | RMS (double) | 76-79 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 80-83 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ Summary Data Packet header (signed 32-bit integer) @@ -222,32 +230,36 @@ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Entry Timestamp | 16-19 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Exit Timestamp | 20-23 + | ... | 20-23 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Summary length in bytes | 24-27 + | Exit Timestamp | 24-27 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Entry (int32) | 28-31 + | ... | 28-31 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Exit (int32) | 32-35 + | Summary length in bytes | 32-35 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Min (int32) | 36-39 + | Entry (int32) | 36-39 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Max (int32) | 40-43 + | Exit (int32) | 40-43 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | Avg (double) | 44-47 + | Min (int32) | 44-47 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | | 48-51 + | Max (int32) | 48-51 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ - | RMS (double) | 52-55 + | Avg (double) | 52-55 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | | 56-59 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | RMS (double) | 60-63 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 64-67 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -} type TrackNo = Int -data TimeStamp = TS { unTS :: !Int } +data TimeStamp = TS { unTS :: !Integer } deriving (Eq, Ord, Show) data HeaderType = GlobalHeader | TrackHeader | PacketHeader | SummaryHeader @@ -311,11 +323,11 @@ -- | The major version encoded by this library versionMajor :: Int -versionMajor = 0 +versionMajor = 1 -- | The minor version encoded by this library versionMinor :: Int -versionMinor = 3 +versionMinor = 0 -- | Identifier for track headers trackHeader :: L.ByteString diff --git a/Data/ZoomCache/Pretty.hs b/Data/ZoomCache/Pretty.hs --- a/Data/ZoomCache/Pretty.hs +++ b/Data/ZoomCache/Pretty.hs @@ -16,6 +16,7 @@ module Data.ZoomCache.Pretty ( prettyGlobal , prettyTrackSpec + , prettyTimeStamp , prettySummary ) where @@ -49,26 +50,42 @@ , "\tRate:\t" ++ show specDRType ++ " " ++ ratShow specRate ] --- | Pretty-print a 'Summary' -prettySummary :: Summary -> String -prettySummary s@SummaryDouble{..} = concat - [ prettySummaryTimes s +-- | Pretty-print a 'TimeStamp', given a datarate +prettyTimeStamp :: Rational -> TimeStamp -> String +prettyTimeStamp r (TS t) + | d == 0 = "00:00:00.000" + -- | d < 100 = printf "%02d:%02d:%02d::%02d" hrs minN secN framesN + | otherwise = printf "%02d:%02d:%02d.%03d" hrs minN secN msN + where + d = denominator r + n = numerator r + msN = quot (1000 * framesN) n + (secT, framesN) = quotRem (fromIntegral t*d) n + (minT, secN) = quotRem secT 60 + (hrs, minN) = quotRem minT 60 + +-- | Pretty-print a 'Summary', given a datarate +prettySummary :: Rational -> Summary -> String +prettySummary r s@SummaryDouble{..} = concat + [ prettySummaryTimes r s , prettySummaryLevel s , printf "\tentry: %.3f\texit: %.3f\tmin: %.3f\tmax: %.3f\t" summaryDoubleEntry summaryDoubleExit summaryDoubleMin summaryDoubleMax , prettySummaryAvgRMS s ] -prettySummary s@SummaryInt{..} = concat - [ prettySummaryTimes s +prettySummary r s@SummaryInt{..} = concat + [ prettySummaryTimes r s , prettySummaryLevel s , printf "\tentry: %d\texit: %df\tmin: %d\tmax: %d\t" summaryIntEntry summaryIntExit summaryIntMin summaryIntMax , prettySummaryAvgRMS s ] -prettySummaryTimes :: Summary -> String -prettySummaryTimes s = printf "[%d - %d]" (unTS $ summaryEntryTime s) - (unTS $ summaryExitTime s) +prettySummaryTimes :: Rational -> Summary -> String +prettySummaryTimes r s = concat + [ "[", (prettyTimeStamp r $ summaryEntryTime s) + , "-", (prettyTimeStamp r $ summaryExitTime s), "] " + ] prettySummaryLevel :: Summary -> String prettySummaryLevel s = printf "lvl: %d" (summaryLevel s) diff --git a/Data/ZoomCache/Read.hs b/Data/ZoomCache/Read.hs --- a/Data/ZoomCache/Read.hs +++ b/Data/ZoomCache/Read.hs @@ -22,6 +22,7 @@ , zoomInfoFile ) where +import Control.Applicative ((<$>)) import Data.Int import qualified Data.IntMap as IM import qualified Data.Iteratee as I @@ -39,13 +40,13 @@ zoomInfoFile path = I.fileDriverRandom iterHeaders path >>= info zoomDumpFile :: FilePath -> IO () -zoomDumpFile = I.fileDriverRandom (mapPackets dumpData) +zoomDumpFile = I.fileDriverRandom (mapStream dumpData) zoomDumpSummary :: FilePath -> IO () -zoomDumpSummary = I.fileDriverRandom (mapSummaries dumpSummary) +zoomDumpSummary = I.fileDriverRandom (mapStream dumpSummary) zoomDumpSummaryLevel :: Int -> FilePath -> IO () -zoomDumpSummaryLevel lvl = I.fileDriverRandom (mapSummaries (dumpSummaryLevel lvl)) +zoomDumpSummaryLevel lvl = I.fileDriverRandom (mapStream (dumpSummaryLevel lvl)) ---------------------------------------------------------------------- @@ -54,19 +55,31 @@ putStrLn . prettyGlobal $ cfGlobal mapM_ (putStrLn . uncurry prettyTrackSpec) . IM.assocs $ cfSpecs -dumpData :: Packet -> IO () -dumpData p = mapM_ (\(t,d) -> printf "%s: %s\n" t d) tds +streamRate :: Stream -> Maybe Rational +streamRate StreamNull = Nothing +streamRate s = specRate <$> IM.lookup (strmTrack s) (cfSpecs (strmFile s)) + +dumpData :: Stream -> IO () +dumpData s@StreamPacket{..} = mapM_ (\(t,d) -> printf "%s: %s\n" t d) tds where - tds = zip (map (show . unTS) $ packetTimeStamps p) vals - vals = case packetData p of + pretty = case streamRate s of + Just r -> prettyTimeStamp r + Nothing -> show . unTS + tds = zip (map pretty (packetTimeStamps strmPacket)) vals + vals = case packetData strmPacket of PDDouble ds -> map show ds PDInt is -> map show is +dumpData _ = return () -dumpSummary :: Summary -> IO () -dumpSummary = putStrLn . prettySummary +dumpSummary :: Stream -> IO () +dumpSummary s@StreamSummary{..} = case streamRate s of + Just r -> putStrLn $ prettySummary r strmSummary + Nothing -> return () +dumpSummary _ = return () -dumpSummaryLevel :: Int -> Summary -> IO () -dumpSummaryLevel level s - | level == summaryLevel s = dumpSummary s - | otherwise = return () +dumpSummaryLevel :: Int -> Stream -> IO () +dumpSummaryLevel level s@StreamSummary{..} + | level == summaryLevel strmSummary = dumpSummary s + | otherwise = return () +dumpSummaryLevel _ _ = return () diff --git a/Data/ZoomCache/Summary.hs b/Data/ZoomCache/Summary.hs --- a/Data/ZoomCache/Summary.hs +++ b/Data/ZoomCache/Summary.hs @@ -52,7 +52,7 @@ deriving (Show) -- | The duration covered by a summary, in units of 1 / the track's datarate -summaryDuration :: Summary -> Int +summaryDuration :: Summary -> Integer summaryDuration s = (unTS $ summaryExitTime s) - (unTS $ summaryEntryTime s) -- | Append two Summaries, merging statistical summary data. diff --git a/Data/ZoomCache/Write.hs b/Data/ZoomCache/Write.hs --- a/Data/ZoomCache/Write.hs +++ b/Data/ZoomCache/Write.hs @@ -278,7 +278,7 @@ modifyTrack trackNo $ \z -> z { twBuilder = twBuilder z <> builder d , twTSBuilder = twTSBuilder z <> - (encInt . unTS) t + (encInt64 . unTS) t } modifyTrack trackNo $ \z -> z @@ -352,8 +352,8 @@ bsFromTrack trackNo TrackWork{..} = toLazyByteString $ mconcat [ fromLazyByteString packetHeader , encInt trackNo - , encInt . unTS $ twEntryTime - , encInt . unTS $ twExitTime + , encInt64 . unTS $ twEntryTime + , encInt64 . unTS $ twExitTime , encInt (len twBuilder + len twTSBuilder) , encInt twCount , twBuilder diff --git a/zoom-cache.cabal b/zoom-cache.cabal --- a/zoom-cache.cabal +++ b/zoom-cache.cabal @@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.2.0.0 +Version: 0.2.1.0 -- A short (one-line) description of the package. Synopsis: A streamable, seekable, zoomable cache file format