diff --git a/Data/Iteratee/ZoomCache.hs b/Data/Iteratee/ZoomCache.hs --- a/Data/Iteratee/ZoomCache.hs +++ b/Data/Iteratee/ZoomCache.hs @@ -359,11 +359,16 @@ => Iteratee ByteString m Global readGlobalHeader = do v <- readVersion + checkVersion v n <- readInt32be p <- readRational64be b <- readRational64be _u <- B.pack <$> (I.joinI $ I.takeUpTo 20 I.stream2list) return $ Global v n p b Nothing + where + checkVersion (Version major minor) + | major == versionMajor && minor >= versionMinor = return () + | otherwise = error "Unsupported zoom-cache version" readTrackHeader :: (Functor m, Monad m) => [IdentifyCodec] 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 @@ -80,7 +80,7 @@ llDropWhileB = dw LL.empty where dw prev func l - | LL.null l = LL.empty + | LL.null l = prev | func (LL.head l) = dw (LL.take 1 l) func (LL.tail l) | otherwise = LL.append prev l diff --git a/Data/ZoomCache.hs b/Data/ZoomCache.hs --- a/Data/ZoomCache.hs +++ b/Data/ZoomCache.hs @@ -64,6 +64,8 @@ , setWatermark -- * TrackSpec helpers + , setCodec + , setCodecMultichannel , mkTrackSpec , oneTrack @@ -86,6 +88,7 @@ import Data.ZoomCache.Common import Data.ZoomCache.Identify import Data.ZoomCache.Pretty +import Data.ZoomCache.TrackSpec import Data.ZoomCache.Types -- Track Types diff --git a/Data/ZoomCache/Format.hs b/Data/ZoomCache/Format.hs --- a/Data/ZoomCache/Format.hs +++ b/Data/ZoomCache/Format.hs @@ -91,11 +91,11 @@ -- | The major version encoded by this library versionMajor :: Int -versionMajor = 1 +versionMajor = 2 -- | The minor version encoded by this library versionMinor :: Int -versionMinor = 1 +versionMinor = 0 {- | diff --git a/Data/ZoomCache/Multichannel/Internal.hs b/Data/ZoomCache/Multichannel/Internal.hs --- a/Data/ZoomCache/Multichannel/Internal.hs +++ b/Data/ZoomCache/Multichannel/Internal.hs @@ -69,10 +69,11 @@ oneTrackMultichannel channels a delta zlib !drType !rate !name = IM.singleton 1 (mkTrackSpecMultichannel channels a delta zlib drType rate name) {-# INLINABLE oneTrackMultichannel #-} +{-# DEPRECATED oneTrackMultichannel "Use setCodecMultichannel instead" #-} mkTrackSpecMultichannel :: (ZoomReadable a) => Int -> a -> Bool -> Bool -> SampleRateType -> Rational -> ByteString -> TrackSpec mkTrackSpecMultichannel channels a = reifyIntegral channels (\n -> TrackSpec (Codec (NList n [a]))) - +{-# DEPRECATED mkTrackSpecMultichannel "Use setCodecMultichannel instead" #-} diff --git a/Data/ZoomCache/Numeric.hs b/Data/ZoomCache/Numeric.hs --- a/Data/ZoomCache/Numeric.hs +++ b/Data/ZoomCache/Numeric.hs @@ -81,7 +81,7 @@ ---------------------------------------------------------------------- --- | Coercion of numeric Summary to type SummarySO Double. +-- | Coercion of numeric Summary to type Summary Double. toSummaryDouble :: Typeable a => Summary a -> Maybe (Summary Double) toSummaryDouble s | typeOf s == typeOf (undefined :: Summary Double) = id (cast s :: Maybe (Summary Double)) 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 , prettySampleOffset , prettySummarySO ) where @@ -55,6 +56,16 @@ | otherwise = "Raw" compression | specZlibCompress = "Zlib" | otherwise = "Uncompressed" + +-- | Pretty-print a 'SampleOffset', given a datarate +prettyTimeStamp :: TimeStamp -> String +prettyTimeStamp (TS ts) = printf "%02d:%02d:%02d.%03d" hrs minN secN msN + where + secT, msN :: Integer + secT = floor ts + msN = round (1000 * (ts - fromIntegral secT)) + (minT, secN) = quotRem secT 60 + (hrs, minN) = quotRem minT 60 -- | Pretty-print a 'SampleOffset', given a datarate prettySampleOffset :: Rational -> SampleOffset -> String diff --git a/Data/ZoomCache/TrackSpec.hs b/Data/ZoomCache/TrackSpec.hs new file mode 100644 --- /dev/null +++ b/Data/ZoomCache/TrackSpec.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS -Wall -fno-warn-orphans #-} +---------------------------------------------------------------------- +-- | +-- Module : Data.ZoomCache.TrackSpec +-- Copyright : Conrad Parker +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Conrad Parker +-- Stability : unstable +-- Portability : unknown +-- +-- ZoomCache track specification +---------------------------------------------------------------------- + +module Data.ZoomCache.TrackSpec ( + -- * TrackSpec helpers + setCodec + , setCodecMultichannel + , mkTrackSpec + , oneTrack +) where + +import Data.ByteString (ByteString) +import Data.Default +import qualified Data.IntMap as IM +import Data.TypeLevel.Num hiding ((==)) + +import Data.ZoomCache.Common +import Data.ZoomCache.NList +import Data.ZoomCache.Types + +import Data.ZoomCache.Multichannel.NList() +import Data.ZoomCache.Numeric.IEEE754() + +------------------------------------------------------------ + +instance Default TrackSpec where + def = TrackSpec + { specType = Codec (undefined :: Double) + , specDeltaEncode = True + , specZlibCompress = True + , specSRType = ConstantSR + , specRate = 1000 + , specName = "" + } + +------------------------------------------------------------ + +-- | Create a track map for a stream of a given type, as track no. 1 +oneTrack :: (ZoomReadable a) + => a -> Bool -> Bool -> SampleRateType -> Rational -> ByteString + -> TrackMap +oneTrack a delta zlib !drType !rate !name = + IM.singleton 1 (mkTrackSpec a delta zlib drType rate name) +{-# INLINABLE oneTrack #-} +{-# DEPRECATED oneTrack "Use setCodec instead" #-} + +mkTrackSpec :: (ZoomReadable a) + => a -> Bool -> Bool -> SampleRateType -> Rational -> ByteString + -> TrackSpec +mkTrackSpec a = TrackSpec (Codec a) +{-# DEPRECATED mkTrackSpec "Use setCodec instead" #-} + +setCodec :: ZoomReadable a => a -> TrackSpec -> TrackSpec +setCodec a t = t { specType = Codec a } + +setCodecMultichannel :: ZoomReadable a + => Int -> a -> TrackSpec -> TrackSpec +setCodecMultichannel channels a t = reifyIntegral channels + (\n -> t { specType = Codec (NList n [a]) }) + diff --git a/Data/ZoomCache/Types.hs b/Data/ZoomCache/Types.hs --- a/Data/ZoomCache/Types.hs +++ b/Data/ZoomCache/Types.hs @@ -127,7 +127,7 @@ before :: (Timestampable a) => Maybe TimeStamp -> a -> Bool before Nothing _ = True -before (Just b) x = t == Nothing || (fromJust t) <= b +before (Just b) x = t == Nothing || (fromJust t) < b where t = timestamp x diff --git a/Data/ZoomCache/Write.hs b/Data/ZoomCache/Write.hs --- a/Data/ZoomCache/Write.hs +++ b/Data/ZoomCache/Write.hs @@ -40,17 +40,12 @@ -- * Watermarks , watermark , setWatermark - - -- * TrackSpec helpers - , mkTrackSpec - , oneTrack ) where import Blaze.ByteString.Builder hiding (flush) import Codec.Compression.Zlib import Control.Applicative ((<$>)) import Control.Monad.State -import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as C import qualified Data.ByteString.Lazy as L @@ -177,15 +172,6 @@ closeWrite :: ZoomWHandle -> IO () closeWrite z = hClose (whHandle z) - --- | Create a track map for a stream of a given type, as track no. 1 -oneTrack :: (ZoomReadable a) => a -> Bool -> Bool -> SampleRateType -> Rational -> ByteString -> TrackMap -oneTrack a delta zlib !drType !rate !name = IM.singleton 1 (mkTrackSpec a delta zlib drType rate name) -{-# INLINABLE oneTrack #-} - -mkTrackSpec :: (ZoomReadable a) - => a -> Bool -> Bool -> SampleRateType -> 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. diff --git a/tools/zoom-cache.hs b/tools/zoom-cache.hs --- a/tools/zoom-cache.hs +++ b/tools/zoom-cache.hs @@ -9,29 +9,26 @@ import Control.Monad (foldM) import Control.Monad.Trans (liftIO) -import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as C import Data.Default +import qualified Data.IntMap as IM import System.Console.GetOpt import UI.Command import Data.ZoomCache import Data.ZoomCache.Dump -import Data.ZoomCache.Multichannel +import Data.ZoomCache.Multichannel() ------------------------------------------------------------ data Config = Config { noRaw :: Bool - , delta :: Bool - , zlib :: Bool - , variable :: Bool - , intData :: Bool - , label :: ByteString - , rate :: Integer , channels :: Int , wmLevel :: Int , track :: TrackNo + , intData :: Bool + , variable :: Bool + , spec :: TrackSpec } instance Default Config where @@ -40,27 +37,27 @@ defConfig :: Config defConfig = Config { noRaw = False - , delta = False - , zlib = False - , variable = False - , intData = False - , label = "gen" - , rate = 1000 , channels = 1 , wmLevel = 1024 , track = 1 + , intData = False + , variable = False + , spec = def { specDeltaEncode = False + , specZlibCompress = False + , specName = "gen" + } } data Option = NoRaw + | Channels String + | Watermark String + | Track String | Delta | ZLib | Variable | IntData - | Label String | Rate String - | Channels String - | Watermark String - | Track String + | Label String deriving (Eq) options :: [OptDescr Option] @@ -70,6 +67,12 @@ genOptions = [ Option ['z'] ["no-raw"] (NoArg NoRaw) "Do NOT include raw data in the output" + , Option ['c'] ["channels"] (ReqArg Channels "channels") + "Set number of channels" + , Option ['w'] ["watermark"] (ReqArg Watermark "watermark") + "Set high-watermark level" + , Option ['t'] ["track"] (ReqArg Track "trackNo") + "Set or select track number" , Option ['d'] ["delta"] (NoArg Delta) "Delta-encode data" , Option ['Z'] ["zlib"] (NoArg ZLib) @@ -78,16 +81,10 @@ "Generate variable-rate data" , Option ['i'] ["integer"] (NoArg IntData) "Generate integer data" - , Option ['l'] ["label"] (ReqArg Label "label") - "Set track label" , Option ['r'] ["rate"] (ReqArg Rate "data-rate") "Set track rate" - , Option ['c'] ["channels"] (ReqArg Channels "channels") - "Set number of channels" - , Option ['w'] ["watermark"] (ReqArg Watermark "watermark") - "Set high-watermark level" - , Option ['t'] ["track"] (ReqArg Track "trackNo") - "Set or select track number" + , Option ['l'] ["label"] (ReqArg Label "label") + "Set track label" ] processArgs :: [String] -> IO (Config, [String]) @@ -103,18 +100,6 @@ where processOneOption config NoRaw = do return $ config {noRaw = True} - processOneOption config Delta = do - return $ config {delta = True} - processOneOption config ZLib = do - return $ config {zlib = True} - processOneOption config Variable = do - return $ config {variable = True} - processOneOption config IntData = do - return $ config {intData = True} - processOneOption config (Label s) = do - return $ config {label = C.pack s} - processOneOption config (Rate s) = do - return $ config {rate = read s} processOneOption config (Channels s) = do return $ config {channels = read s} processOneOption config (Watermark s) = do @@ -122,6 +107,23 @@ processOneOption config (Track s) = do return $ config {track = read s} + processOneOption config Delta = do + return $ config { spec = (spec config){specDeltaEncode = True} } + processOneOption config ZLib = do + return $ config { spec = (spec config){specZlibCompress = True} } + processOneOption config Variable = do + return $ config { variable = True + , spec = (spec config){specSRType = VariableSR} + } + processOneOption config IntData = do + return $ config { intData = True + , spec = setCodec (undefined :: Int) (spec config) + } + processOneOption config (Rate s) = do + return $ config { spec = (spec config){specRate = fromInteger $ read s} } + processOneOption config (Label s) = do + return $ config { spec = (spec config){specName = C.pack s} } + ------------------------------------------------------------ zoomGen :: Command () @@ -130,37 +132,44 @@ , cmdHandler = zoomGenHandler , cmdCategory = "Writing" , cmdShortDesc = "Generate zoom-cache data" - , cmdExamples = [("Generate a file called foo.zxd", "foo.zxd")] + , cmdExamples = [("Generate a file called foo.zoom", "foo.zoom")] } zoomGenHandler :: App () () zoomGenHandler = do (config, filenames) <- liftIO . processArgs =<< appArgs - liftIO $ zoomWriteFile config filenames + liftIO $ mapM_ (zoomWriteFile config) filenames -zoomWriteFile :: Config -> [FilePath] -> IO () -zoomWriteFile _ [] = return () -zoomWriteFile Config{..} (path:_) +zoomWriteFile :: Config -> FilePath -> IO () +zoomWriteFile Config{..} path | intData = w ints path | otherwise = w doubles path where w :: (ZoomReadable a, ZoomWrite a, ZoomWritable a, ZoomWrite (SampleOffset, a)) => [a] -> FilePath -> IO () w d - | variable && channels == 1 = withFileWrite (oneTrack (head d) delta zlib VariableSR rate' label) + | variable && channels == 1 = withFileWrite trackMap (not noRaw) - (sW >> mapM_ (write track) (zip (map SO [1,3..]) d)) - | channels == 1 = withFileWrite (oneTrack (head d) delta zlib ConstantSR rate' label) + (sW >> mapM_ (write track) + (zip (map SO [1,3..]) d)) + | channels == 1 = withFileWrite trackMap (not noRaw) (sW >> mapM_ (write track) d) - | variable = withFileWrite (oneTrackMultichannel channels (head d) delta zlib VariableSR rate' label) + | variable = withFileWrite trackMap (not noRaw) - (sW >> mapM_ (write track) (zip (map SO [1,3..]) (map (replicate channels) d))) - | otherwise = withFileWrite (oneTrackMultichannel channels (head d) delta zlib ConstantSR rate' label) + (sW >> mapM_ (write track) + (zip (map SO [1,3..]) + (map (replicate channels) d))) + | otherwise = withFileWrite trackMap (not noRaw) - (sW >> mapM_ (write track) (map (replicate channels) d)) - rate' = fromInteger rate - sW = setWatermark 1 wmLevel + (sW >> mapM_ (write track) + (map (replicate channels) d)) + sW = setWatermark track wmLevel + trackMap = IM.singleton track spec' + spec' | channels == 1 && intData = setCodec (undefined :: Int) spec + | channels == 1 = setCodec (undefined :: Double) spec + | intData = setCodecMultichannel channels (undefined :: Int) spec + | otherwise = setCodecMultichannel channels (undefined :: Double) spec ------------------------------------------------------------ @@ -178,7 +187,7 @@ , cmdHandler = zoomInfoHandler , cmdCategory = "Reading" , cmdShortDesc = "Display basic info about a zoom-cache file" - , cmdExamples = [("Display info about foo.zxd", "foo.zxd")] + , cmdExamples = [("Display info about foo.zoom", "foo.zoom")] } zoomInfoHandler :: App () () @@ -208,7 +217,7 @@ , cmdHandler = zoomSummaryHandler , cmdCategory = "Reading" , cmdShortDesc = "Read zoom-cache summary data" - , cmdExamples = [("Read summary level 3 from foo.zxd", "3 foo.zxd")] + , cmdExamples = [("Read summary level 3 from foo.zoom", "3 foo.zoom")] } zoomSummaryHandler :: App () () @@ -218,7 +227,7 @@ where f trackNo (lvl:paths) = mapM_ (zoomDumpSummaryLevel (read lvl) standardIdentifiers trackNo) paths - f _ _ = putStrLn "Usage: zoom-cache summary n file.zxd" + f _ _ = putStrLn "Usage: zoom-cache summary n file.zoom" ------------------------------------------------------------ -- The Application 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.9.0.0 +Version: 0.9.1.0 Synopsis: A streamable, seekable, zoomable cache file format @@ -116,6 +116,7 @@ Data.ZoomCache.Numeric.Types Data.ZoomCache.Numeric.Word Data.ZoomCache.Pretty + Data.ZoomCache.TrackSpec Data.ZoomCache.Types Data.ZoomCache.Unit Data.ZoomCache.Write