module Data.MediaBus.Media.Reframe
( initialReframerState
, runReframer
, pushStartFrame
, pushFrame
, PushFrameError(..)
, nextFrameAvailableDuration
, nextFrameTimestamp
, generateFrame
, type ReframerT
, ReframerSt()
, ReframeError(..)
, mkReFrameError
) where
import Control.Exception
import Control.Monad
import Control.Monad.Trans.State.Strict as State
import Data.MediaBus.Media.Stream
import Data.Typeable
initialReframerState
:: (Num d, Num s)
=> ReframerSt s d
initialReframerState = MkTimeFrame 0 0 0
runReframer
:: Monad m
=> ReframerT m s d a -> ReframerSt s d -> m (a, ReframerSt s d)
runReframer = runStateT
pushStartFrame
:: (Num d, Monad m)
=> d -> ReframerT m s d ()
pushStartFrame d = do
(MkTimeFrame _ s _) <- State.get
State.put (MkTimeFrame d s d)
pushFrame
:: (Num d, Monad m, Eq d, Ord d)
=> Frame s d d -> ReframerT m s d (Maybe PushFrameError)
pushFrame (MkFrame ts _ dur) = do
(MkTimeFrame startTs nextSeq endTs) <- State.get
let endTs' = ts + dur
when (ts == endTs) (State.put (MkTimeFrame startTs nextSeq endTs'))
return
(if | ts < endTs && endTs' < endTs -> Just InputFrameIsLate
| ts < endTs && endTs' >= endTs -> Just InputFrameOverlaps
| ts > endTs -> Just InputFrameIsEarly
| ts == endTs -> Nothing)
data PushFrameError
= InputFrameIsLate
| InputFrameOverlaps
| InputFrameIsEarly
deriving (Eq, Ord, Show, Enum)
nextFrameAvailableDuration
:: (Num d, Monad m)
=> ReframerT m s d d
nextFrameAvailableDuration = do
(MkTimeFrame startTs _ endTs) <- State.get
return (endTs startTs)
nextFrameTimestamp
:: (Num d, Monad m)
=> ReframerT m s d d
nextFrameTimestamp = do
(MkTimeFrame startTs _ _) <- State.get
return startTs
generateFrame
:: (Num s, Num d, Monad m, Eq d, Ord d, Show d)
=> d -> ReframerT m s d (Frame s d d)
generateFrame wantedDuration = do
(MkTimeFrame startTs nextSeq endTs) <- State.get
available <- nextFrameAvailableDuration
let endTs' = max (startTs + wantedDuration) endTs
State.put (MkTimeFrame (startTs + wantedDuration) (nextSeq + 1) endTs')
return (MkFrame startTs nextSeq (wantedDuration `min` available))
data ReframerSt s d = MkTimeFrame
{ _startTs :: !d
, _nextSeqNum :: !s
, _endTs :: !d
} deriving (Typeable)
instance (Show s, Show d) =>
Show (ReframerSt s d) where
showsPrec d MkTimeFrame {_startTs, _nextSeqNum, _endTs} =
showParen
(d > 10)
(showString "reframer-state: " .
showString "start: " .
showsPrec 11 _startTs .
showString ", end: " .
showsPrec 11 _endTs . showString ", next-sn: " . showsPrec 11 _nextSeqNum)
type ReframerT m s d a = StateT (ReframerSt s d) m a
data ReframeError s d = MkReframeError
{ reframeError :: String
, reframeErrorRequestedOutput :: Maybe d
, reframeErrorSt :: ReframerSt s d
} deriving (Typeable)
instance (Show s, Show d) =>
Show (ReframeError s d) where
showsPrec d MkReframeError { reframeError
, reframeErrorRequestedOutput
, reframeErrorSt
} =
showParen
(d > 10)
(showString "reframe-error: " .
showsPrec 11 reframeError .
maybe
id
(\ro -> showString ", requested: " . showsPrec 11 ro)
reframeErrorRequestedOutput .
showString ", " . showsPrec 11 reframeErrorSt)
instance (Show s, Typeable s, Show d, Typeable d) =>
Exception (ReframeError s d)
mkReFrameError
:: Monad m
=> String -> Maybe d -> ReframerT m s d (ReframeError s d)
mkReFrameError msg requestedOutputDuration =
MkReframeError msg requestedOutputDuration <$> State.get