packages feed

mediabus 0.3.1.0 → 0.3.2.0

raw patch · 7 files changed

+255/−18 lines, 7 filesdep ~mediabus

Dependency ranges changed: mediabus

Files

mediabus.cabal view
@@ -1,5 +1,5 @@ name: mediabus-version: 0.3.1.0+version: 0.3.2.0 cabal-version: >=1.10 build-type: Simple license: BSD3@@ -21,17 +21,20 @@     exposed-modules:         Data.MediaBus         Data.MediaBus.Basics.Clock+        Data.MediaBus.Basics.LoggingExtra         Data.MediaBus.Basics.Monotone         Data.MediaBus.Basics.OrderedBy         Data.MediaBus.Basics.Sequence         Data.MediaBus.Basics.Series         Data.MediaBus.Basics.SourceId         Data.MediaBus.Basics.Ticks+        Data.MediaBus.Basics.VectorExtra         Data.MediaBus.Conduit.Async         Data.MediaBus.Conduit.Audio.Raw.Alaw         Data.MediaBus.Conduit.Audio.Raw.DebugSink         Data.MediaBus.Conduit.Audio.Raw.Resample         Data.MediaBus.Conduit.Discontinous+        Data.MediaBus.Conduit.Logging         Data.MediaBus.Conduit.Reorder         Data.MediaBus.Conduit.Segment         Data.MediaBus.Conduit.Stream@@ -49,6 +52,7 @@         Data.MediaBus.Media.Channels         Data.MediaBus.Media.Discontinous         Data.MediaBus.Media.Media+        Data.MediaBus.Media.Reframe         Data.MediaBus.Media.Samples         Data.MediaBus.Media.Segment         Data.MediaBus.Media.Stream@@ -113,7 +117,7 @@         conduit >=1.2.9 && <1.3,         conduit-combinators >=1.1.0 && <1.2,         conduit-extra >=1.1.15 && <1.2,-        mediabus >=0.3.1.0 && <0.4,+        mediabus >=0.3.2.0 && <0.4,         containers >=0.5.7.1 && <0.6,         data-default >=0.7.1.1 && <0.8,         deepseq >=1.4.2.0 && <1.5,
src/Data/MediaBus.hs view
@@ -5,17 +5,20 @@   ) where  import Data.MediaBus.Basics.Clock as X+import Data.MediaBus.Basics.LoggingExtra as X import Data.MediaBus.Basics.Monotone as X import Data.MediaBus.Basics.OrderedBy as X import Data.MediaBus.Basics.Sequence as X import Data.MediaBus.Basics.Series as X import Data.MediaBus.Basics.SourceId as X import Data.MediaBus.Basics.Ticks as X+import Data.MediaBus.Basics.VectorExtra as X import Data.MediaBus.Conduit.Async as X import Data.MediaBus.Conduit.Audio.Raw.Alaw as X import Data.MediaBus.Conduit.Audio.Raw.DebugSink as X import Data.MediaBus.Conduit.Audio.Raw.Resample as X import Data.MediaBus.Conduit.Discontinous as X+import Data.MediaBus.Conduit.Logging as X import Data.MediaBus.Conduit.Reorder as X import Data.MediaBus.Conduit.Segment as X import Data.MediaBus.Conduit.Stream as X@@ -33,6 +36,7 @@ import Data.MediaBus.Media.Channels as X import Data.MediaBus.Media.Discontinous as X import Data.MediaBus.Media.Media as X+import Data.MediaBus.Media.Reframe as X import Data.MediaBus.Media.Samples as X import Data.MediaBus.Media.Segment as X import Data.MediaBus.Media.Stream as X
+ src/Data/MediaBus/Basics/LoggingExtra.hs view
@@ -0,0 +1,21 @@+-- | Utilities for logging.+module Data.MediaBus.Basics.LoggingExtra+  ( withLogMessagePrefix+  ) where++import Control.Monad.Logger+++-- | Prefix every log message done from inside the given monad action with the+-- given prefix. This runs a 'LoggingT' action inside a 'MonadLoggerIO' base+-- monad with a log function that wraps around the log function returned by+-- 'askLoggerIO' and prefixes each message with the given prefix.+withLogMessagePrefix+  :: (ToLogStr prefix, MonadLoggerIO m)+  => prefix -> LoggingT m a -> m a+withLogMessagePrefix prefix ml = do+  originalLogger <- askLoggerIO+  let logger loc lvl src msg =+        originalLogger loc lvl src (prefixL `mappend` msg)+      prefixL = toLogStr prefix+  runLoggingT ml logger
src/Data/MediaBus/Basics/Monotone.hs view
@@ -1,9 +1,9 @@ module Data.MediaBus.Basics.Monotone-    ( LocalOrd(..)-    ) where+  ( LocalOrd(..)+  ) where -import           Data.Word-import           Data.Int+import Data.Int+import Data.Word  -- | Class of numbers that are monotone increasing having only a relative order, -- that is not necessarily transitive.@@ -14,24 +14,39 @@ -- express that @0@ `succeeds` @192@, since 'Ord' ensures complete transitivity -- and therefore @0 < 192@. class LocalOrd a where-    succeeds :: a -> a -> Bool-    default succeeds :: (Bounded a, Integral a) => a -> a -> Bool-    x `succeeds` y = (x - y) < ((maxBound - minBound) `div` 2)+  succeeds :: a -> a -> Bool -instance LocalOrd Word8+instance LocalOrd Word8 where+  x `succeeds` y =+    let d = x - y+    in d > 0 && d <= ((maxBound - minBound) `div` 2) -instance LocalOrd Word16+instance LocalOrd Word16 where+  x `succeeds` y =+    let d = x - y+    in d > 0 && d <= ((maxBound - minBound) `div` 2) -instance LocalOrd Word32+instance LocalOrd Word32 where+  x `succeeds` y =+    let d = x - y+    in d > 0 && d <= ((maxBound - minBound) `div` 2) -instance LocalOrd Word64+instance LocalOrd Word64 where+  x `succeeds` y =+    let d = x - y+    in d > 0 && d <= ((maxBound - minBound) `div` 2) -instance LocalOrd Int8+instance LocalOrd Int8 where+  x `succeeds` y = x - y > 0 -instance LocalOrd Int16+instance LocalOrd Int16 where+  x `succeeds` y = x - y > 0 -instance LocalOrd Int32+instance LocalOrd Int32 where+  x `succeeds` y = x - y > 0 -instance LocalOrd Int64+instance LocalOrd Int64 where+  x `succeeds` y = x - y > 0 -instance LocalOrd Int+instance LocalOrd Int where+  x `succeeds` y = x - y > 0
+ src/Data/MediaBus/Basics/VectorExtra.hs view
@@ -0,0 +1,15 @@+-- | Dubious utilities for 'Vector'+module Data.MediaBus.Basics.VectorExtra+  ( castedLength+  ) where++import Data.Vector.Storable as V++-- * Vector casting+-- | Calculate the number of elements that would fit into the given 'Vector'+-- if it were 'unsafeCast'ed to a vector of elements defined by the first argument.+castedLength+  :: forall a b proxy.+     (Storable a, Storable b)+  => proxy a -> Vector b -> Int+castedLength _ !v = V.length (unsafeCast v :: Vector a)
+ src/Data/MediaBus/Conduit/Logging.hs view
@@ -0,0 +1,20 @@+-- | Logging utilities for 'Conduit's.+module Data.MediaBus.Conduit.Logging+  ( prefixLogsC+  ) where++import Control.Monad.Logger+import Data.Conduit+import Data.Monoid++-- | Prefix all log messages of the given 'Conduit' with a 'Text'.+-- This is similar to 'Data.MediaBus.Basisc.LoggingExtra.withLogMessagePrefix'.+prefixLogsC+  :: (ToLogStr prefix, MonadLoggerIO m)+  => prefix -> ConduitM i o (LoggingT m) r -> ConduitM i o m r+prefixLogsC prefix nested = do+  originalLogger <- askLoggerIO+  transPipe (`runLoggingT` wrapLogger originalLogger) nested+  where+    wrapLogger originalLogger loc src lvl msg =+      originalLogger loc src lvl (toLogStr prefix <> msg)
+ src/Data/MediaBus/Media/Reframe.hs view
@@ -0,0 +1,158 @@+-- | This module contains functions and types for reframing the sequence number+--   and timestamps of 'Frame's.+--+--   This means that this module will allow you to record a set of incoming+--   frames using 'pushFrame'. Whenever you want to extract the timing and+--   sequence number information of the next frame with a given duration,+--   use 'generateFrame'.+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++-- | Create an empty initial state.+initialReframerState+  :: (Num d, Num s)+  => ReframerSt s d+initialReframerState = MkTimeFrame 0 0 0++-- | Run state 'ReframerSt' state transformer.+runReframer+  :: Monad m+  => ReframerT m s d a -> ReframerSt s d -> m (a, ReframerSt s d)+runReframer = runStateT++-- | Reset the current timing and sequence number, and start with the given+--   start time.+pushStartFrame+  :: (Num d, Monad m)+  => d -> ReframerT m s d ()+pushStartFrame d = do+  (MkTimeFrame _ s _) <- State.get+  State.put (MkTimeFrame d s d)++-- | Increase the available duration by the duration in the frame,  iff the+--   timestamp of the given frame matches exactly the timestamp after the end+--   of the available period, otherwise do nothing with the state and return+--   'True'.+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)++-- | Specifies in what way 'pushFrame' failed+data PushFrameError+  = InputFrameIsLate -- ^ The input frame ends before '_endTs'+  | InputFrameOverlaps -- ^ The input frame starts before, and ends after '_endTs'+  | InputFrameIsEarly -- ^ The input frame begins after '_endTs'+  deriving (Eq, Ord, Show, Enum)++-- | Return the duration of the frames recorded with 'pushFrame'.+nextFrameAvailableDuration+  :: (Num d, Monad m)+  => ReframerT m s d d+nextFrameAvailableDuration = do+  (MkTimeFrame startTs _ endTs) <- State.get+  return (endTs - startTs)++-- | Return the timestamp of the frame being build. .+nextFrameTimestamp+  :: (Num d, Monad m)+  => ReframerT m s d d+nextFrameTimestamp = do+  (MkTimeFrame startTs _ _) <- State.get+  return startTs++-- | Try to create a frame with the given duration, and update the state+--   accordingly, the actual duration, that was available is+--   put into the payload field of the frame returned.+--   The start time stamp of the next frame+--   is always incremented by the @wantedDureation@ regardless of wether it was+--   available.+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))++-- | Reframer state.+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)++-- | The 'ReframerSt' 'StateT' transformer+type ReframerT m s d a = StateT (ReframerSt s d) m a++-- | The exception type for 'encodeLinearToAacC'+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)++-- | Utility function to generate a 'ReframeError' with the current state.+mkReFrameError+  :: Monad m+  => String -> Maybe d -> ReframerT m s d (ReframeError s d)+mkReFrameError msg requestedOutputDuration =+  MkReframeError msg requestedOutputDuration <$> State.get