module Data.Iteratee.ZoomCache (
Stream(..)
, enumCacheFile
, wholeTrackSummary
, wholeTrackSummaryUTC
, iterHeaders
, enumStream
, enumStreamIncomplete
, enumStreamTrackNo
, seekTimeStamp
, seekUTCTime
, enumPackets
, enumPacketsUTC
, enumSummaryLevel
, enumSummaries
, enumSummaryUTCLevel
, enumSummariesUTC
, filterTracksByName
, filterTracks
, enumPacketSOs
, enumSummarySOLevel
, enumSummarySOs
, enumCTPSO
, enumCTSO
) where
import Control.Applicative
import Control.Monad (replicateM, liftM)
import Control.Monad.Trans (MonadIO)
import Data.Bits
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Functor.Identity
import Data.Int
import Data.IntMap (IntMap)
import qualified Data.IntMap as IM
import Data.Iteratee (Iteratee)
import qualified Data.Iteratee as I
import Data.Iteratee.ZLib
import Data.Maybe
import Data.Ratio
import Data.Time
import Data.Iteratee.ZoomCache.Utils
import Data.ZoomCache.Common
import Data.ZoomCache.Format
import Data.ZoomCache.Multichannel.Internal (supportMultichannel)
import Data.ZoomCache.Numeric.Delta
import Data.ZoomCache.Types
data Stream =
StreamPacket
{ strmFile :: CacheFile
, strmTrack :: TrackNo
, strmPacket :: PacketSO
}
| StreamSummary
{ strmFile :: CacheFile
, strmTrack :: TrackNo
, strmSummary :: ZoomSummarySO
}
instance Timestampable Stream where
timestamp (StreamPacket c t p) = timestamp (packetFromCTPSO (c,t,p))
timestamp (StreamSummary c t s) = timestamp (summaryFromCTSO (c,t,s))
wholeTrackSummary :: (Functor m, MonadIO m)
=> [IdentifyCodec]
-> TrackNo
-> Iteratee ByteString m (TrackSpec, ZoomSummary)
wholeTrackSummary identifiers trackNo = I.joinI $ enumCacheFile identifiers .
I.joinI . filterTracks [trackNo] . I.joinI . enumCTSO $ f <$> I.last
where
f :: (CacheFile, TrackNo, ZoomSummarySO) -> (TrackSpec, ZoomSummary)
f ctso@(cf, _, _) = (fromJust $ IM.lookup trackNo (cfSpecs cf),
summaryFromCTSO ctso)
wholeTrackSummaryUTC :: (Functor m, MonadIO m)
=> [IdentifyCodec]
-> TrackNo
-> Iteratee ByteString m (TrackSpec, Maybe ZoomSummaryUTC)
wholeTrackSummaryUTC identifiers trackNo = I.joinI $ enumCacheFile identifiers .
I.joinI . filterTracks [trackNo] . I.joinI . enumCTSO $ f <$> I.last
where
f :: (CacheFile, TrackNo, ZoomSummarySO) -> (TrackSpec, Maybe ZoomSummaryUTC)
f ctso@(cf, _, _) = (fromJust $ IM.lookup trackNo (cfSpecs cf),
summaryUTCFromCTSO ctso)
enumPackets :: (Functor m, Monad m)
=> I.Enumeratee [Stream] [Packet] m a
enumPackets = I.joinI . enumCTPSO . I.mapChunks (map packetFromCTPSO)
packetFromCTPSO :: (CacheFile, TrackNo, PacketSO) -> Packet
packetFromCTPSO (cf, trackNo, pso) = packetFromPacketSO r pso
where
r = specRate . fromJust . IM.lookup trackNo . cfSpecs $ cf
enumPacketsUTC :: (Functor m, Monad m)
=> I.Enumeratee [Stream] [PacketUTC] m a
enumPacketsUTC = I.joinI . enumCTPSO . I.mapChunks (catMaybes . map packetUTCFromCTPSO)
packetUTCFromCTPSO :: (CacheFile, TrackNo, PacketSO) -> Maybe PacketUTC
packetUTCFromCTPSO (cf, trackNo, pso) = toPacket <$> base'm
where
toPacket base = packetUTCFromPacketSO base r pso
r = specRate . fromJust . IM.lookup trackNo . cfSpecs $ cf
base'm = baseUTC . cfGlobal $ cf
enumSummaryLevel :: (Functor m, Monad m)
=> Int
-> I.Enumeratee [Stream] [ZoomSummary] m a
enumSummaryLevel level =
I.joinI . enumSummaries .
I.filter (\(ZoomSummary s) -> summaryLevel s == level)
enumSummaries :: (Functor m, Monad m)
=> I.Enumeratee [Stream] [ZoomSummary] m a
enumSummaries = I.joinI . enumCTSO . I.mapChunks (map summaryFromCTSO)
summaryFromCTSO :: (CacheFile, TrackNo, ZoomSummarySO) -> ZoomSummary
summaryFromCTSO (cf, trackNo, (ZoomSummarySO zso)) =
ZoomSummary (summaryFromSummarySO r zso)
where
r = specRate . fromJust . IM.lookup trackNo . cfSpecs $ cf
enumSummaryUTCLevel :: (Functor m, Monad m)
=> Int
-> I.Enumeratee [Stream] [ZoomSummaryUTC] m a
enumSummaryUTCLevel level =
I.joinI . enumSummariesUTC .
I.filter (\(ZoomSummaryUTC s) -> summaryUTCLevel s == level)
enumSummariesUTC :: (Functor m, Monad m)
=> I.Enumeratee [Stream] [ZoomSummaryUTC] m a
enumSummariesUTC = I.joinI . enumCTSO . I.mapChunks (catMaybes . map summaryUTCFromCTSO)
summaryUTCFromCTSO :: (CacheFile, TrackNo, ZoomSummarySO) -> Maybe ZoomSummaryUTC
summaryUTCFromCTSO (cf, trackNo, (ZoomSummarySO zso)) = toZS <$> base'm
where
toZS base = ZoomSummaryUTC (summaryUTCFromSummarySO base r zso)
r = specRate . fromJust . IM.lookup trackNo . cfSpecs $ cf
base'm = baseUTC . cfGlobal $ cf
enumPacketSOs :: (Functor m, Monad m)
=> I.Enumeratee [Stream] [PacketSO] m a
enumPacketSOs = I.joinI . enumCTPSO . I.mapChunks (map (\(_,_,p) -> p))
enumSummarySOLevel :: (Functor m, Monad m)
=> Int
-> I.Enumeratee [Stream] [ZoomSummarySO] m a
enumSummarySOLevel level =
I.joinI . enumSummarySOs .
I.filter (\(ZoomSummarySO s) -> summarySOLevel s == level)
enumSummarySOs :: (Functor m, Monad m)
=> I.Enumeratee [Stream] [ZoomSummarySO] m a
enumSummarySOs = I.joinI . enumCTSO . I.mapChunks (map (\(_,_,s) -> s))
enumCTPSO :: (Functor m, Monad m)
=> I.Enumeratee [Stream] [(CacheFile, TrackNo, PacketSO)] m a
enumCTPSO = I.mapChunks (catMaybes . map toCTPSO)
where
toCTPSO :: Stream -> Maybe (CacheFile, TrackNo, PacketSO)
toCTPSO StreamPacket{..} = Just (strmFile, strmTrack, strmPacket)
toCTPSO _ = Nothing
enumCTSO :: (Functor m, Monad m)
=> I.Enumeratee [Stream] [(CacheFile, TrackNo, ZoomSummarySO)] m a
enumCTSO = I.mapChunks (catMaybes . map toCTSO)
where
toCTSO :: Stream -> Maybe (CacheFile, TrackNo, ZoomSummarySO)
toCTSO StreamSummary{..} = Just (strmFile, strmTrack, strmSummary)
toCTSO _ = Nothing
filterTracksByName :: (Functor m, Monad m)
=> CacheFile
-> [ByteString]
-> I.Enumeratee [Stream] [Stream] m a
filterTracksByName CacheFile{..} names = filterTracks tracks
where
tracks :: [TrackNo]
tracks = IM.keys (IM.filter f cfSpecs)
f :: TrackSpec -> Bool
f ts = specName ts `elem` names
filterTracks :: (Functor m, Monad m)
=> [TrackNo]
-> I.Enumeratee [Stream] [Stream] m a
filterTracks tracks = I.filter fil
where
fil :: Stream -> Bool
fil StreamPacket{..} = strmTrack `elem` tracks
fil StreamSummary{..} = strmTrack `elem` tracks
enumCacheFile :: (Functor m, MonadIO m)
=> [IdentifyCodec]
-> I.Enumeratee ByteString [Stream] m a
enumCacheFile identifiers iter = do
fi <- iterHeaders identifiers
enumStream fi iter
enumStreamTrackNo :: (Functor m, MonadIO m)
=> CacheFile
-> TrackNo
-> I.Enumeratee ByteString [Stream] m a
enumStreamTrackNo cf0 trackNo = I.unfoldConvStreamCheck I.eneeCheckIfDoneIgnore go cf0
where
go :: (Functor m, MonadIO m)
=> CacheFile
-> Iteratee ByteString m (CacheFile, [Stream])
go cf = do
header <- I.joinI $ I.takeUpTo 8 I.stream2list
case parseHeader (B.pack header) of
Just PacketHeader -> do
(_, packet) <- readPacketTrackNo (cfSpecs cf) trackNo
let res = maybe [] (\p -> [StreamPacket cf trackNo p]) packet
return (cf, res)
Just SummaryHeader -> do
(_, summary) <- readSummaryBlockTrackNo (cfSpecs cf) trackNo
let res = maybe [] (\s -> [StreamSummary cf trackNo s]) summary
return (cf, res)
_ -> return (cf, [])
iterStream :: (Functor m, MonadIO m) =>
CacheFile -> Iteratee ByteString m [Stream]
iterStream cf = do
header <- I.joinI $ I.takeUpTo 8 I.stream2list
case parseHeader (B.pack header) of
Just PacketHeader -> do
(trackNo, packet) <- readPacket (cfSpecs cf)
return [StreamPacket cf trackNo (fromJust packet)]
Just SummaryHeader -> do
(trackNo, summary) <- readSummaryBlock (cfSpecs cf)
return [StreamSummary cf trackNo (fromJust summary)]
_ -> return []
enumStream :: (Functor m, MonadIO m)
=> CacheFile
-> I.Enumeratee ByteString [Stream] m a
enumStream = I.unfoldConvStreamCheck I.eneeCheckIfDoneIgnore $ \cf ->
liftM (cf, ) (iterStream cf)
convStreamIncomplete :: (Monad m, I.Nullable s) =>
I.Iteratee s m s'
-> I.Enumeratee s s' m a
convStreamIncomplete fi = I.eneeCheckIfDonePass check
where
check k (Just e) = do
I.throwRecoverableErr e (const I.identity)
check k Nothing
check k Nothing = do
isEOF <- I.isStreamFinished
case isEOF of
Nothing -> do
str <- either (I.EOF . Just) I.Chunk `liftM` I.checkErr fi
I.eneeCheckIfDonePass check $ k str
e@(Just _) -> I.eneeCheckIfDonePass check . k $ I.EOF e
enumStreamIncomplete :: (Functor m, MonadIO m) =>
CacheFile
-> I.Enumeratee ByteString [Stream] m a
enumStreamIncomplete = convStreamIncomplete . iterStream
data HeaderType = GlobalHeader | TrackHeader | PacketHeader | SummaryHeader
parseHeader :: ByteString -> Maybe HeaderType
parseHeader h
| h == globalHeader = Just GlobalHeader
| h == trackHeader = Just TrackHeader
| h == packetHeader = Just PacketHeader
| h == summaryHeader = Just SummaryHeader
| otherwise = Nothing
iterHeaders :: (Functor m, Monad m)
=> [IdentifyCodec]
-> I.Iteratee ByteString m CacheFile
iterHeaders identifiers = iterGlobal >>= go
where
iterGlobal :: (Functor m, Monad m)
=> Iteratee ByteString m CacheFile
iterGlobal = do
header <- I.joinI $ I.takeUpTo 8 I.stream2list
case parseHeader (B.pack header) of
Just GlobalHeader -> mkCacheFile <$> readGlobalHeader
_ -> error "No global header"
go :: (Functor m, Monad m)
=> CacheFile
-> Iteratee ByteString m CacheFile
go fi = do
header <- I.joinI $ I.takeUpTo 8 I.stream2list
case parseHeader (B.pack header) of
Just TrackHeader -> do
(trackNo, spec) <- readTrackHeader identifiers
let fi' = fi{cfSpecs = IM.insert trackNo spec (cfSpecs fi)}
if (fiFull fi')
then return fi'
else go fi'
_ -> return fi
readGlobalHeader :: (Functor m, Monad m)
=> Iteratee ByteString m Global
readGlobalHeader = do
v <- readVersion
checkVersion v
n <- readInt32be
jDay <- readIntegerVLC
sN <- readIntegerVLC
sD <- readIntegerVLC
let !u = if (sD == 0)
then Nothing
else Just $ UTCTime (ModifiedJulianDay jDay) (fromRational (sN % sD))
return $ Global v n u
where
checkVersion (Version major minor)
| major == versionMajor && minor >= versionMinor = return ()
| otherwise = error "Unsupported zoom-cache version"
readTrackHeader :: (Functor m, Monad m)
=> [IdentifyCodec]
-> Iteratee ByteString m (TrackNo, TrackSpec)
readTrackHeader identifiers = do
trackNo <- readInt32be
(drType, delta, zlib) <- readFlags
rate <- readRational64be
identLength <- readInt32be
trackType <- maybe (error "Unknown track type") return =<< readCodecMultichannel identLength
nameLength <- readInt32be
name <- B.pack <$> (I.joinI $ I.takeUpTo nameLength I.stream2list)
return (trackNo, TrackSpec trackType delta zlib drType rate name)
where
readCodecMultichannel = readCodec (supportMultichannel identifiers)
enumInflateZlib :: (MonadIO m) => I.Enumeratee ByteString ByteString m a
enumInflateZlib = enumInflate Zlib defaultDecompressParams
readPacketPred :: (Functor m, MonadIO m)
=> IntMap TrackSpec
-> ((TrackNo, SampleOffset, SampleOffset) -> Bool)
-> Iteratee ByteString m (TrackNo, Maybe PacketSO)
readPacketPred specs p = do
trackNo <- readInt32be
entryTime <- SO <$> readInt64be
exitTime <- SO <$> readInt64be
count <- readInt32be
byteLength <- readInt32be
packet <- if (p (trackNo, entryTime, exitTime))
then do
readPacketData specs trackNo entryTime exitTime count byteLength
else do
I.drop byteLength
return Nothing
return (trackNo, packet)
readPacketTrackNo :: (Functor m, MonadIO m)
=> IntMap TrackSpec
-> TrackNo
-> Iteratee ByteString m (TrackNo, Maybe PacketSO)
readPacketTrackNo specs wantTrackNo =
readPacketPred specs (\(trackNo, _, _) -> trackNo == wantTrackNo)
readPacket :: (Functor m, MonadIO m)
=> IntMap TrackSpec
-> Iteratee ByteString m (TrackNo, Maybe PacketSO)
readPacket specs = readPacketPred specs (const True)
readPacketData :: (Functor m, MonadIO m)
=> IntMap TrackSpec
-> TrackNo
-> SampleOffset -> SampleOffset
-> Int
-> Int
-> Iteratee ByteString m (Maybe PacketSO)
readPacketData specs trackNo entryTime exitTime count byteLength =
case IM.lookup trackNo specs of
Just TrackSpec{..} -> do
let readDTS :: (Functor m, Monad m)
=> Iteratee ByteString m (ZoomRaw, [SampleOffset])
readDTS = readDataSampleOffsets specType specDeltaEncode specSRType
(d, ts) <- if specZlibCompress
then do
z <- I.joinI $ enumInflateZlib I.stream2stream
return $ runner1 $ I.enumPure1Chunk z readDTS
else readDTS
return . Just $
(PacketSO trackNo entryTime exitTime count d ts)
Nothing -> do
I.drop byteLength
return Nothing
where
runner1 :: Identity (I.Iteratee s Identity c) -> c
runner1 = runIdentity . I.run . runIdentity
readRawCodec :: (Functor m, Monad m)
=> Codec -> Bool
-> Iteratee ByteString m ZoomRaw
readRawCodec (Codec a) delta = ZoomRaw . f <$> replicateM count (readRawAs a)
where
f | delta = deltaDecodeRaw
| otherwise = id
readRawAs :: (ZoomReadable a, Functor m, Monad m)
=> a -> Iteratee ByteString m a
readRawAs = const readRaw
readDataSampleOffsets :: (Functor m, Monad m)
=> Codec -> Bool -> SampleRateType
-> Iteratee ByteString m (ZoomRaw, [SampleOffset])
readDataSampleOffsets codec delta drType = do
d <- readRawCodec codec delta
ts <- readSampleOffsets drType
return (d, ts)
readSampleOffsets :: (Functor m, Monad m)
=> SampleRateType
-> Iteratee ByteString m [SampleOffset]
readSampleOffsets drType = map SO <$> case drType of
ConstantSR -> do
return $ take count [unSO entryTime ..]
VariableSR -> do
deltaDecode <$> replicateM count readInt64be
readSummaryBlockPred :: (Functor m, Monad m)
=> IntMap TrackSpec
-> ((TrackNo, Int, SampleOffset, SampleOffset) -> Bool)
-> Iteratee ByteString m (TrackNo, Maybe ZoomSummarySO)
readSummaryBlockPred specs p = do
trackNo <- readInt32be
lvl <- readInt32be
entryTime <- SO <$> readInt64be
exitTime <- SO <$> readInt64be
byteLength <- readInt32be
summary <- if (p (trackNo, lvl, entryTime, exitTime))
then do
readSummaryBlockData specs trackNo lvl entryTime exitTime byteLength
else do
I.drop byteLength
return Nothing
return (trackNo, summary)
readSummaryBlockTrackNo :: (Functor m, Monad m)
=> IntMap TrackSpec
-> TrackNo
-> Iteratee ByteString m (TrackNo, Maybe ZoomSummarySO)
readSummaryBlockTrackNo specs wantTrackNo =
readSummaryBlockPred specs (\(trackNo, _, _, _) -> trackNo == wantTrackNo)
readSummaryBlock :: (Functor m, Monad m)
=> IntMap TrackSpec
-> Iteratee ByteString m (TrackNo, Maybe ZoomSummarySO)
readSummaryBlock specs = readSummaryBlockPred specs (const True)
readSummaryBlockData :: (Functor m, Monad m)
=> IntMap TrackSpec
-> TrackNo
-> Int
-> SampleOffset -> SampleOffset
-> Int
-> Iteratee ByteString m (Maybe ZoomSummarySO)
readSummaryBlockData specs trackNo lvl entryTime exitTime byteLength =
case IM.lookup trackNo specs of
Just TrackSpec{..} -> do
Just <$> readSummaryCodec specType
Nothing -> do
I.drop byteLength
return Nothing
where
readSummaryCodec :: (Functor m, Monad m)
=> Codec
-> Iteratee ByteString m ZoomSummarySO
readSummaryCodec (Codec a) = do
ZoomSummarySO <$> (SummarySO trackNo lvl entryTime exitTime <$> readSummaryAs a)
readSummaryAs :: (ZoomReadable a, Functor m, Monad m)
=> a -> Iteratee ByteString m (SummaryData a)
readSummaryAs = const readSummary
readVersion :: (Functor m, Monad m)
=> Iteratee ByteString m Version
readVersion = Version <$> readInt16be <*> readInt16be
readFlags :: (Functor m, Monad m)
=> Iteratee ByteString m (SampleRateType, Bool, Bool)
readFlags = do
(n :: Int16) <- readInt16be
let drType = case n .&. 1 of
0 -> ConstantSR
_ -> VariableSR
delta = case n .&. 2 of
0 -> False
_ -> True
zlib = case n .&. 4 of
0 -> False
_ -> True
return (drType, delta, zlib)