mediabus 0.2.0.2 → 0.3.0.0

raw patch · 71 files changed

+3385/−2541 lines, 71 filesdep ~mediabusPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: mediabus

API changes (from Hackage documentation)

Files

• mediabus.cabal +40/−32
• specs/Data/MediaBus/Audio/ResampleSpec.hs +0/−58
• specs/Data/MediaBus/Basics/TicksSpec.hs +33/−0
• specs/Data/MediaBus/Conduit/Audio/Raw/ResampleSpec.hs +64/−0
• specs/Data/MediaBus/Conduit/ReorderSpec.hs +173/−0
• specs/Data/MediaBus/Conduit/SegmentSpec.hs +98/−0
• specs/Data/MediaBus/Conduit/StreamSpec.hs +60/−0
• specs/Data/MediaBus/Media/BufferSpec.hs +45/−0
• specs/Data/MediaBus/ReorderSpec.hs +0/−172
• specs/Data/MediaBus/SampleSpec.hs +0/−45
• specs/Data/MediaBus/SequenceSpec.hs +0/−31
• specs/Data/MediaBus/StreamSegmentSpec.hs +0/−98
• specs/Data/MediaBus/StreamSpec.hs +0/−60
• specs/Data/MediaBus/TicksSpec.hs +0/−38
• src/Data/MediaBus.hs +38/−25
• src/Data/MediaBus/AsyncConduit.hs +0/−119
• src/Data/MediaBus/Audio/Alaw.hs +0/−131
• src/Data/MediaBus/Audio/Channels.hs +0/−69
• src/Data/MediaBus/Audio/Raw.hs +0/−99
• src/Data/MediaBus/Audio/Resample.hs +0/−41
• src/Data/MediaBus/Basics/Clock.hs +122/−0
• src/Data/MediaBus/Basics/Monotone.hs +36/−0
• src/Data/MediaBus/Basics/OrderedBy.hs +17/−0
• src/Data/MediaBus/Basics/Sequence.hs +86/−0
• src/Data/MediaBus/Basics/Series.hs +110/−0
• src/Data/MediaBus/Basics/SourceId.hs +58/−0
• src/Data/MediaBus/Basics/Ticks.hs +410/−0
• src/Data/MediaBus/BlankMedia.hs +0/−24
• src/Data/MediaBus/Clock.hs +0/−92
• src/Data/MediaBus/Conduit.hs +0/−59
• src/Data/MediaBus/Conduit/Async.hs +157/−0
• src/Data/MediaBus/Conduit/Audio/Raw/Alaw.hs +26/−0
• src/Data/MediaBus/Conduit/Audio/Raw/DebugSink.hs +56/−0
• src/Data/MediaBus/Conduit/Audio/Raw/Resample.hs +75/−0
• src/Data/MediaBus/Conduit/Discontinous.hs +19/−0
• src/Data/MediaBus/Conduit/Reorder.hs +111/−0
• src/Data/MediaBus/Conduit/Segment.hs +67/−0
• src/Data/MediaBus/Conduit/Stream.hs +173/−0
• src/Data/MediaBus/Conduit/Timing.hs +38/−0
• src/Data/MediaBus/Conduit/Trace.hs +51/−0
• src/Data/MediaBus/Conduit/TypeAnnotations.hs +32/−0
• src/Data/MediaBus/DebugSink.hs +0/−49
• src/Data/MediaBus/Discontinous.hs +0/−48
• src/Data/MediaBus/Media/Audio.hs +32/−0
• src/Data/MediaBus/Media/Audio/Raw.hs +128/−0
• src/Data/MediaBus/Media/Audio/Raw/Alaw.hs +122/−0
• src/Data/MediaBus/Media/Audio/Raw/Mono.hs +35/−0
• src/Data/MediaBus/Media/Audio/Raw/Signed16bit.hs +47/−0
• src/Data/MediaBus/Media/Audio/Raw/Stereo.hs +63/−0
• src/Data/MediaBus/Media/Blank.hs +34/−0
• src/Data/MediaBus/Media/Buffer.hs +153/−0
• src/Data/MediaBus/Media/Channels.hs +64/−0
• src/Data/MediaBus/Media/Discontinous.hs +72/−0
• src/Data/MediaBus/Media/Media.hs +84/−0
• src/Data/MediaBus/Media/Samples.hs +61/−0
• src/Data/MediaBus/Media/Segment.hs +80/−0
• src/Data/MediaBus/Media/Stream.hs +210/−0
• src/Data/MediaBus/Monotone.hs +0/−36
• src/Data/MediaBus/OrderedBy.hs +0/−13
• src/Data/MediaBus/Payload.hs +0/−9
• src/Data/MediaBus/Reorder.hs +0/−102
• src/Data/MediaBus/Sample.hs +0/−158
• src/Data/MediaBus/Segment.hs +0/−49
• src/Data/MediaBus/Sequence.hs +0/−94
• src/Data/MediaBus/Series.hs +0/−135
• src/Data/MediaBus/SourceId.hs +0/−37
• src/Data/MediaBus/Stream.hs +0/−302
• src/Data/MediaBus/StreamSegment.hs +0/−59
• src/Data/MediaBus/Ticks.hs +0/−231
• src/Data/MediaBus/Transcoder.hs +0/−22
• src/Data/MediaBus/Transport/Udp.hs +5/−4

@@ -1,5 +1,5 @@ name: mediabus-version: 0.2.0.2+version: 0.3.0.0 cabal-version: >=1.10 build-type: Simple license: BSD3@@ -20,29 +20,38 @@ library     exposed-modules:         Data.MediaBus-        Data.MediaBus.AsyncConduit-        Data.MediaBus.Audio.Alaw-        Data.MediaBus.Audio.Channels-        Data.MediaBus.Audio.Raw-        Data.MediaBus.Audio.Resample-        Data.MediaBus.BlankMedia-        Data.MediaBus.Clock-        Data.MediaBus.Conduit-        Data.MediaBus.DebugSink-        Data.MediaBus.Discontinous-        Data.MediaBus.Monotone-        Data.MediaBus.OrderedBy-        Data.MediaBus.Segment-        Data.MediaBus.StreamSegment-        Data.MediaBus.Payload-        Data.MediaBus.Reorder-        Data.MediaBus.Sample-        Data.MediaBus.Sequence-        Data.MediaBus.Series-        Data.MediaBus.SourceId-        Data.MediaBus.Stream-        Data.MediaBus.Ticks-        Data.MediaBus.Transcoder+        Data.MediaBus.Basics.Clock+        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.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.Reorder+        Data.MediaBus.Conduit.Segment+        Data.MediaBus.Conduit.Stream+        Data.MediaBus.Conduit.Timing+        Data.MediaBus.Conduit.Trace+        Data.MediaBus.Conduit.TypeAnnotations+        Data.MediaBus.Media.Audio+        Data.MediaBus.Media.Audio.Raw+        Data.MediaBus.Media.Audio.Raw.Alaw+        Data.MediaBus.Media.Audio.Raw.Mono+        Data.MediaBus.Media.Audio.Raw.Signed16bit+        Data.MediaBus.Media.Audio.Raw.Stereo+        Data.MediaBus.Media.Blank+        Data.MediaBus.Media.Buffer+        Data.MediaBus.Media.Channels+        Data.MediaBus.Media.Discontinous+        Data.MediaBus.Media.Media+        Data.MediaBus.Media.Samples+        Data.MediaBus.Media.Segment+        Data.MediaBus.Media.Stream         Data.MediaBus.Transport.Udp     build-depends:         QuickCheck >=2.9.2 && <2.10,@@ -103,7 +112,7 @@         conduit >=1.2.9 && <1.3,         conduit-combinators >=1.1.0 && <1.2,         conduit-extra >=1.1.15 && <1.2,-        mediabus >=0.2.0.2 && <0.3,+        mediabus >=0.3.0.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,@@ -134,11 +143,10 @@                         TypeInType TypeOperators TypeSynonymInstances UnicodeSyntax     hs-source-dirs: specs     other-modules:-        Data.MediaBus.Audio.ResampleSpec-        Data.MediaBus.StreamSegmentSpec-        Data.MediaBus.ReorderSpec-        Data.MediaBus.SampleSpec-        Data.MediaBus.SequenceSpec-        Data.MediaBus.StreamSpec-        Data.MediaBus.TicksSpec+        Data.MediaBus.Conduit.Audio.Raw.ResampleSpec+        Data.MediaBus.Media.BufferSpec+        Data.MediaBus.Conduit.SegmentSpec+        Data.MediaBus.Conduit.ReorderSpec+        Data.MediaBus.Conduit.StreamSpec+        Data.MediaBus.Basics.TicksSpec     ghc-options: -threaded -rtsopts -with-rtsopts=-N -j +RTS -A256m -n2m -RTS -Wall -O0 -fno-warn-unused-binds -fno-warn-orphans -fno-warn-unused-do-bind -fno-warn-missing-signatures -fno-warn-type-defaults

@@ -1,58 +0,0 @@-module Data.MediaBus.Audio.ResampleSpec ( spec ) where--import           Data.MediaBus-import           Conduit-import           Test.QuickCheck-import           Test.Hspec-import           Control.Monad.State.Strict-import           Data.Default--spec :: Spec-spec = describe "Resampling of S16 samples from 8 to 16 kHz" $ do-    it "interpolates between samples" $-        let lastVal = 0-        in-            property $-                \samples -> sampleBufferToList (resampleAndConsume (singleFrameFromList samples)-                                                                   lastVal)-                    `shouldBe` expectedResamplingResult samples lastVal-    it "interpolates also between frames" $-        let lastVal = 0-        in-            property $-                \samplesLists -> sampleBufferToList (resampleAndConsume (framesFromLists samplesLists)-                                                                        lastVal)-                    `shouldBe` expectedResamplingResult (join samplesLists)-                                                        lastVal--expectedResamplingResult :: [S16 8000] -> S16 8000 -> [S16 16000]-expectedResamplingResult xs lastVal =-    concatMap (\(x, y) -> [ setAudioSampleRateTo16kHz (avgSamples x y)-                          , setAudioSampleRateTo16kHz y-                          ])-              (zip (lastVal : xs) xs)--resampleAndConsume :: Source Identity (Stream SrcId32 SeqNum32 Ticks32At48000 () (SampleBuffer (S16 8000)))-                   -> S16 8000-                   -> SampleBuffer (S16 16000)-resampleAndConsume vvv lastVal =-    runConduitPure (vvv .|-                        resample8to16kHz' lastVal .|-                        concatStreamContents)--singleFrameFromList :: Monad m-                    => [S16 8000]-                    -> Source m (Stream SrcId32 SeqNum32 Ticks32At48000 () (SampleBuffer (S16 8000)))-singleFrameFromList x = mapOutput (MkStream . Next)-                                  (mapOutput (MkFrame () def)-                                             (yield (sampleBufferFromList x)) .|-                                       deriveFrameTimestamp 0)--framesFromLists :: Monad m-                => [[S16 8000]]-                -> Source m (Stream SrcId32 SeqNum32 Ticks32At48000 () (SampleBuffer (S16 8000)))-framesFromLists xs = mapOutput (MkStream . Next)-                               (mapOutput (MkFrame () def)-                                          (mapM_ (yield . sampleBufferFromList)-                                                 xs) .|-                                    deriveFrameTimestamp 0)

@@ -0,0 +1,33 @@+module Data.MediaBus.Basics.TicksSpec+  ( spec+  ) where++import Control.Lens+import Data.MediaBus+import Data.Word+import Test.Hspec+import Test.QuickCheck++spec :: Spec+spec = do+  describe "nominalDiffTime At8kHzU32" $+    it "is isomorphic" $+    property $ \tix ->+      view (from nominalDiffTime) (view nominalDiffTime (mkTicks32At8000 tix)) `shouldBe`+      mkTicks32At8000 tix+  describe "nominalDiffTime At48kHzU64" $+    it "is isomorphic" $+    property $ \tix ->+      view (from nominalDiffTime) (view nominalDiffTime (mkTicks64At48000 tix)) `shouldBe`+      mkTicks64At48000 tix+  describe "convertTicks between At16kHzU32 and At16kHzU32" $+    it "is idempotent" $+    property $ \tix ->+      let t = mkTicks32At16000 tix+      in convertTicks t `shouldBe` t+  describe "convertTicks between At8kHzU32 and At16kHzU64" $+    it "preserves nominalDiffTime when converting back and forth" $+    property $ \tix ->+      let t = mkTicks32At8000 tix+      in view nominalDiffTime (convertTicks t :: Ticks (Hz 16000) Word64) `shouldBe`+         view nominalDiffTime t

@@ -0,0 +1,64 @@+module Data.MediaBus.Conduit.Audio.Raw.ResampleSpec+  ( spec+  ) where++import Conduit+import Control.Monad.State.Strict+import Data.Default+import Data.MediaBus+import Test.Hspec+import Test.QuickCheck+import Control.Lens++spec :: Spec+spec =+  describe "Resampling of S16 samples from 8 to 16 kHz" $ do+    it "interpolates between samples" $+      let lastVal = 0+      in property $ \(NonEmpty samples) ->+           mediaBufferToList+             (view+                pcmMediaBuffer+                (resampleAndConsume (singleFrameFromList samples) lastVal)) `shouldBe`+           expectedResamplingResult samples lastVal+    it "interpolates also between frames" $+      let lastVal = 0+      in property $ \samplesLists ->+           mediaBufferToList+             (view+                pcmMediaBuffer+                (resampleAndConsume (framesFromLists samplesLists) lastVal)) `shouldBe`+           expectedResamplingResult (join samplesLists) lastVal++expectedResamplingResult :: [Pcm Mono S16] -> Pcm Mono S16 -> [Pcm Mono S16]+expectedResamplingResult xs lastVal =+  concatMap (\(x, y) -> [pcmAverage x y, y]) (zip (lastVal : xs) xs)++type AudioBuffer r = Audio (Hz r) Mono (Raw S16)++resampleAndConsume+  :: Source Identity (Stream SrcId32 SeqNum32 Ticks32At48000 () (AudioBuffer 8000))+  -> Pcm Mono S16+  -> AudioBuffer 16000+resampleAndConsume vvv lastVal =+  runConduitPure (vvv .| resample8to16kHz' lastVal .| concatStreamContents)++singleFrameFromList+  :: Monad m+  => [Pcm Mono S16]+  -> Source m (Stream SrcId32 SeqNum32 Ticks32At48000 () (AudioBuffer 8000))+singleFrameFromList x =+  mapOutput+    (MkStream . Next)+    (mapOutput (MkFrame () def) (yield (pcmMediaBuffer # mediaBufferFromList x)) .|+     deriveFrameTimestamp 0)++framesFromLists+  :: Monad m+  => [[Pcm Mono S16]]+  -> Source m (Stream SrcId32 SeqNum32 Ticks32At48000 () (AudioBuffer 8000))+framesFromLists xs =+  mapOutput+    (MkStream . Next)+    (mapOutput (MkFrame () def) (mapM_ (yield . view (from pcmMediaBuffer) . mediaBufferFromList) xs) .|+     deriveFrameTimestamp 0)

@@ -0,0 +1,173 @@+module Data.MediaBus.Conduit.ReorderSpec+  ( spec+  ) where++import Conduit+import Control.Monad+import Data.Conduit.List+import Data.MediaBus+import Data.Proxy+import Data.Word+import Debug.Trace+import Test.Hspec+import Test.QuickCheck++spec :: Spec+spec =+  describe "reorderFramesBySeqNumC" $ do+    let runC inputs =+          runConduitPure+            (sourceList inputs .|+             annotateTypeC+               (Proxy :: Proxy (Stream () TestSeqNumType () () ()))+               (reorderFramesBySeqNumC 3) .|+             consume)+    it "yields at least one 'Start' for each incoming 'Start'" $+      property $ \inputs ->+        let countStarts =+              foldr+                (\x n ->+                   case x of+                     MkStream (Start _) -> n + 1+                     MkStream (Next _) -> n)+                0+        in countStarts (runC inputs) `shouldSatisfy` (>= countStarts inputs)+    it "yields exactly the given input if the input is ordered and gap-free" $+      let inputs = [startFrame 0] ++ [nextFrame x | x <- [0 .. 10]]+      in runC inputs `shouldBe` inputs+    it "reorders out of order packets (1)" $+      let inputs =+            [startFrame 0, nextFrame 0, nextFrame 2, nextFrame 3, nextFrame 1]+          expected =+            [startFrame 0, nextFrame 0, nextFrame 1, nextFrame 2, nextFrame 3]+      in runC inputs `shouldBe` expected+    it "reorders out of order packets (2)" $+      let inputs = [startFrame 0, nextFrame 2, nextFrame 1, nextFrame 0]+          expected = [startFrame 0, nextFrame 0, nextFrame 1, nextFrame 2]+      in runC inputs `shouldBe` expected+    it "skips over missing frames when the queue is full" $+      let inputs =+            [ startFrame 0+            , nextFrame 0+            , nextFrame 1+            , nextFrame 3+            , nextFrame 4+            , nextFrame 5+            ]+          expected =+            [ startFrame 0+            , nextFrame 0+            , nextFrame 1+            , nextFrame 3+            , nextFrame 4+            , nextFrame 5+            ]+      in runC inputs `shouldBe` expected+    it "restarts at the incoming sequence numbering after too many frame drops" $+      let inputs =+            [ startFrame 10+            , nextFrame 10+            , nextFrame 11+            , nextFrame 12+            , nextFrame 0+            , nextFrame 1+            , nextFrame 2+            , nextFrame 3+            , nextFrame 4+            ]+          expected =+            [ startFrame 10+            , nextFrame 10+            , nextFrame 11+            , nextFrame 12+            , startFrame 2+            , nextFrame 2+            , nextFrame 3+            , nextFrame 4+            ]+      in runC inputs `shouldBe` expected+    it+      "restarts at the incoming sequence numbering after too many frame drops, AND flushes the queued elements first" $+      let inputs =+            [ startFrame 10+            , nextFrame 13+            , nextFrame 14+            , nextFrame 0+            , nextFrame 1+            , nextFrame 2+            , nextFrame 3+            , nextFrame 4+            ]+          expected =+            [ startFrame 10+            , nextFrame 13+            , nextFrame 14+            , startFrame 2+            , nextFrame 2+            , nextFrame 3+            , nextFrame 4+            ]+      in runC inputs `shouldBe` expected+    it "flushes and resets its internal state after every 'Start'" $+      let inputs =+            [ startFrame 10+            , nextFrame 13+            , nextFrame 14+            , startFrame 40+            , nextFrame 40+            , nextFrame 41+            , startFrame 50+            , nextFrame 0+            , nextFrame 1+            , startFrame 60+            , nextFrame 50+            , nextFrame 51+            , nextFrame 52+            ]+          expected =+            [ startFrame 10+            , nextFrame 13+            , nextFrame 14+            , startFrame 40+            , nextFrame 40+            , nextFrame 41+            , startFrame 50+            , startFrame 60+            , startFrame 52+            , nextFrame 52+            ]+      in runC inputs `shouldBe` expected+    it "yields monotone increasing frames higher than the start-frame" $+      property $ \inputs ->+        let os = runC inputs+        in when+             (not (isMonoIncreasingAndHigherThanStartSeqNum os))+             (trace+                (unlines $+                 ((("IN:   " ++) <$> show <$> inputs) ++ (("OUT:  " ++) <$> show <$>+                  os)))+                os `shouldSatisfy`+              isMonoIncreasingAndHigherThanStartSeqNum)++isMonoIncreasingAndHigherThanStartSeqNum :: [Stream () TestSeqNumType () () ()]+                                         -> Bool+isMonoIncreasingAndHigherThanStartSeqNum [] = True+isMonoIncreasingAndHigherThanStartSeqNum (MkStream (Start (MkFrameCtx () () sn ())):rest) =+  isMonoIncreasingAndHigherThanStartSeqNumN sn rest+isMonoIncreasingAndHigherThanStartSeqNum rest@(MkStream (Next (MkFrame () sn ())):_) =+  isMonoIncreasingAndHigherThanStartSeqNumN sn rest++isMonoIncreasingAndHigherThanStartSeqNumN _ [] = True+isMonoIncreasingAndHigherThanStartSeqNumN _ (MkStream (Start (MkFrameCtx () () sn ())):rest) =+  isMonoIncreasingAndHigherThanStartSeqNumN sn rest+isMonoIncreasingAndHigherThanStartSeqNumN sn (MkStream (Next (MkFrame () snFrame ())):rest)+  | snFrame >= sn = isMonoIncreasingAndHigherThanStartSeqNumN snFrame rest+  | otherwise = False++startFrame :: TestSeqNumType -> Stream () TestSeqNumType () () ()+startFrame sn = MkStream (Start (MkFrameCtx () () sn ()))++nextFrame :: TestSeqNumType -> Stream () TestSeqNumType () () ()+nextFrame sn = MkStream (Next (MkFrame () sn ()))++type TestSeqNumType = Word64

@@ -0,0 +1,98 @@+module Data.MediaBus.Conduit.SegmentSpec ( spec ) where++import           Test.Hspec+import           Data.Conduit.List+import           Conduit+import           Test.QuickCheck+import           Data.MediaBus+import           Data.Word+import qualified Data.Vector.Storable as V+import           Control.Lens+import           Data.Proxy++spec :: Spec+spec = describe "segmentC" $ do+    it "only outputs segments with a valid length" $+        property $+            \ls -> withTestData ls+                                PT5+                                (\_ outputs -> Prelude.drop 1 outputs `shouldSatisfy`+                                     all ((== getDuration PT5) . getDuration))+    it "only drops less than the static duration" $+        property $+            \ls -> withTestData ls+                                PT5+                                (\inputs outputs -> (sum (getDuration <$> inputs) -+                                                         sum (getDuration <$> outputs)) `shouldSatisfy`+                                     (< getDuration PT5))+    it "maintains strictly monotonic sequence numbers" $+        property $+            \ls -> withTestData ls+                                PT5+                                (const (`shouldSatisfy` seqNumStrictlyMonotoneIncreasing))+    it "maintains strictly monotonic timestamps" $+        property $+            \ls -> withTestData ls+                                PT5+                                (const (`shouldSatisfy` ticksStrictlyMonotoneIncreasing (nominalDiffTime # getStaticDuration PT5)))++withTestData :: HasStaticDuration d+             => [TestLen]+             -> PT d+             -> ([Stream () Word8 (Ticks (Hz 8000) Word32) () (Audio (Hz 8000) Mono (Raw S16))]+                 -> [Stream () Word8 (Ticks (Hz 8000) Word32) () (Segment d (Audio (Hz 8000) Mono (Raw S16)))]+                 -> res)+             -> res+withTestData ls pt f = let inputs = mkTestInputs ls+                           outputs = runSegmentC inputs pt+                       in+                           f inputs outputs++seqNumStrictlyMonotoneIncreasing outs =+    let res = view seqNum <$> outs+    in+        all (== 1) $ zipWith (-) (Prelude.drop 2 res) (Prelude.drop 1 res)++ticksStrictlyMonotoneIncreasing dur outs =+    let res = view timestamp' <$> outs+    in+        all (== dur) $ zipWith (-) (Prelude.drop 2 res) (Prelude.drop 1 res)++runSegmentC :: (HasStaticDuration d, HasDuration c, CanSegment c, Monoid c)+            => [Stream () Word8 (Ticks (Hz 8000) Word32) () c]+            -> PT d+            -> [Stream () Word8 (Ticks (Hz 8000) Word32) () (Segment d c)]+runSegmentC inputs _p = runConduitPure (sourceList inputs .|+                                            segmentC .|+                                            consume)++mkTestInputs :: [TestLen]+             -> [Stream () Word8 (Ticks (Hz 8000) Word32) () (Audio (Hz 8000) Mono (Raw S16))]+mkTestInputs = reverse .+    snd .+        foldl (\((ts0, sn0), acc0) (MkTestLen len) ->+                   ( (ts0 + fromIntegral len, sn0 + 1)+                   , mkTestPacket sn0 ts0 len : acc0+                   ))+              ((0, 0), [ mkTestStartPacket ])+  where+    mkTestPacket sn ts len =+        MkStream (Next (MkFrame ts sn (pcmMediaBuffer . mediaBufferVector # (V.replicate len 0))))++    mkTestStartPacket = MkStream (Start (MkFrameCtx () 0 0 ()))++data PT d where+        PT0 :: PT (0 :/ Hz 1)+        PT5 :: PT (5 :/ Hz 1000)+        PT10 :: PT (80 :/ Hz 8000)+        PT20 :: PT (320 :/ Hz 16000)++instance HasStaticDuration d =>+         HasDuration (PT d) where+    getDuration _ = getStaticDuration (Proxy :: Proxy d)++newtype TestLen = MkTestLen Int+    deriving (Read, Show, Ord, Eq, Num)++instance Arbitrary TestLen where+    arbitrary = MkTestLen <$> choose (0, 1000)

@@ -0,0 +1,60 @@+module Data.MediaBus.Conduit.StreamSpec ( spec ) where++import           Test.Hspec+import           Test.QuickCheck+import           Conduit+import           Data.Conduit.List+import           Data.MediaBus+import           Control.Monad+import           Data.Word+import           Control.Lens++spec :: Spec+spec = describe "Stream conduits" $+    describe "Functor instance: fmap" $+        it "should have the same result as 'overFrameContentC (...) f'" pending++-- fmap f = overFrameContentC undefined (mapInput _framePayload (const Nothing) (const f))+_helloWorld :: IO ()+_helloWorld = void $+    runConduit (yieldMany ("Hello world" :: String) .|+                    traceShowC 1 "YO" .|+                    consume)++_sampleSomeStream :: IO ALittleOutOfOrder+_sampleSomeStream = MkALittleOutOfOrder <$> sample' arbitrary++_yieldStream :: Monad m+             => ALittleOutOfOrder+             -> Source m (Stream () (SeqNum Word16) () () ())+_yieldStream (MkALittleOutOfOrder frames) =+    yieldMany frames .|+        traceShowC 1 "ORIGINAL"++_reorderSomeFrames = void $+    _sampleSomeStream >>=+        (\fs -> runConduit (_yieldStream fs .|+                                reorderFramesBySeqNumC 2 .|+                                traceShowC 1 "     ORDERED" .|+                                consume))++newtype ALittleOutOfOrder =+      MkALittleOutOfOrder { fromALittleOutOfOrder :: [Stream () (SeqNum Word16) () () ()]+                          }++instance Arbitrary ALittleOutOfOrder where+    arbitrary = do+        start <- (MkStream . Start) <$> arbitrary+        (len :: Int) <- arbitrary+        MkALittleOutOfOrder <$> loop (start ^. seqNum) (len + 10) [ start ]+      where+        loop (MkSeqNum lastSeq) n acc+            | n == 0 = return acc+            | otherwise = do+                  nextSeq' <- choose (lastSeq + 1, lastSeq + 2)+                  ts <- arbitrary+                  c <- arbitrary+                  let nextSeq = MkSeqNum nextSeq'+                  loop nextSeq+                       (n - 1)+                       (MkStream (Next (MkFrame ts nextSeq c)) : acc)

@@ -0,0 +1,45 @@+module Data.MediaBus.Media.BufferSpec ( spec ) where++import           Data.MediaBus+import           Control.Monad+import           Test.Hspec+import           Control.Lens+import           Data.Char+import qualified Data.Vector.Generic.Mutable as V++spec :: Spec+spec = describe "MediaBuffer" $ do+    it "can be mapped over with eachSample" $+        (mediaBufferFromList "Hello" & each %~ toUpper) `shouldBe`+        mediaBufferFromList "HELLO"+    it "can be mapped over with eachSample changing the type" $+        (mediaBufferFromList "Hello" & mediaBufferVector .+             each %~+             const True) `shouldBe`+        mediaBufferFromList (Prelude.replicate 5 True)+    describe "modifyMediaBuffer" $+        it "modifies in-place" $+        let f v =+                -- imperative safe destructive updates+                let n = V.length v+                in+                    forM_ [0 .. (n - 1) `div` 2] (\i -> V.swap v i (n - 1 - i))+        in+            modifyMediaBuffer f (mediaBufferFromList [1 .. 4 :: Int]) `shouldBe`+                mediaBufferFromList [4,3 .. 1]+    describe "unsafeModifyMediaBuffer" $+        it "modifies in-place and can return values" $+        let f v =+                -- imperative safe destructive updates+                let n = V.length v+                in+                    forM [0 .. (n - 1) `div` 2]+                         (\i -> do+                              V.swap v i (n - 1 - i)+                              return i)+        in+            unsafeModifyMediaBuffer f (mediaBufferFromList [1 .. 4 :: Int]) `shouldBe`+                ([ 0, 1 ], mediaBufferFromList [4,3 .. 1])++data TestFormat = MkTestFormat+    deriving Show

@@ -1,172 +0,0 @@-module Data.MediaBus.ReorderSpec ( spec ) where--import           Conduit-import           Data.Conduit.List-import           Data.MediaBus-import           Test.Hspec-import           Data.Proxy-import           Data.Word-import           Test.QuickCheck--spec :: Spec-spec = describe "reorderFramesBySeqNumC" $ do-    let runC inputs = runConduitPure (sourceList inputs .|-                                          annotateTypeC (Proxy :: Proxy (Stream () Word8 () () ()))-                                                         (reorderFramesBySeqNumC 3) .|-                                          consume)--    it "yields at least one 'Start' for each incoming 'Start'" $-        property $-            \inputs -> let countStarts = foldr (\x n -> case x of-                                                    MkStream (Start _) -> n + 1-                                                    MkStream (Next _) -> n)-                                               0-                       in-                           countStarts (runC inputs) `shouldSatisfy`-                               (>= countStarts inputs)-    it "yields exactly the given input if the input is ordered and gap-free" $-        let inputs = [ startFrame 0 ] ++-                [ nextFrame x-                | x <- [0 .. 10] ]-        in-            runC inputs `shouldBe`-                inputs-    it "reorders out of order packets (1)" $-        let inputs = [ startFrame 0-                     , nextFrame 0-                     , nextFrame 2-                     , nextFrame 3-                     , nextFrame 1-                     ]-            expected = [ startFrame 0-                       , nextFrame 0-                       , nextFrame 1-                       , nextFrame 2-                       , nextFrame 3-                       ]-        in-            runC inputs `shouldBe`-                expected-    it "reorders out of order packets (2)" $-        let inputs = [ startFrame 0, nextFrame 2, nextFrame 1, nextFrame 0 ]-            expected = [ startFrame 0, nextFrame 0, nextFrame 1, nextFrame 2 ]-        in-            runC inputs `shouldBe`-                expected-    it "skips over missing frames when the queue is full" $-        let inputs = [ startFrame 0-                     , nextFrame 0-                     , nextFrame 1-                     , nextFrame 3-                     , nextFrame 4-                     , nextFrame 5-                     ]-            expected = [ startFrame 0-                       , nextFrame 0-                       , nextFrame 1-                       , nextFrame 3-                       , nextFrame 4-                       , nextFrame 5-                       ]-        in-            runC inputs `shouldBe`-                expected-    it "restarts at the incoming sequence numbering after too many frame drops" $-        let inputs = [ startFrame 10-                     , nextFrame 10-                     , nextFrame 11-                     , nextFrame 12-                     , nextFrame 0-                     , nextFrame 1-                     , nextFrame 2-                     , nextFrame 3-                     , nextFrame 4-                     ]-            expected = [ startFrame 10-                       , nextFrame 10-                       , nextFrame 11-                       , nextFrame 12-                       , startFrame 2-                       , nextFrame 2-                       , nextFrame 3-                       , nextFrame 4-                       ]-        in-            runC inputs `shouldBe`-                expected-    it "restarts at the incoming sequence numbering after too many frame drops, AND flushes the queued elements first" $-        let inputs = [ startFrame 10-                     , nextFrame 13-                     , nextFrame 14-                     , nextFrame 0-                     , nextFrame 1-                     , nextFrame 2-                     , nextFrame 3-                     , nextFrame 4-                     ]-            expected = [ startFrame 10-                       , nextFrame 13-                       , nextFrame 14-                       , startFrame 2-                       , nextFrame 2-                       , nextFrame 3-                       , nextFrame 4-                       ]-        in-            runC inputs `shouldBe`-                expected-    it "flushes and resets its internal state after every 'Start'" $-        let inputs = [ startFrame 10-                     , nextFrame 13-                     , nextFrame 14-                     , startFrame 40-                     , nextFrame 40-                     , nextFrame 41-                     , startFrame 50-                     , nextFrame 0-                     , nextFrame 1-                     , startFrame 60-                     , nextFrame 50-                     , nextFrame 51-                     , nextFrame 52-                     ]-            expected = [ startFrame 10-                       , nextFrame 13-                       , nextFrame 14-                       , startFrame 40-                       , nextFrame 40-                       , nextFrame 41-                       , startFrame 50-                       , startFrame 60-                       , startFrame 52-                       , nextFrame 52-                       ]-        in-            runC inputs `shouldBe`-                expected-    it "yields monotone increasing frames higher than the start-frame" $-        property $-            \inputs -> runC inputs `shouldSatisfy`-                isMonoIncreasingAndHigherThanStartSeqNum--isMonoIncreasingAndHigherThanStartSeqNum :: [Stream () Word8 () () ()] -> Bool-isMonoIncreasingAndHigherThanStartSeqNum [] =-    True-isMonoIncreasingAndHigherThanStartSeqNum (MkStream (Start (MkFrameCtx () () sn ())) : rest) =-    isMonoIncreasingAndHigherThanStartSeqNumN sn rest-isMonoIncreasingAndHigherThanStartSeqNum rest@(MkStream (Next (MkFrame () sn ())) : _) =-    isMonoIncreasingAndHigherThanStartSeqNumN sn rest--isMonoIncreasingAndHigherThanStartSeqNumN _ [] =-    True-isMonoIncreasingAndHigherThanStartSeqNumN _ (MkStream (Start (MkFrameCtx () () sn ())) : rest) =-    isMonoIncreasingAndHigherThanStartSeqNumN sn rest-isMonoIncreasingAndHigherThanStartSeqNumN sn (MkStream (Next (MkFrame () snFrame ())) : rest)-    | snFrame >= sn = isMonoIncreasingAndHigherThanStartSeqNumN snFrame rest-    | otherwise = False--startFrame :: Word8 -> Stream () Word8 () () ()-startFrame sn = MkStream (Start (MkFrameCtx () () sn ()))--nextFrame :: Word8 -> Stream () Word8 () () ()-nextFrame sn = MkStream (Next (MkFrame () sn ()))

@@ -1,45 +0,0 @@-module Data.MediaBus.SampleSpec ( spec ) where--import           Data.MediaBus-import           Control.Monad-import           Test.Hspec-import           Control.Lens-import           Data.Char-import qualified Data.Vector.Generic.Mutable as V--spec :: Spec-spec = describe "SampleBuffer" $ do-    it "can be mapped over with eachSample" $-        (sampleBufferFromList "Hello" & eachSample %~ toUpper) `shouldBe`-        sampleBufferFromList "HELLO"-    it "can be mapped over with eachSample changing the type" $-        (sampleBufferFromList "Hello" & sampleBuffer . sampleVector .-             each %~-             const True) `shouldBe`-        sampleBufferFromList (Prelude.replicate 5 True)-    describe "mutateSamples" $-        it "modifies in-place" $-        let f v =-                -- imperative safe destructive updates-                let n = V.length v-                in-                    forM_ [0 .. (n - 1) `div` 2] (\i -> V.swap v i (n - 1 - i))-        in-            mutateSamples f (sampleBufferFromList [1 .. 4 :: Int]) `shouldBe`-                sampleBufferFromList [4,3 .. 1]-    describe "unsafeMutateSamples" $-        it "modifies in-place and can return values" $-        let f v =-                -- imperative safe destructive updates-                let n = V.length v-                in-                    forM [0 .. (n - 1) `div` 2]-                         (\i -> do-                              V.swap v i (n - 1 - i)-                              return i)-        in-            unsafeMutateSamples f (sampleBufferFromList [1 .. 4 :: Int]) `shouldBe`-                ([ 0, 1 ], sampleBufferFromList [4,3 .. 1])--data TestFormat = MkTestFormat-    deriving Show

@@ -1,31 +0,0 @@-module Data.MediaBus.SequenceSpec ( spec ) where--import           Conduit                         as C-import           Data.Conduit.List               ( consume, sourceList )-import           Data.Word-import           Test.Hspec-import           Test.QuickCheck-import           Data.MediaBus---- -------------------------------------------------------------------------------- * Tests/Specs--- ------------------------------------------------------------------------------spec :: Spec-spec =-    describe "synchronizeToSeqNum" $-        it "produces dense, strictly monotonic output" $-            property synchronizeToSeqNumIsMonotone--synchronizeToSeqNumIsMonotone :: NonEmptyList (SeqNum ())-                              -> Word64-                              -> Expectation-synchronizeToSeqNumIsMonotone (NonEmpty xs) startVal = do-    let inEvents = sourceList xs :: Producer Identity (SeqNum ())-        (e0 : rest) = runConduitPure (inEvents .|-                                          synchronizeToSeqNum startVal .|-                                          consume)-    e0 `shouldBe` MkSeqNum startVal--    (rest `zip` drop 1 rest) `shouldSatisfy`-        all (not .-                 uncurry succeeds)

@@ -1,98 +0,0 @@-module Data.MediaBus.StreamSegmentSpec ( spec ) where--import           Test.Hspec-import           Data.Conduit.List-import           Conduit-import           Test.QuickCheck-import           Data.MediaBus-import           Data.Word-import qualified Data.Vector.Storable as V-import           Control.Lens-import           Data.Proxy--spec :: Spec-spec = describe "segmentC" $ do-    it "only outputs segments with a valid length" $-        property $-            \ls -> withTestData ls-                                PT5-                                (\_ outputs -> (Prelude.drop 1 outputs) `shouldSatisfy`-                                     all ((== getDuration PT5) . getDuration))-    it "only drops less than the static duration" $-        property $-            \ls -> withTestData ls-                                PT5-                                (\inputs outputs -> (sum (getDuration <$> inputs) --                                                         sum (getDuration <$> outputs)) `shouldSatisfy`-                                     (< getDuration PT5))-    it "maintains strictly monotonic sequence numbers" $-        property $-            \ls -> withTestData ls-                                PT5-                                (const (`shouldSatisfy` seqNumStrictlyMonotoneIncreasing))-    it "maintains strictly monotonic timestamps" $-        property $-            \ls -> withTestData ls-                                PT5-                                (const (`shouldSatisfy` ticksStrictlyMonotoneIncreasing (nominalDiffTime # getStaticDuration PT5)))--withTestData :: HasStaticDuration d-             => [TestLen]-             -> PT d-             -> ([Stream () Word8 (Ticks 8000 Word32) () (SampleBuffer (S16 8000))]-                 -> [Stream () Word8 (Ticks 8000 Word32) () (Segment d (SampleBuffer (S16 8000)))]-                 -> res)-             -> res-withTestData ls pt f = let inputs = mkTestInputs ls-                           outputs = runSegmentC inputs pt-                       in-                           f inputs outputs--seqNumStrictlyMonotoneIncreasing outs =-    let res = view seqNum <$> outs-    in-        all (== 1) $ zipWith (-) (Prelude.drop 2 res) (Prelude.drop 1 res)--ticksStrictlyMonotoneIncreasing dur outs =-    let res = view timestamp' <$> outs-    in-        all (== dur) $ zipWith (-) (Prelude.drop 2 res) (Prelude.drop 1 res)--runSegmentC :: (HasStaticDuration d, HasDuration c, CanSegment c, Monoid c)-            => [Stream () Word8 (Ticks 8000 Word32) () c]-            -> PT d-            -> [Stream () Word8 (Ticks 8000 Word32) () (Segment d c)]-runSegmentC inputs _p = runConduitPure (sourceList inputs .|-                                            segmentC .|-                                            consume)--mkTestInputs :: [TestLen]-             -> [Stream () Word8 (Ticks 8000 Word32) () (SampleBuffer (S16 8000))]-mkTestInputs = reverse .-    snd .-        foldl (\((ts0, sn0), acc0) (MkTestLen len) ->-                   ( (ts0 + fromIntegral len, sn0 + 1)-                   , mkTestPacket sn0 ts0 len : acc0-                   ))-              ((0, 0), [ mkTestStartPacket ])-  where-    mkTestPacket sn ts len =-        MkStream (Next (MkFrame ts sn (MkSampleBuffer (V.replicate len 0))))--    mkTestStartPacket = MkStream (Start (MkFrameCtx () 0 0 ()))--data PT d where-        PT0 :: PT (0 :@ 1)-        PT5 :: PT (5 :@ 1000)-        PT10 :: PT (80 :@ 8000)-        PT20 :: PT (320 :@ 16000)--instance HasStaticDuration d =>-         HasDuration (PT d) where-    getDuration _ = getStaticDuration (Proxy :: Proxy d)--newtype TestLen = MkTestLen Int-    deriving (Read, Show, Ord, Eq, Num)--instance Arbitrary TestLen where-    arbitrary = MkTestLen <$> choose (0, 1000)

@@ -1,60 +0,0 @@-module Data.MediaBus.StreamSpec ( spec ) where--import           Test.Hspec-import           Test.QuickCheck-import           Conduit-import           Data.Conduit.List-import           Data.MediaBus-import           Control.Monad-import           Data.Word-import           Control.Lens--spec :: Spec-spec = describe "Stream conduits" $-    describe "Functor instance: fmap" $-        it "should have the same result as 'overFrameContentC (...) f'" pending---- fmap f = overFrameContentC undefined (mapInput _framePayload (const Nothing) (const f))-_helloWorld :: IO ()-_helloWorld = void $-    runConduit (yieldMany ("Hello world" :: String) .|-                    traceShowC 1 "YO" .|-                    consume)--_sampleSomeStream :: IO ALittleOutOfOrder-_sampleSomeStream = MkALittleOutOfOrder <$> sample' arbitrary--_yieldStream :: Monad m-             => ALittleOutOfOrder-             -> Source m (Stream () (SeqNum Word16) () () ())-_yieldStream (MkALittleOutOfOrder frames) =-    yieldMany frames .|-        traceShowC 1 "ORIGINAL"--_reorderSomeFrames = void $-    _sampleSomeStream >>=-        (\fs -> runConduit (_yieldStream fs .|-                                reorderFramesBySeqNumC 2 .|-                                traceShowC 1 "     ORDERED" .|-                                consume))--newtype ALittleOutOfOrder =-      MkALittleOutOfOrder { fromALittleOutOfOrder :: [Stream () (SeqNum Word16) () () ()]-                          }--instance Arbitrary ALittleOutOfOrder where-    arbitrary = do-        start <- (MkStream . Start) <$> arbitrary-        (len :: Int) <- arbitrary-        MkALittleOutOfOrder <$> loop (start ^. seqNum) (len + 10) [ start ]-      where-        loop (MkSeqNum lastSeq) n acc-            | n == 0 = return acc-            | otherwise = do-                  nextSeq' <- choose (lastSeq + 1, lastSeq + 2)-                  ts <- arbitrary-                  c <- arbitrary-                  let nextSeq = MkSeqNum nextSeq'-                  loop nextSeq-                       (n - 1)-                       (MkStream (Next (MkFrame ts nextSeq c)) : acc)

@@ -1,38 +0,0 @@-module Data.MediaBus.TicksSpec ( spec ) where--import           Data.MediaBus-import           Test.QuickCheck-import           Test.Hspec-import           Control.Lens-import           Data.Word--spec :: Spec-spec = do-    describe "nominalDiffTime At8kHzU32" $-        it "is isomorphic" $-            property $-                \tix -> (view (from nominalDiffTime)-                              (view nominalDiffTime (mkTicks at8kHzU32 tix)))-                        `shouldBe`-                        mkTicks at8kHzU32 tix-    describe "nominalDiffTime At48kHzU64" $-        it "is isomorphic" $-            property $-                \tix -> (view (from nominalDiffTime)-                              (view nominalDiffTime (mkTicks at48kHzU64 tix)))-                        `shouldBe`-                        mkTicks at48kHzU64 tix-    describe "convertTicks between At16kHzU32 and At16kHzU32" $-        it "is idempotent" $-            property $-                \tix -> let t = mkTicks at16kHzU32 tix-                        in-                            convertTicks t `shouldBe` t-    describe "convertTicks between At8kHzU32 and At16kHzU64" $-        it "preserves nominalDiffTime when converting back and forth" $-            property $-                \tix -> let t = mkTicks at8kHzU32 tix-                        in-                            view nominalDiffTime-                                 (convertTicks t :: Ticks 16000 Word64) `shouldBe`-                                view nominalDiffTime t

@@ -1,26 +1,39 @@-module Data.MediaBus ( module X ) where+-- | Multi media processing library.+-- This module only reexports all other modules in this package.+module Data.MediaBus+  ( module X+  ) where -import           Data.MediaBus.AsyncConduit   as X-import           Data.MediaBus.Audio.Alaw     as X-import           Data.MediaBus.Audio.Channels as X-import           Data.MediaBus.Audio.Raw      as X-import           Data.MediaBus.Audio.Resample as X-import           Data.MediaBus.BlankMedia     as X-import           Data.MediaBus.Clock          as X-import           Data.MediaBus.Conduit        as X-import           Data.MediaBus.DebugSink      as X-import           Data.MediaBus.Discontinous   as X-import           Data.MediaBus.Monotone       as X-import           Data.MediaBus.OrderedBy      as X-import           Data.MediaBus.Segment        as X-import           Data.MediaBus.Payload        as X-import           Data.MediaBus.Reorder        as X-import           Data.MediaBus.Sample         as X-import           Data.MediaBus.Sequence       as X-import           Data.MediaBus.Series         as X-import           Data.MediaBus.SourceId       as X-import           Data.MediaBus.Stream         as X-import           Data.MediaBus.StreamSegment  as X-import           Data.MediaBus.Ticks          as X-import           Data.MediaBus.Transcoder     as X-import           Data.MediaBus.Transport.Udp  as X+import Data.MediaBus.Basics.Clock 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.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.Reorder as X+import Data.MediaBus.Conduit.Segment as X+import Data.MediaBus.Conduit.Stream as X+import Data.MediaBus.Conduit.Timing as X+import Data.MediaBus.Conduit.Trace as X+import Data.MediaBus.Conduit.TypeAnnotations as X+import Data.MediaBus.Media.Audio as X+import Data.MediaBus.Media.Audio.Raw as X+import Data.MediaBus.Media.Audio.Raw.Alaw as X+import Data.MediaBus.Media.Audio.Raw.Mono as X+import Data.MediaBus.Media.Audio.Raw.Signed16bit as X+import Data.MediaBus.Media.Audio.Raw.Stereo as X+import Data.MediaBus.Media.Blank as X+import Data.MediaBus.Media.Buffer as X+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.Samples as X+import Data.MediaBus.Media.Segment as X+import Data.MediaBus.Media.Stream as X+import Data.MediaBus.Transport.Udp as X

@@ -1,119 +0,0 @@-module Data.MediaBus.AsyncConduit-    ( withAsyncPolledSource-    , PayloadQ()-    , mkPayloadQ-    , payloadQSink-    , payloadQSource-    ) where--import           Control.Exception               ( evaluate )-import           Control.Monad.State-import           Data.Time.Clock-import           Control.Concurrent.Async.Lifted-import           Control.Concurrent.STM-import           Control.Concurrent              ( threadDelay )-import           Control.Parallel.Strategies     ( NFData, rdeepseq-                                                 , withStrategy )-import           GHC.TypeLits-import           System.Random-import           Conduit-import           Data.MediaBus.Clock-import           Data.MediaBus.Stream-import           Data.MediaBus.Discontinous-import           Data.MediaBus.Ticks-import           Control.Lens-import           Data.Default-import           Debug.Trace-import           Data.Proxy-import           Text.Printf--data PollPayloadSourceSt s t =-      MkPollPayloadSourceSt { _ppSeqNum :: !s-                            , _ppTicks  :: !t-                            }--makeLenses ''PollPayloadSourceSt--withAsyncPolledSource :: (MonadResource m, MonadBaseControl IO m, KnownNat r, Integral t, Integral s, Default c, Default p, HasStaticDuration c, HasDuration c, NFData c, NFData p, NFData s, NFData t, Random i, Random t, Random s, Show c)-                      => Int-                      -> Source m (Stream i s (Ticks r t) p c)-                      -> (( Async ()-                          , Source m (Stream i s (Ticks r t) p (Discontinous c))-                          )-                          -> m o)-                      -> m o-withAsyncPolledSource !frameQueueLen !src !f = do-    !pq <- mkPayloadQ frameQueueLen-    withAsync (runConduit (src .| payloadQSink pq))-              (\a -> f (void a, payloadQSource pq))--data PayloadQ a = MkPayloadQ { _payloadQSegmentDuration :: !NominalDiffTime-                             , _payloadQPollIntervall   :: !NominalDiffTime-                             , _payloadQRing            :: !(TBQueue a)-                             }--mkPayloadQ :: forall m a.-           (HasStaticDuration a, MonadBaseControl IO m)-           => Int-           -> m (PayloadQ a)-mkPayloadQ qlen = MkPayloadQ segmentDuration-                             (fromIntegral qlen * 0.5 * segmentDuration) <$> liftBase (newTBQueueIO qlen)-  where-    segmentDuration = getStaticDuration (Proxy :: Proxy a)--payloadQSink :: (NFData a, MonadBaseControl IO m, Show a)-             => PayloadQ a-             -> Sink (Stream i s t p a) m ()-payloadQSink (MkPayloadQ _ _ !ringRef) =-    awaitForever go-  where-    go !x = do-        maybe (return ()) pushInRing (x ^? payload)-        return ()-      where-        pushInRing !buf' = liftBase $ do-            !buf <- evaluate $ withStrategy rdeepseq buf'-            atomically $ do-                isFull <- isFullTBQueue ringRef-                when isFull (void $ readTBQueue ringRef)-                writeTBQueue ringRef buf--payloadQSource :: (Random i, NFData c, NFData p, Default p, HasStaticDuration c, HasDuration c, MonadBaseControl IO m, KnownNat r, Integral t, Integral s, NFData t, NFData s)-               => PayloadQ c-               -> Source m (Stream i s (Ticks r t) p (Discontinous c))-payloadQSource (MkPayloadQ pTime pollIntervall ringRef) =-    evalStateC (MkPollPayloadSourceSt 0 0) $ do-        yieldStart-        go False-  where-    go wasMissing = do-        res <- liftBase $ race (atomically $ readTBQueue ringRef) sleep-        case res of-            Left buf -> yieldNextBuffer (Got buf) >> go False-            Right dt -> yieldMissing dt wasMissing >> go True--    sleep = liftBase (do-                          !(t0 :: ClockTime UtcClock) <- now-                          threadDelay (_ticks pollIntervallMicros)-                          !t1 <- now-                          return (_utcClockTimeDiff (diffTime t1 t0)))-    yieldMissing !dt !wasMissing = do-        unless wasMissing-               (traceM (printf "*** UNDERFLOW: Missing %s" (show dt)))-        replicateM_ (floor (dt / pTime)) (yieldNextBuffer Missing)-    yieldStart = (MkFrameCtx <$> liftBase randomIO-                             <*> use ppTicks-                             <*> use ppSeqNum-                             <*> pure def) >>=-        yieldStartFrameCtx--    pollIntervallMicros :: Ticks 1000000 Int-    pollIntervallMicros = nominalDiffTime # pollIntervall---    yieldNextBuffer !buf = do-        let !bufferDuration = nominalDiffTime # getDuration buf-        !ts <- ppTicks <<+= bufferDuration-        !sn <- ppSeqNum <<+= 1-        frm <- liftBase (evaluate (withStrategy rdeepseq $ MkFrame ts sn buf))-        yieldNextFrame frm

@@ -1,131 +0,0 @@-module Data.MediaBus.Audio.Alaw-    ( ALaw(..)-    , alawSample-    ) where--import           Foreign.Storable-import           Data.MediaBus.Stream-import           Data.MediaBus.Audio.Raw-import           Data.MediaBus.Audio.Channels-import           Data.MediaBus.BlankMedia-import           Data.MediaBus.Ticks-import           Data.MediaBus.Sample-import           Data.MediaBus.Transcoder-import           Data.Bits-import           Data.Word-import           Data.Int-import           Control.Lens-import           Data.Proxy-import           Data.Function                ( on )-import           Test.QuickCheck              ( Arbitrary(..) )-import           GHC.Generics                 ( Generic )-import           Control.Parallel.Strategies  ( NFData, rdeepseq, withStrategy )--newtype ALaw = MkALaw { _alawSample :: Word8 }-    deriving (Show, Storable, Num, Eq, Bits, Arbitrary, Generic)--instance NFData ALaw--makeLenses ''ALaw--instance Ord ALaw where-    compare = compare `on` (decodeALawSample . _alawSample)--instance HasDuration (Proxy ALaw) where-    getDuration _ = 1 / 8000-    getDurationTicks _ = convertTicks (MkTicks 1 :: Ticks 8000 Int)--instance HasChannelLayout ALaw where-    channelLayout _ = SingleChannel--instance Transcoder (SampleBuffer ALaw) (SampleBuffer (S16 8000)) where-    transcode = over (framePayload . eachSample)-                     (withStrategy rdeepseq .-                          MkS16 . decodeALawSample . _alawSample)--instance Transcoder (SampleBuffer (S16 8000)) (SampleBuffer ALaw) where-    transcode = over (framePayload . eachSample)-                     (withStrategy rdeepseq .-                          MkALaw . encodeALawSample . _s16Sample)--instance IsAudioSample ALaw where-    type GetAudioSampleRate ALaw = 8000-    type SetAudioSampleRate ALaw x = ALaw-    avgSamples !x !y = MkALaw .-        encodeALawSample .-            _s16Sample $-        (avgSamples `on` (mkS16 . decodeALawSample . _alawSample)) x y-      where-        mkS16 :: Int16 -> S16 8000-        mkS16 = MkS16-    setAudioSampleRate _ = id--instance CanBeBlank ALaw where-    blank = MkALaw 0xD5--decodeALawSample :: Word8 -> Int16-decodeALawSample !a' = let !a = a' `xor` 85-                           !quant_mask = 15-                           !quant_shift = 4-                           !seg_mask = 112-                           !seg_shift = 4-                           tBase, tAbs, seg :: Int16-                           !seg = (fromIntegral a .&. seg_mask) `shiftR`-                               seg_shift-                           !tBase = (fromIntegral a .&. quant_mask) `shiftL`-                               quant_shift-                           !tAbs = case seg of-                               0 -> tBase + 8-                               1 -> tBase + 264-                               _ -> (tBase + 264) `shiftL`-                                   fromIntegral (seg - 1)-                           !isPos = testBit a 7-                       in-                           if isPos then tAbs else tAbs * (-1)---- | See http://opensource.apple.com//source/tcl/tcl-20/tcl_ext/snack/snack/generic/g711.c------ >	Linear Input Code	 Compressed Code--- >	-----------------  ------------------ >	  0000000wxyza         000wxyz--- >	  0000001wxyza         001wxyz--- >	  000001wxyzab         010wxyz--- >	  00001wxyzabc         011wxyz--- >	  0001wxyzabcd         100wxyz--- >	  001wxyzabcde         101wxyz--- >	  01wxyzabcdef         110wxyz--- >	  1wxyzabcdefg         111wxyz------ For further information see John C. Bellamy's Digital Telephony, 1982, John--- Wiley & Sons, pps 98-111 and 472-476.-encodeALawSample :: Int16 -> Word8-encodeALawSample !pcmVal' =-    let !pcmVal = pcmVal' `shiftR` 3 -- to 13 bit-        (!mask, !pcmValAbs) = if pcmVal >= 0-                              then ( 0xD5 -- sign (7th) bit = 1-                                   , pcmVal-                                   )-                              else ( 0x55 -- sign bit = 0-                                   , (-1) * pcmVal - 1-                                   )-        -- !segments = [0x1F,0x3F,0x7F,0xFF,0x1FF,0x3FF,0x7FF,0xFFF] :: [-        !segment-            | pcmValAbs <= 31 = 0-            | pcmValAbs <= 63 = 1-            | pcmValAbs <= 127 = 2-            | pcmValAbs <= 255 = 3-            | pcmValAbs <= 511 = 4-            | pcmValAbs <= 1023 = 5-            | pcmValAbs <= 2047 = 6-            | pcmValAbs <= 4095 = 7-            | otherwise = 8-        !res = if segment == 8-               then 0x7F-               else let !segShift = if segment < 2-                                    then 1-                                    else fromIntegral segment-                    in-                        shiftL segment 4 .|.-                            (shiftR pcmValAbs segShift .&. 0xF)-    in-        fromIntegral res `xor` mask

@@ -1,69 +0,0 @@-module Data.MediaBus.Audio.Channels-    ( ChannelLayout(..)-    , ChannelPair(..)-    , leftSample-    , rightSample-    , HasChannelLayout(..)-    ) where--import           Control.Lens-import           Foreign.Storable-import           Data.MediaBus.Ticks-import           Data.MediaBus.BlankMedia-import           Test.QuickCheck-import           Data.Proxy-import           GHC.Generics        ( Generic )-import           Control.DeepSeq--data ChannelLayout = SingleChannel | ChannelPair-    deriving (Show, Eq, Ord, Enum, Generic)--instance (CanBeBlank r) =>-         CanBeBlank (ChannelPair r) where-    blank = MkChannelPair blank blank--instance NFData ChannelLayout--class HasChannelLayout c where-    channelLayout :: c -> ChannelLayout--data ChannelPair a = MkChannelPair { _leftSample  :: a-                                   , _rightSample :: a-                                   }-    deriving (Show, Eq, Ord, Generic)--instance NFData a =>-         NFData (ChannelPair a)--instance Arbitrary a =>-         Arbitrary (ChannelPair a) where-    arbitrary = MkChannelPair <$> arbitrary <*> arbitrary--makeLenses ''ChannelPair--instance HasChannelLayout a =>-         HasChannelLayout (ChannelPair a) where-    channelLayout MkChannelPair{_leftSample,_rightSample} =-        case (channelLayout _leftSample, channelLayout _rightSample) of-            (SingleChannel, SingleChannel) ->-                ChannelPair-            other -> error ("Sorry this channel layout is not supported: " ++-                                show other)--instance (HasDuration (Proxy a)) =>-         HasDuration (Proxy (ChannelPair a)) where-    getDuration _ = getDuration (Proxy :: Proxy a)--instance Storable s =>-         Storable (ChannelPair s) where-    sizeOf s = 2 * sizeOf s-    alignment = alignment-    peekByteOff ptr off = do-        l <- peekByteOff ptr off-        let rOffset = sizeOf l-        r <- peekByteOff ptr (rOffset + off)-        return (MkChannelPair l r)-    pokeByteOff ptr off (MkChannelPair l r) = do-        pokeByteOff ptr off l-        let rOffset = sizeOf l-        pokeByteOff ptr (off + rOffset) r

@@ -1,99 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}--module Data.MediaBus.Audio.Raw-    ( S16(..)-    , s16Sample-    , IsAudioSample(..)-    , setAudioSampleRateTo8kHz-    , setAudioSampleRateTo16kHz-    , setAudioSampleRateTo48kHz-    , doubleAudioSampleRate-    ) where--import           Foreign.Storable-import           Data.MediaBus.Audio.Channels-import           Data.MediaBus.BlankMedia-import           Data.Int-import           Control.Lens-import           Test.QuickCheck-import           Data.Bits-import           Data.Typeable-import           Data.MediaBus.Ticks-import           GHC.TypeLits-import           Data.Function                ( on )-import           GHC.Generics                 ( Generic )-import           Control.DeepSeq--newtype S16 (rate :: Nat) = MkS16 { _s16Sample :: Int16 }-    deriving (Typeable, Storable, Num, Eq, Ord, Arbitrary, Generic)--instance NFData (S16 rate)--instance KnownNat r =>-         HasDuration (Proxy (S16 r)) where-    getDuration _ = 1 / fromInteger (natVal (Proxy :: Proxy r))-    getDurationTicks _ = convertTicks (MkTicks 1 :: Ticks r Int)--instance Show (S16 r) where-    show (MkS16 x) = show x--makeLenses ''S16--class (KnownNat (GetAudioSampleRate a), SetAudioSampleRate a (GetAudioSampleRate a) ~ a, Show a, Storable a, Eq a, Ord a, Arbitrary a) =>-      IsAudioSample a where-    type GetAudioSampleRate a :: Nat-    type SetAudioSampleRate a (b :: Nat)-    avgSamples :: a -> a -> a-    setAudioSampleRate :: KnownNat r => proxy r -> a -> SetAudioSampleRate a r--instance KnownNat r =>-         IsAudioSample (S16 r) where-    type SetAudioSampleRate (S16 r) x = S16 x-    type GetAudioSampleRate (S16 r) = r-    avgSamples (MkS16 !x) (MkS16 !y) =-        MkS16 $-            if abs x < 16382 &&-                abs y < 16382-            then (x + y) `unsafeShiftR` 1-            else (x `unsafeShiftR` 1) + (y `unsafeShiftR` 1)-    setAudioSampleRate _ (MkS16 !x) =-        MkS16 x--instance CanBeBlank (S16 r) where-    blank = MkS16 0--instance (IsAudioSample a) =>-         IsAudioSample (ChannelPair a) where-    type SetAudioSampleRate (ChannelPair a) x = ChannelPair (SetAudioSampleRate a x)-    type GetAudioSampleRate (ChannelPair a) = GetAudioSampleRate a-    avgSamples !x !y = MkChannelPair ((avgSamples `on` _leftSample) x y)-                                     ((avgSamples `on` _rightSample) x y)-    setAudioSampleRate !p (MkChannelPair !l !r) =-        MkChannelPair (setAudioSampleRate p l) (setAudioSampleRate p r)--setAudioSampleRateTo8kHz :: (IsAudioSample x, y ~ SetAudioSampleRate x 8000)-                         => x-                         -> y-setAudioSampleRateTo8kHz =-    setAudioSampleRate (Proxy :: Proxy 8000)--setAudioSampleRateTo16kHz :: (IsAudioSample x, y ~ SetAudioSampleRate x 16000)-                          => x-                          -> y-setAudioSampleRateTo16kHz =-    setAudioSampleRate (Proxy :: Proxy 16000)--setAudioSampleRateTo48kHz :: (IsAudioSample x, y ~ SetAudioSampleRate x 48000)-                          => x-                          -> y-setAudioSampleRateTo48kHz =-    setAudioSampleRate (Proxy :: Proxy 48000)--doubleAudioSampleRate :: forall a b.-                      (IsAudioSample a, b ~ SetAudioSampleRate a (GetAudioSampleRate a + GetAudioSampleRate a), KnownNat (GetAudioSampleRate a + GetAudioSampleRate a))-                      => a-                      -> b-doubleAudioSampleRate = setAudioSampleRate (Proxy :: Proxy (GetAudioSampleRate a + GetAudioSampleRate a))--instance HasChannelLayout (S16 r) where-    channelLayout _ = SingleChannel

@@ -1,41 +0,0 @@-module Data.MediaBus.Audio.Resample ( resample8to16kHz' ) where--import           Data.MediaBus.Stream-import           Data.MediaBus.Sample-import           Data.MediaBus.Audio.Raw-import           Conduit-import qualified Data.Vector.Storable         as V-import qualified Data.Vector.Storable.Mutable as M-import           Control.Monad.State.Strict-import           Control.Lens-import           Control.Parallel.Strategies  ( NFData, rdeepseq, using )--resample8to16kHz' :: (NFData s, NFData t, NFData p, NFData i, IsAudioSample sa, GetAudioSampleRate sa ~ 8000, Monad m, IsAudioSample (SetAudioSampleRate sa 16000), NFData (SetAudioSampleRate sa 16000))-                  => sa-                  -> Conduit (Stream i s t p (SampleBuffer sa)) m (Stream i s t p (SampleBuffer (SetAudioSampleRate sa 16000)))-resample8to16kHz' !sa = evalStateC sa (mapPayloadMC' resample)-  where-    resample !sb-        | sampleCount sb == 0 = return (MkSampleBuffer mempty)-        | otherwise = do-              !lastVal <- get-              let !lastVal' = V.last (sb ^. sampleVector)-              put lastVal'-              let !sb' = createSampleBufferFrom (interpolate lastVal) sb-              return sb'-      where-        interpolate !lastVal !vIn = do-            let !lenOut = 2 * lenIn-            !vOut <- M.new lenOut-            void $ lerpSamples vOut (doubleAudioSampleRate lastVal) 0-            return (vOut `using` rdeepseq)-          where-            !lenIn = V.length vIn-            lerpSamples !vOut !prev !i =-                when (i < lenIn) $ do-                    !nextHalfRate <- V.indexM vIn i-                    let !next = doubleAudioSampleRate nextHalfRate-                    let !smpl = avgSamples prev next-                    M.unsafeWrite vOut (2 * i) smpl-                    M.unsafeWrite vOut (2 * i + 1) next-                    lerpSamples vOut next (i + 1)

@@ -0,0 +1,122 @@+-- | An interface for /clocks/. Since there are many ways to calculate different+-- ideas of /time/, e.g. system time, wall clock time or stream time, a type+-- class 'Clock' is provided with the basic interface for getting the current+-- time and comparing time stamps.+module Data.MediaBus.Basics.Clock+  ( IsClock(..)+  , timeSince+  , UtcClock(..)+  , useUtcClock+  , utcClockTimeDiff+  ) where++import Control.DeepSeq+import Control.Lens+import Control.Monad.IO.Class+import Data.Default+import Data.Function (on)+import Data.Kind+import Data.MediaBus.Basics.Monotone+import Data.Proxy+import Data.Time.Calendar+import Data.Time.Clock+import Data.Word+import GHC.Generics (Generic)+import Test.QuickCheck++-- * Clocks+-- | Clocks can generate reference times, and they can convert these to tickss. Tickss are mere integrals+class ( Default (ClockTimeDiff c)+      , Ord (ClockTimeDiff c)+      , Eq (ClockTimeDiff c)+      , Num (ClockTimeDiff c)+      , Show (ClockTime c)+      , Eq (ClockTime c)+      , Show (ClockTimeDiff c)+      , LocalOrd (ClockTimeDiff c)+      ) =>+      IsClock c where+  data ClockTime c+  data ClockTimeDiff c+  type MonadClock c (m :: Type -> Type) :: Constraint+  -- | Return the current absolute time as a 'ClockTime'+  now+    :: MonadClock c m+    => m (ClockTime c)+  -- | Convert a 'ClockTime' to a 'ClockTimeDiff' by 'diffTime'ing the time+  -- with the beginning of time.+  timeAsTimeDiff :: ClockTime c -> ClockTimeDiff c+  -- | The time difference (a 'ClockTimeDiff') between two 'ClockTime's+  diffTime :: ClockTime c -> ClockTime c -> ClockTimeDiff c+  -- | Add the relative time to an absolute time to obtain a new absolute+  -- time.+  timeAddTimeDiff :: ClockTime c -> ClockTimeDiff c -> ClockTime c++-- | Return the time elapsed between since the given absolute time.+timeSince+  :: (IsClock c, MonadClock c m, Monad m)+  => ClockTime c -> m (ClockTimeDiff c)+timeSince t0 = do+  t1 <- now+  return (diffTime t1 t0)++-- * UTC System Time Clock+-- | A UTC System Time Clock+data UtcClock =+  MkUtcClock+  deriving (Generic)++instance NFData UtcClock++-- | A 'Proxy' for 'UtcClock'+useUtcClock :: Proxy UtcClock+useUtcClock = Proxy++instance IsClock UtcClock where+  newtype ClockTime UtcClock = MkUtcClockTime{_utcClockTime ::+                                            UTCTime}+                           deriving (Eq, Generic)+  newtype ClockTimeDiff+          UtcClock = MkUtcClockTimeDiff{_utcClockTimeDiff :: NominalDiffTime}+                   deriving (Ord, Eq, Num, Generic)+  type MonadClock UtcClock m = MonadIO m+  now = MkUtcClockTime <$> liftIO getCurrentTime+  timeAsTimeDiff (MkUtcClockTime ref) =+    MkUtcClockTimeDiff $ diffUTCTime ref $ UTCTime (toEnum 0) 0+  timeAddTimeDiff (MkUtcClockTime t) (MkUtcClockTimeDiff dt) =+    MkUtcClockTime (addUTCTime dt t)+  diffTime (MkUtcClockTime later) (MkUtcClockTime sooner) =+    MkUtcClockTimeDiff $ diffUTCTime later sooner++instance NFData (ClockTime UtcClock)++instance Show (ClockTime UtcClock) where+  show (MkUtcClockTime !t) = show t++instance Show (ClockTimeDiff UtcClock) where+  showsPrec d (MkUtcClockTimeDiff t) =+    showParen (d > 10) $ showString "Δt " . showsPrec 11 t++instance NFData (ClockTimeDiff UtcClock)++instance Default (ClockTimeDiff UtcClock) where+  def = MkUtcClockTimeDiff $ fromInteger def++instance Arbitrary (ClockTime UtcClock) where+  arbitrary =+    MkUtcClockTime <$>+    (UTCTime <$> (ModifiedJulianDay <$> arbitrary) <*>+     (fromInteger <$> arbitrary))++instance Arbitrary (ClockTimeDiff UtcClock) where+  arbitrary = MkUtcClockTimeDiff . fromInteger <$> arbitrary++-- | An 'Iso' for converting a 'UtcClock' 'ClockTimeDiff' from/to a 'NominalDiffTime'.+utcClockTimeDiff :: Iso' (ClockTimeDiff UtcClock) NominalDiffTime+utcClockTimeDiff = iso _utcClockTimeDiff MkUtcClockTimeDiff++instance LocalOrd (ClockTimeDiff UtcClock) where+  succeeds = succeeds `on` roundToSeconds+    where+      roundToSeconds = round . (/ 1000000000000) . _utcClockTimeDiff+      roundToSeconds :: ClockTimeDiff UtcClock -> Word64

@@ -0,0 +1,36 @@+module Data.MediaBus.Basics.Monotone+    ( LocalOrd(..)+    ) where++import           Data.Word+import           Data.Int++-- | Class of numbers that are monotone increasing (or decreasing) and have a+-- relative order, that is not necessarily transitive.+--+-- For example, for a series of 'Word8' values: @0 64 128 192 0 64 128 ...@+-- could be interpreted as a monotone series of consecutive increasing values,+-- that wrap around after 255. But note that the 'Ord' instance is not+-- sufficient to express that @0@ is __after__ @192@, since @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)++instance LocalOrd Word8++instance LocalOrd Word16++instance LocalOrd Word32++instance LocalOrd Word64++instance LocalOrd Int8++instance LocalOrd Int16++instance LocalOrd Int32++instance LocalOrd Int64++instance LocalOrd Int

@@ -0,0 +1,17 @@+-- | Value level 'Ord'er. Sometimes values are stored in e.g. 'Data.Set.Set's+-- and the default 'Ord' instance isn't what we want. In that case it would be+-- great to pass the comparison as an explicit function.+module Data.MediaBus.Basics.OrderedBy ( OrderedBy(..) ) where++-- | A wrapper around a value (to be compared) and a function to the value that+-- shall be compared against.+data OrderedBy cmp a = MkOrderedBy+  { orderedByComparableValue :: cmp+  , orderedByValue :: a+  }++instance Eq cmp => Eq (OrderedBy cmp a) where+  MkOrderedBy cmpa _ == MkOrderedBy cmpb _ = cmpa == cmpb++instance Ord cmp => Ord (OrderedBy cmp a) where+  MkOrderedBy cmpa _ `compare` MkOrderedBy cmpb _ = cmpa `compare` cmpb

@@ -0,0 +1,86 @@+-- | This modules contains the 'SeqNum' newtype wrapper to indicate that a type+-- is a sequence number.+module Data.MediaBus.Basics.Sequence+    ( SeqNum(..)+    , fromSeqNum+    , type SeqNum8+    , type SeqNum16+    , type SeqNum32+    , type SeqNum64+    , HasSeqNum(..)+    ) where++import           Test.QuickCheck            ( Arbitrary(..) )+import           Data.MediaBus.Basics.Monotone+import           Data.MediaBus.Basics.Series+import           Control.Lens+import           Data.Default+import           Text.Printf+import           GHC.Generics               ( Generic )+import           Control.DeepSeq+import           System.Random+import           Data.Word++-- | The newtype wrapper that indicates that something is a sequence number.+newtype SeqNum s = MkSeqNum { _fromSeqNum :: s }+    deriving (Num, Eq, Bounded, Enum, LocalOrd, Arbitrary, Default, Generic, Random)++instance NFData s =>+         NFData (SeqNum s)++instance HasSeqNum (SeqNum s) where+    type GetSeqNum (SeqNum s) = s+    type SetSeqNum (SeqNum s) s' = SeqNum s'+    seqNum = fromSeqNum++instance Show s =>+         Show (SeqNum s) where+    show (MkSeqNum s) = printf "SEQNUM: %10s" (show s)++instance (Eq a, LocalOrd a) =>+         Ord (SeqNum a) where+    compare !x !y+        | x == y = EQ+        | x `succeeds` y = GT+        | otherwise = LT++deriving instance (Real a, Num a, Eq a, LocalOrd a) => Real+         (SeqNum a)++deriving instance (Integral a, Enum a, Real a, Eq a, LocalOrd a) =>+         Integral (SeqNum a)++-- | An 'Iso' between a 'SeqNum' and its' value.+fromSeqNum :: Iso (SeqNum a) (SeqNum b) a b+fromSeqNum = iso _fromSeqNum MkSeqNum++-- * Type aliases++-- | A 'Word8' based sequence number.+type SeqNum8 = SeqNum Word8++-- | A 'Word16' based sequence number.+type SeqNum16 = SeqNum Word16++-- | A 'Word32' based sequence number.+type SeqNum32 = SeqNum Word32++-- | A 'Word64' based sequence number.+type SeqNum64 = SeqNum Word64++-- * Lens type classes++-- | A class for types providing a lens to a sequence number.+class SetSeqNum t (GetSeqNum t) ~ t =>+      HasSeqNum t where+    type GetSeqNum t+    type SetSeqNum t s+    -- | A lens for the sequence number contained in @t@+    seqNum :: Lens t (SetSeqNum t s) (GetSeqNum t) s++instance (HasSeqNum a, HasSeqNum b, GetSeqNum a ~ GetSeqNum b) =>+         HasSeqNum (Series a b) where+    type GetSeqNum (Series a b) = GetSeqNum a+    type SetSeqNum (Series a b) t = Series (SetSeqNum a t) (SetSeqNum b t)+    seqNum f (Start !a) = Start <$> seqNum f a+    seqNum f (Next !b) = Next <$> seqNum f b

@@ -0,0 +1,110 @@+-- | A series with a start value and consecutive next vaules.+module Data.MediaBus.Basics.Series+  ( Series(..)+  , _Next+  , _Start+  , type Series'+  , AsSeries(..)+  , AsSeriesStart(..)+  , AsSeriesNext(..)+  ) where++import Control.DeepSeq+import Control.Lens+import Data.Bifunctor+import GHC.Generics (Generic)+import Test.QuickCheck++-- | A value of a series is either the 'Start' of that series or the 'Next'+-- value in a started series.+data Series a b+  = Next { _seriesValue :: !b}+  | Start { _seriesStartValue :: !a}+  deriving (Eq, Generic)++makePrisms ''Series++-- | A simple version of a series, where the 'Start' value has the same type as+-- the 'Next' value.+type Series' a = Series a a++instance (NFData a, NFData b) =>+         NFData (Series a b)++instance (Show a, Show b) =>+         Show (Series a b) where+  showsPrec d (Start !x) =+    showParen (d > 10) $ showString "START: " . showsPrec 11 x+  showsPrec d (Next !x) = showsPrec d x++instance (Ord a, Ord b) =>+         Ord (Series a b) where+  compare (Next !l) (Next !r) = compare l r+  compare _ _ = EQ++instance (Arbitrary a, Arbitrary b) =>+         Arbitrary (Series a b) where+  arbitrary = do+    isNext <- choose (0.0, 1.0)+    if isNext < (0.95 :: Double)+      then Next <$> arbitrary+      else Start <$> arbitrary++instance Functor (Series a) where+  fmap = over _Next++instance Bifunctor Series where+  first = over _Start+  second = over _Next++-- | A class of types with any kind /start/ and /next/ semantics, not+-- necessarily provided by 'Series'.+class AsSeries s a b | s -> a, s -> b where+  -- | A simple 'Prim' to extract a /start/ value+  seriesStart' :: Prism' s a+  -- | A simple 'Prim' to extract a /next/ value+  seriesNext' :: Prism' s b++instance AsSeries (Either a b) a b where+  seriesStart' = _Left+  seriesNext' = _Right++instance AsSeries (Series a b) a b where+  seriesNext' = _Next+  seriesStart' = _Start++-- | A type class for types that might have a /start/ value.+class (SetSeriesStart s (GetSeriesStart s) ~ s) =>+      AsSeriesStart s where+  type GetSeriesStart s+  type SetSeriesStart s t+  -- | A 'Prism' for /start/ values+  seriesStart :: Prism s (SetSeriesStart s n) (GetSeriesStart s) n++instance AsSeriesStart (Either a b) where+  type GetSeriesStart (Either a b) = a+  type SetSeriesStart (Either a b) n = (Either n b)+  seriesStart = _Left++instance AsSeriesStart (Series a b) where+  type GetSeriesStart (Series a b) = a+  type SetSeriesStart (Series a b) n = (Series n b)+  seriesStart = _Start++-- | A type class for types that might have a /next/ value.+class (SetSeriesNext s (GetSeriesNext s) ~ s) =>+      AsSeriesNext s where+  type GetSeriesNext s+  type SetSeriesNext s t+  -- | A 'Prism' for the /next/ values+  seriesNext :: Prism s (SetSeriesNext s n) (GetSeriesNext s) n++instance AsSeriesNext (Either a b) where+  type GetSeriesNext (Either a b) = b+  type SetSeriesNext (Either a b) n = (Either a n)+  seriesNext = _Right++instance AsSeriesNext (Series a b) where+  type GetSeriesNext (Series a b) = b+  type SetSeriesNext (Series a b) n = (Series a n)+  seriesNext = _Next

@@ -0,0 +1,58 @@+-- | This module contains the 'SourceId' wrapper type, that indicate that+-- something is identifies a single source of media. This could be an RTP SSRC+-- or the IP/Port pair of a network source. The defining characteristic of a+-- 'SourceId' is that every thing that has a certain source id stems from **the+-- same media source**, e.g. the same microphone, audio file, synthesizer,...+module Data.MediaBus.Basics.SourceId+    ( SourceId(..)+    , sourceIdValue+    , type SrcId32+    , type SrcId64+    , HasSourceId(..)+    , EachSourceId(..)+    ) where++import           Control.Lens+import           Test.QuickCheck+import           Data.Default+import           GHC.Generics    ( Generic )+import           Control.DeepSeq+import           Data.Word++-- | Things that can be uniquely identified by a looking at a (much simpler)+-- representation, the 'identity'.+newtype SourceId i = MkSourceId { _sourceIdValue :: i }+    deriving (Eq, Arbitrary, Default, Ord, Generic)+++-- | An 'Iso' for the value of a 'SourceId'+sourceIdValue :: Iso (SourceId a) (SourceId b) a b+sourceIdValue = iso _sourceIdValue MkSourceId++-- | A short alias for 'SourceId' with a 'Word32' value+type SrcId32 = SourceId Word32++-- | A short alias for 'SourceId' with a 'Word64' value+type SrcId64 = SourceId Word64++instance (NFData i) =>+         NFData (SourceId i)++instance Show i =>+         Show (SourceId i) where+    show (MkSourceId x) = "SOURCE-ID: " ++ show x++-- | Type class for a lens over the contained source id+class HasSourceId s t where+    type SourceIdFrom s+    type SourceIdTo t+    -- | A lens for the 'SourceId'+    sourceId :: Lens s t (SourceIdFrom s) (SourceIdTo t)++-- | Type class with a 'Traversal' for types that may or may not contain anctual+-- source id.+class EachSourceId s t where+    type SourceIdsFrom s+    type SourceIdsTo t+    -- | A 'Traversal' for the 'SourceId'+    eachSourceId :: Traversal s t (SourceIdsFrom s) (SourceIdsTo t)

@@ -0,0 +1,410 @@+-- | This module contains the 'Ticks' time unit as well as the corresponding+-- known-at-compile-time 'StaticTicks' time unit. The time stamps are given as+-- quotient of a 'Rate' that indicates the number of 'Ticks' per second.+module Data.MediaBus.Basics.Ticks+  ( Rate(..)+  , type Hz+  , type OnePerPicoSecond+  , KnownRate(..)+  , HasRate(..)+  , CoerceRate(..)+  , getRate+  , getRateProxy+  , RateProxy(..)+  , type PeriodDuration+  , getPeriodDuration+  , coerceRateTo8kHz+  , coerceRateTo16kHz+  , coerceRateTo48kHz+  , coerceToDoubleRate+  , Ticks(..)+  , CanBeTicks+  , type PicoSeconds+  , type Ticks32+  , mkTicks32+  , type Ticks64+  , mkTicks64+  , type Ticks32At8000+  , mkTicks32At8000+  , type Ticks32At16000+  , mkTicks32At16000+  , type Ticks32At48000+  , mkTicks32At48000+  , type Ticks64At8000+  , mkTicks64At8000+  , type Ticks64At16000+  , mkTicks64At16000+  , type Ticks64At48000+  , mkTicks64At48000+  , nominalDiffTime+  , convertTicks+  , StaticTicks(..)+  , KnownStaticTicks(..)+  , type StaticTicksRate+  , type StaticTicksTicks+  , HasDuration(..)+  , HasTimestamp(..)+  , HasStaticDuration(..)+  , getStaticDurationTicks+  , getStaticDuration+  , toStaticDurationProxy+  , ticksFromStaticDuration+  , (:/)+  ) where++import Control.DeepSeq+import Control.Lens+import Data.Default+import Data.Kind+import Data.MediaBus.Basics.Monotone+import Data.MediaBus.Basics.Series+import Data.Proxy+import Data.Time.Clock+import Data.Word+import GHC.Generics (Generic)+import GHC.TypeLits+import System.Random+import Test.QuickCheck+import Text.Printf++-- * Time data types+-- ** A basic Time Unit+-- | The known at ompile time, time unit in units per second.+newtype Rate =+  Hertz Nat++-- | A more beautiful operator for 'Hertz'+type Hz r = 'Hertz r++-- | Analogous to 'KnownNat' this (kind-)class is for 'StaticTicks' with a runtime+-- 'Ticks' value.+class KnownRate (s :: Rate) where+  -- | Return the runtime rate value in Hertz+  rateVal :: proxy s -> Integer+  -- | Return the compile time rate value in Hertz+  type RateVal s :: Nat++instance (KnownNat r) =>+         KnownRate ('Hertz r) where+  rateVal _ = natVal (Proxy :: Proxy r)+  type RateVal ('Hertz r) = r++-- | A proxy type for 'Rate's useful to prevent orphan instances, is seen in+-- the 'Show' instance for 'RateProxy'. If the instance were defined as+-- @instance KnownRate r => Show (proxy r) where ... @ it would be an orphan+-- instance.+data RateProxy :: Rate -> Type where+        MkRateProxy :: RateProxy rate+        ConvertRateProxy :: proxy rate -> RateProxy rate++instance KnownRate r =>+         Show (RateProxy r) where+  showsPrec p _ =+    showParen (p > 10) (shows (rateVal (Proxy :: Proxy r)) . showString " Hz")++-- | Return the 'StaticTicks' representing the shortest representable duration+-- of something sampled at a 'Rate'+type PeriodDuration i = 1 :/ GetRate i++-- | The maximum representable frequency is @10e12 1/s@ which corresponds to+--   the resolution of 'NominalDiffTime', i.e. 1 pico second.+type OnePerPicoSecond = Hz 1000000000000++-- ** Types that have a /known/ 'Rate'+-- | Types with a known 'Rate', e.g. audio media has a sample rate.+class (KnownRate (GetRate i), SetRate i (GetRate i) ~ i) =>+      HasRate i where+  -- | Set the static sample rate of the media+  type SetRate i (r :: Rate)+  -- | The static sample rate of the media+  type GetRate i :: Rate++-- | Types which contain a rate, but are agnostic of it. The counter example would be+-- if the rate was a type index of a data family.+class (HasRate i, GetRate i ~ ri, SetRate i rj ~ j, KnownRate rj) =>+      CoerceRate i j ri rj+    where+  -- | Change the static sample rate, without e.g. resampling+  coerceRate :: proxy rj -> i -> SetRate i rj++-- | Return the 'Rate' as an 'Integer' from a proxy for an instance of 'HasRate'+getRate+  :: forall i proxy.+     HasRate i+  => proxy i -> Integer+getRate = rateVal . getRateProxy++-- | Return a 'Proxy' for the 'GetRate' from a proxy for an instance of 'HasRate'+getRateProxy+  :: HasRate i+  => proxy i -> RateProxy (GetRate i)+getRateProxy _ = MkRateProxy++-- | Return the reciprocal of the sample rate, i.e. the duration that one sample spans+getPeriodDuration+  :: forall i proxy.+     HasRate i+  => proxy i -> NominalDiffTime+getPeriodDuration _ = 1 / fromInteger (rateVal (Proxy :: Proxy (GetRate i)))++-- | Utility around 'coerceRate' to set the sample rate to 8000 Hz.+coerceRateTo8kHz+  :: CoerceRate x y rx (Hz 8000)+  => x -> y+coerceRateTo8kHz = coerceRate (Proxy :: Proxy (Hz 8000))++-- | Utility around 'coerceRate' to set the sample rate to 16000 Hz.+coerceRateTo16kHz+  :: CoerceRate x y rx (Hz 16000)+  => x -> y+coerceRateTo16kHz = coerceRate (Proxy :: Proxy (Hz 16000))++-- | Utility around 'coerceRate' to set the sample rate to 48000 Hz.+coerceRateTo48kHz+  :: CoerceRate x y rx (Hz 48000)+  => x -> y+coerceRateTo48kHz = coerceRate (Proxy :: Proxy (Hz 48000))++-- | Utility around 'coerceRate' to double the sample rate.+coerceToDoubleRate+  :: forall r s x y.+     ( CoerceRate x y r (Hz (s + s))+     , KnownRate r+     , RateVal r ~ s+     , KnownNat (s + s)+     )+  => x -> y+coerceToDoubleRate = coerceRate (Proxy :: Proxy (Hz (s + s)))++-- ** Arbitrary resolution (aka rate) integral time+-- | An integral time unit such that (time_in_seconds = _ticks * 1/rate)+newtype Ticks (rate :: Rate) w = MkTicks+  { _ticks :: w+  } deriving ( Eq+             , Real+             , Integral+             , Enum+             , LocalOrd+             , Num+             , Arbitrary+             , Default+             , Generic+             , Random+             )++-- | The constraint on the type parameters of 'Ticks+type CanBeTicks (r :: Rate) w = (KnownRate r, Integral w)++-- | The highest resolution 'Ticks' possible, such that it can still be+--   converted to 'NominalDiffTime'+type PicoSeconds = Ticks OnePerPicoSecond Integer++-- ** Smart constructors for 'Ticks'+-- | Alias for 'Ticks' based on a 'Word32' tick count.+type Ticks32 r = Ticks r Word32++-- | Create a 'Ticks32' from a 'Rate' given via a proxy and the number of ticks.+mkTicks32+  :: KnownRate r+  => proxy r -> Word32 -> Ticks32 r+mkTicks32 _ = MkTicks++-- | Alias for 'Ticks' based on a 'Word64' tick count.+type Ticks64 r = Ticks r Word64++-- | Create a 'Ticks64' from a 'Rate' given via a proxy and the number of ticks.+mkTicks64+  :: KnownRate r+  => proxy r -> Word64 -> Ticks64 r+mkTicks64 _ = MkTicks++-- | Alias for 'Ticks' based on a 'Word32' tick count with a rate of 8000 ticks per second.+type Ticks32At8000 = Ticks32 (Hz 8000)++-- | Create a 'Ticks32At8000' from a tick count.+mkTicks32At8000 :: Word32 -> Ticks32At8000+mkTicks32At8000 = MkTicks++-- | Alias for 'Ticks' based on a 'Word32' tick count with a rate of 16000 ticks per second.+type Ticks32At16000 = Ticks32 (Hz 16000)++-- | Create a 'Ticks32At16000 from a tick count.+mkTicks32At16000 :: Word32 -> Ticks32At16000+mkTicks32At16000 = MkTicks++-- | Alias for 'Ticks' based on a 'Word32' tick count with a rate of 48000 ticks per second.+type Ticks32At48000 = Ticks32 (Hz 48000)++-- | Create a 'Ticks32At48000 from a tick count.+mkTicks32At48000 :: Word32 -> Ticks32At48000+mkTicks32At48000 = MkTicks++-- | Alias for 'Ticks' based on a 'Word64' tick count with a rate of 8000 ticks per second.+type Ticks64At8000 = Ticks64 (Hz 8000)++-- | Create a 'Ticks64At8000 from a tick count.+mkTicks64At8000 :: Word64 -> Ticks64At8000+mkTicks64At8000 = MkTicks++-- | Alias for 'Ticks' based on a 'Word64' tick count with a rate of 16000 ticks per second.+type Ticks64At16000 = Ticks64 (Hz 16000)++-- | Create a 'Ticks64At16000 from a tick count.+mkTicks64At16000 :: Word64 -> Ticks64At16000+mkTicks64At16000 = MkTicks++-- | Alias for 'Ticks' based on a 'Word64' tick count with a rate of 48000 ticks per second.+type Ticks64At48000 = Ticks64 (Hz 48000)++-- | Create a 'Ticks64At48000 from a tick count.+mkTicks64At48000 :: Word64 -> Ticks64At48000+mkTicks64At48000 = MkTicks++instance NFData w =>+         NFData (Ticks rate w)++-- | Transform a 'Tick' value to another 'Tick' value.+convertTicks+  :: (CanBeTicks r w, CanBeTicks r' w')+  => Ticks r w -> Ticks r' w'+convertTicks = view (from nominalDiffTime) . view nominalDiffTime++-- | A function (an 'Iso') that converts back-and-forth between 'Tick's and+--  'NominalDiffTime's+nominalDiffTime+  :: forall r w.+     (CanBeTicks r w)+  => Iso' (Ticks r w) NominalDiffTime+nominalDiffTime = iso (toNDT . _ticks) (MkTicks . fromNDT)+  where+    toNDT = (/ rate) . fromIntegral+    fromNDT = round . (* rate)+    rate = fromInteger $ rateVal (Proxy :: Proxy r)++instance (CanBeTicks r w, Show w) =>+         Show (Ticks r w) where+  show tix@(MkTicks x) =+    printf+      "%10s (%10d @ %10d Hz)"+      (show (view nominalDiffTime tix))+      (toInteger x)+      (rateVal (Proxy :: Proxy r))++instance (Eq w, LocalOrd w) =>+         Ord (Ticks rate w) where+  (<=) = flip succeeds++-- ** Compile-Time Known Time values+-- | Time unit for durations known at compile time.+data StaticTicks where+        (:/:) :: Nat -> Rate -> StaticTicks++-- | Convenient wrapper around 'MkStaticTicks' and+--   'MkRate' to create a promoted 'StaticTicks'.+type ticks :/ rate = ticks ':/: rate++-- | Return the 'Rate' value of a promoted 'StaticTicks'.+type family StaticTicksRate (s :: StaticTicks) :: Rate where+  StaticTicksRate (t :/ r) = r++-- | Return the ticks value of a promoted 'StaticTicks'.+type family StaticTicksTicks (s :: StaticTicks) :: Nat where+  StaticTicksTicks (t :/ r) = t++-- | Analog to 'KnownNat' this (kind-)class is for 'StaticTicks' with a runtime+-- 'Ticks' value.+class KnownStaticTicks (s :: StaticTicks) where+  staticTicksVal+    :: KnownRate r+    => proxy s -> Ticks r Integer++instance (KnownNat d, KnownRate r) =>+         KnownStaticTicks (d :/ r) where+  staticTicksVal _ =+    convertTicks (MkTicks (natVal (Proxy :: Proxy d)) :: Ticks r Integer)++-- * Types with a duration+-- ** Runtime duration values+-- | Types with a duration (e.g. audio samples).+class HasDuration a where+  getDuration :: a -> NominalDiffTime+  getDuration !x = from nominalDiffTime # (getDurationTicks x :: PicoSeconds)+  getDurationTicks+    :: (CanBeTicks r i)+    => a -> Ticks r i+  getDurationTicks !x = nominalDiffTime # getDuration x++instance HasDuration a =>+         HasDuration (Maybe a) where+  getDuration Nothing = 0+  getDuration (Just !a) = getDuration a+  getDurationTicks Nothing = 0+  getDurationTicks (Just !a) = getDurationTicks a++-- | Types that contain a 'Timestamp'+class SetTimestamp t (GetTimestamp t) ~ t =>+      HasTimestamp t where+  type GetTimestamp t+  type SetTimestamp t s+  timestamp :: Lens t (SetTimestamp t s) (GetTimestamp t) s+  timestamp' :: Lens' t (GetTimestamp t)+  timestamp' = timestamp++-- ** Known at compile time durations+-- *** Static ticks TODO rename static -> known+-- | Types that have a duration known at compoile time.+class ( KnownStaticTicks (GetStaticDuration s)+      , SetStaticDuration s (GetStaticDuration s) ~ s+      ) =>+      HasStaticDuration (s :: k) where+  type SetStaticDuration s (pt :: StaticTicks) :: k+  type SetStaticDuration s (pt :: StaticTicks) = s+  type GetStaticDuration s :: StaticTicks++instance (KnownRate r, KnownNat t) =>+         HasStaticDuration (t :/ r) where+  type SetStaticDuration (t :/ r) (t' :/ r') = t' :/ r'+  type GetStaticDuration (t :/ r) = t :/ r++-- | Create a 'Proxy' for the 'StaticTicks' type associated with 's', this is+-- basically the analogon to the 'getDuration' method - just for types with a+-- duration known at compile time.+toStaticDurationProxy+  :: (HasStaticDuration s)+  => proxy s -> Proxy (GetStaticDuration s)+toStaticDurationProxy _ = Proxy++-- | Convert the 'StaticDuration' that some type has to the number of seconds.+getStaticDuration+  :: forall proxy s.+     HasStaticDuration s+  => proxy s -> NominalDiffTime+getStaticDuration px =+  from nominalDiffTime #+  (staticTicksVal (toStaticDurationProxy px) :: PicoSeconds)++-- | Convert the 'StaticDuration' that some type has to any 'Ticks'.+getStaticDurationTicks+  :: forall proxy s r t i.+     ( CanBeTicks r i+     , KnownNat t+     , HasStaticDuration s+     , GetStaticDuration s ~ (t :/ r)+     )+  => proxy s -> Ticks r i+getStaticDurationTicks px = ticksFromStaticDuration (toStaticDurationProxy px)++ticksFromStaticDuration+  :: forall proxy rate ticks i.+     (CanBeTicks rate i, KnownNat ticks)+  => proxy (ticks :/ rate) -> Ticks rate i+ticksFromStaticDuration _ =+  MkTicks (fromIntegral (natVal (Proxy :: Proxy ticks)))+++instance (HasTimestamp a, HasTimestamp b, GetTimestamp a ~ GetTimestamp b) =>+         HasTimestamp (Series a b) where+  type GetTimestamp (Series a b) = GetTimestamp a+  type SetTimestamp (Series a b) t = Series (SetTimestamp a t) (SetTimestamp b t)+  timestamp f (Start a) = Start <$> timestamp f a+  timestamp f (Next b) = Next <$> timestamp f b

@@ -1,24 +0,0 @@-module Data.MediaBus.BlankMedia-    ( CanGenerateBlankMedia(..)-    , CanBeBlank(..)-    ) where--import           Data.MediaBus.Ticks-import           Data.MediaBus.Segment-import           Data.Time.Clock-import           GHC.TypeLits-import           Control.Lens-import           Data.Proxy--class CanGenerateBlankMedia a where-    blankFor :: NominalDiffTime -> a-    blankFor dt = blankForTicks (nominalDiffTime # dt :: Ticks 1000000000000 Integer)-    blankForTicks :: (Integral i, KnownNat r) => Ticks r i -> a-    blankForTicks ticks = blankFor (from nominalDiffTime # ticks)--class CanBeBlank a where-    blank :: a--instance (HasStaticDuration d, CanGenerateBlankMedia a) =>-         CanBeBlank (Segment d a) where-    blank = MkSegment (blankFor (getStaticDuration (Proxy :: Proxy d)))

@@ -1,92 +0,0 @@-module Data.MediaBus.Clock-    ( IsClock(..)-    , timeSince-    , UtcClock(..)-    , useUtcClock-    , _utcClockTimeDiff-    , _utcClockTime-    , utcClockTimeDiff-    ) where--import           Conduit-import           Control.Lens-import           Data.Default-import           Data.Function                   ( on )-import           Data.Kind-import           Data.MediaBus.Monotone-import           Data.Proxy-import           Data.Time.Calendar-import           Data.Time.Clock-import           Data.Word-import           Test.QuickCheck-import           GHC.Generics                    ( Generic )-import           Control.DeepSeq---- | Clocks can generate reference times, and they can convert these to tickss. Tickss are mere integrals-class (Default (ClockTimeDiff c), Ord (ClockTimeDiff c), Eq (ClockTimeDiff c), Num (ClockTimeDiff c), Show (ClockTime c), Eq (ClockTime c), Show (ClockTimeDiff c), LocalOrd (ClockTimeDiff c)) =>-      IsClock c where-    data ClockTime c-    data ClockTimeDiff c-    type MonadClock c (m :: Type -> Type) :: Constraint-    now :: MonadClock c m => m (ClockTime c)-    timeAsTimeDiff :: ClockTime c -> ClockTimeDiff c-    diffTime :: ClockTime c -> ClockTime c -> ClockTimeDiff c-    timeAddTimeDiff :: ClockTime c -> ClockTimeDiff c -> ClockTime c--timeSince :: (IsClock c, MonadClock c m, Monad m) => ClockTime c -> m (ClockTimeDiff c)-timeSince t0 = do-    t1 <- now-    return (diffTime t1 t0)--data UtcClock = MkUtcClock-    deriving Generic--instance NFData UtcClock--useUtcClock :: Proxy UtcClock-useUtcClock = Proxy--instance IsClock UtcClock where-    newtype ClockTime UtcClock = MkUtcClockTime{_utcClockTime :: UTCTime}-                      deriving (Eq, Generic)-    newtype ClockTimeDiff UtcClock = MkUtcClockTimeDiff{_utcClockTimeDiff ::-                                          NominalDiffTime}-                          deriving (Ord, Eq, Num, Generic)-    type MonadClock UtcClock m = MonadIO m-    now = MkUtcClockTime <$> liftIO getCurrentTime-    timeAsTimeDiff (MkUtcClockTime ref) =-        MkUtcClockTimeDiff $ diffUTCTime ref $ UTCTime (toEnum 0) 0-    timeAddTimeDiff (MkUtcClockTime t) (MkUtcClockTimeDiff dt) =-        MkUtcClockTime (addUTCTime dt t)-    diffTime (MkUtcClockTime later) (MkUtcClockTime sooner) =-        MkUtcClockTimeDiff $ diffUTCTime later sooner--instance NFData (ClockTime UtcClock)--instance Show (ClockTime UtcClock) where-    show (MkUtcClockTime t) = show t--instance Show (ClockTimeDiff UtcClock) where-    show (MkUtcClockTimeDiff t) =-        "dt:" ++ show t--instance NFData (ClockTimeDiff UtcClock)--instance Default (ClockTimeDiff UtcClock) where-    def = MkUtcClockTimeDiff $ fromInteger def--instance Arbitrary (ClockTime UtcClock) where-    arbitrary = MkUtcClockTime <$> (UTCTime <$> (ModifiedJulianDay <$> arbitrary)-                                       <*> (fromInteger <$> arbitrary))--instance Arbitrary (ClockTimeDiff UtcClock) where-    arbitrary = MkUtcClockTimeDiff . fromInteger <$> arbitrary--utcClockTimeDiff :: Lens' (ClockTimeDiff UtcClock) NominalDiffTime-utcClockTimeDiff = lens _utcClockTimeDiff (const MkUtcClockTimeDiff)--instance LocalOrd (ClockTimeDiff UtcClock) where-    succeeds = succeeds `on` roundToSeconds-      where-        roundToSeconds = round . (/ 1000000000000) . _utcClockTimeDiff-        roundToSeconds :: ClockTimeDiff UtcClock -> Word64

@@ -1,59 +0,0 @@-module Data.MediaBus.Conduit-    ( annotateTypeC-    , annotateTypeCIn-    , annotateTypeCOut-    , annotateTypeSink-    , annotateTypeSource-    , exitAfterC-    , traceShowC-    , traceShowSink-    ) where--import           Conduit-import           Data.Conduit.List-import           Control.Monad.State.Strict as State-import           Debug.Trace-import           System.Random--annotateTypeC :: proxy a -> Conduit a m a -> Conduit a m a-annotateTypeC _ = id--annotateTypeCIn :: proxy a -> Conduit a m b -> Conduit a m b-annotateTypeCIn _ = id--annotateTypeCOut :: proxy b -> Conduit a m b -> Conduit a m b-annotateTypeCOut _ = id--annotateTypeSource :: proxy a -> Source m a -> Source m a-annotateTypeSource _ = id--annotateTypeSink :: proxy a -> Sink a m r -> Sink a m r-annotateTypeSink _ = id--exitAfterC :: Monad m => Int -> Conduit a m a-exitAfterC 0 = return ()-exitAfterC n = await >>= maybe (return ()) (yield >=> const (exitAfterC (n - 1)))--traceShowC :: (Show a, Monad m) => Double -> String -> Conduit a m a-traceShowC probability msg =-    evalStateC (mkStdGen 100, 0 :: Integer) $-        awaitForever $-        \x -> do-            (g, omitted) <- State.get-            let (p, g') = randomR (0, 1) g-            if p < probability-                then do-                    let omittedmsg = if omitted == 0-                                     then ""-                                     else " *** " ++-                                         show omitted ++-                                         " messages omitted"-                    traceM ((if null msg then "" else msg ++ ": ") ++ show x ++-                                omittedmsg)-                    State.put (g', 0)-                else State.put (g', omitted + 1)-            yield x--traceShowSink :: (Show a, Monad m) => Double -> String -> Consumer a m [a]-traceShowSink probability msg =-    traceShowC probability msg .| consume

@@ -0,0 +1,157 @@+-- | Asynchronous execution of conduits. This module contains a set of functions+-- to concurrently execute 'Stream' processing conduits and couple them using+-- 'TBQueue's.+module Data.MediaBus.Conduit.Async+  ( withAsyncPolledSource+  , FrameContentQ()+  , mkFrameContentQ+  , frameContentQSink+  , frameContentQSource+  ) where++import Conduit+import Control.Concurrent (threadDelay)+import Control.Concurrent.Async.Lifted+import Control.Concurrent.STM+import Control.Exception (evaluate)+import Control.Lens+import Control.Monad.State+import Control.Parallel.Strategies (NFData, rdeepseq, withStrategy)+import Data.Default+import Data.MediaBus.Basics.Clock+import Data.MediaBus.Basics.Ticks+import Data.MediaBus.Media.Discontinous+import Data.MediaBus.Media.Stream+import Data.MediaBus.Conduit.Stream+import Data.Proxy+import Data.Time.Clock+import Debug.Trace+import System.Random+import Text.Printf++data PollFrameContentSourceSt s t = MkPollFrameContentSourceSt+  { _ppSeqNum :: !s+  , _ppTicks :: !t+  }++makeLenses ''PollFrameContentSourceSt++-- | Asynchronously run a 'Source' connected to a 'FrameContentQ' and create a+-- new source that consumes the queue by polling periodically from that queue,+-- generating a 'Discontinous' output.+withAsyncPolledSource+  :: ( MonadResource m+     , MonadBaseControl IO m+     , KnownRate r+     , Integral t+     , Integral s+     , Default p+     , HasStaticDuration c+     , HasDuration c+     , NFData c+     , NFData p+     , NFData s+     , NFData t+     , Random i+     , Random t+     , Random s+     , Show c+     )+  => Int+  -> Source m (Stream i s (Ticks r t) p c)+  -> ((Async (), Source m (Stream i s (Ticks r t) p (Discontinous c))) -> m o)+  -> m o+withAsyncPolledSource !frameQueueLen !src !f = do+  !pq <- mkFrameContentQ frameQueueLen+  withAsync+    (runConduit (src .| frameContentQSink pq))+    (\a -> f (void a, frameContentQSource pq))++-- | A queue for 'frameContent' to decouple concurrent conduits carrying+-- 'Stream's. Under the hood a 'TBQueue' is used. A queue also knows it's+-- default segment duration and preferred polling interval.+data FrameContentQ a = MkFrameContentQ+  { _frameContentQSegmentDuration :: !NominalDiffTime+  , _frameContentQPollInterval :: !NominalDiffTime+  , _frameContentQRing :: !(TBQueue a)+  }++-- | Create a new 'FrameContentQ' with an upper bound on the queue length.+mkFrameContentQ+  :: forall m a.+     (HasStaticDuration a, MonadBaseControl IO m)+  => Int -> m (FrameContentQ a)+mkFrameContentQ qlen =+  MkFrameContentQ segmentDuration (fromIntegral qlen * 0.5 * segmentDuration) <$>+  liftBase (newTBQueueIO qlen)+  where+    segmentDuration = getStaticDuration (Proxy :: Proxy a)++-- | Consume the 'frameContent's of a 'Stream' and write them into a+-- 'FrameContentQ'. When the queue is full, **drop the oldest element** and push+-- in the new element, anyway.+frameContentQSink+  :: (NFData a, MonadBaseControl IO m, Show a)+  => FrameContentQ a -> Sink (Stream i s t p a) m ()+frameContentQSink (MkFrameContentQ _ _ !ringRef) = awaitForever go+  where+    go !x = do+      maybe (return ()) pushInRing (x ^? eachFrameContent)+      return ()+      where+        pushInRing !buf' =+          liftBase $ do+            !buf <- evaluate $ withStrategy rdeepseq buf'+            atomically $ do+              isFull <- isFullTBQueue ringRef+              when isFull (void $ readTBQueue ringRef)+              writeTBQueue ringRef buf++-- | Periodically poll a 'FrameContentQ' and yield the content as frames with+-- newly generated timestamp and sequence number values.+frameContentQSource+  :: ( Random i+     , NFData c+     , NFData p+     , Default p+     , HasStaticDuration c+     , HasDuration c+     , MonadBaseControl IO m+     , KnownRate r+     , Integral t+     , Integral s+     , NFData t+     , NFData s+     )+  => FrameContentQ c -> Source m (Stream i s (Ticks r t) p (Discontinous c))+frameContentQSource (MkFrameContentQ pTime pollIntervall ringRef) =+  evalStateC (MkPollFrameContentSourceSt 0 0) $ do+    yieldStart+    go False+  where+    go wasMissing = do+      res <- liftBase $ race (atomically $ readTBQueue ringRef) sleep+      case res of+        Left buf -> yieldNextBuffer (Got buf) >> go False+        Right dt -> yieldMissing dt wasMissing >> go True+    sleep =+      liftBase+        (do !(t0 :: ClockTime UtcClock) <- now+            threadDelay (_ticks pollIntervallMicros)+            !t1 <- now+            return (diffTime t1 t0 ^. utcClockTimeDiff))+    yieldMissing !dt !wasMissing = do+      unless wasMissing (traceM (printf "*** UNDERFLOW: Missing %s" (show dt))) -- TODO replace by proper logging+      replicateM_ (floor (dt / pTime)) (yieldNextBuffer Missing)+    yieldStart =+      (MkFrameCtx <$> liftBase randomIO <*> use ppTicks <*> use ppSeqNum <*>+       pure def) >>=+      yieldStartFrameCtx+    pollIntervallMicros :: Ticks (Hz 1000000) Int+    pollIntervallMicros = nominalDiffTime # pollIntervall+    yieldNextBuffer !buf = do+      let !bufferDuration = nominalDiffTime # getDuration buf+      !ts <- ppTicks <<+= bufferDuration+      !sn <- ppSeqNum <<+= 1+      frm <- liftBase (evaluate (withStrategy rdeepseq $ MkFrame ts sn buf))+      yieldNextFrame frm

@@ -0,0 +1,26 @@+-- | Conduits for converting 'ALaw' 'Stream's to 'S16' streams and vice versa.+module Data.MediaBus.Conduit.Audio.Raw.Alaw+  ( alawToS16+  , s16ToAlaw+  ) where++import Control.Lens+import Control.DeepSeq (NFData)+import Data.Conduit+import Data.MediaBus.Media.Audio.Raw.Alaw+import Data.MediaBus.Media.Audio.Raw.Signed16bit+import Data.MediaBus.Media.Channels+import Data.MediaBus.Media.Stream+import Data.MediaBus.Conduit.Stream++-- | Convert from 'ALaw' to 'S16'+alawToS16+  :: (NFData cIn, NFData cOut, Monad m, EachChannelL cIn cOut ALaw S16)+  => Conduit (Stream i s t p cIn) m (Stream i s t p cOut)+alawToS16 = mapFrameContentC' (over eachChannel decodeALawSample)++-- | Convert from 'S16' to 'ALaw'+s16ToAlaw+  :: (NFData cIn, NFData cOut, Monad m, EachChannelL cIn cOut S16 ALaw)+  => Conduit (Stream i s t p cIn) m (Stream i s t p cOut)+s16ToAlaw = mapFrameContentC' (over eachChannel encodeALawSample)

@@ -0,0 +1,56 @@+-- | A small utility module that sends an audio stream via /stdout/ to a @sox@+-- system command that plays the audio.+module Data.MediaBus.Conduit.Audio.Raw.DebugSink+  ( debugAudioPlaybackSink+  ) where++import Control.Lens+import Control.Monad.IO.Class+import qualified Data.ByteString as B+import Data.Conduit+import Data.Default+import Data.MediaBus.Media.Media+import Data.MediaBus.Media.Audio+import Data.MediaBus.Media.Audio.Raw+import Data.MediaBus.Media.Buffer+import Data.MediaBus.Media.Channels+import Data.MediaBus.Media.Stream+import Data.MediaBus.Conduit.Stream+import Data.MediaBus.Basics.Ticks+import Data.Proxy+import Data.Streaming.Process+       (Inherited(..), streamingProcess, waitForStreamingProcess)+import System.IO (Handle, hClose)+import System.Process (shell)+import Text.Printf++-- | A 'Sink' that launches a shell command that starts @sox@ such that it reads+-- raw audio data from @STDIN@ and plays it via the systems sound card.+debugAudioPlaybackSink+  :: forall m i s t p c r ch pcm.+     ( Default i+     , MonadIO m+     , KnownRate r+     , KnownChannelLayout ch+     , IsPcmValue (Pcm ch pcm)+     , HasMediaL' c (Audio r ch (Raw pcm))+     , HasMediaBuffer' (Audio r ch (Raw pcm))+     )+  => Sink (Stream i s t p c) m ()+debugAudioPlaybackSink =+  toFramesC .| do+    let cp =+          shell+            (printf+               "play -r %d -b 16 -c1  -e signed-integer -t raw -"+               (rateVal (Proxy :: Proxy r)))+    (!(sinH :: Handle), Inherited, Inherited, cph) <- streamingProcess cp+    awaitForever+      (mapMOf_+         (framePayload . media' . mediaBuffer')+         (pcmToByteString sinH))+    liftIO (hClose sinH)+    _ <- waitForStreamingProcess cph+    return ()+  where+    pcmToByteString !h !d = liftIO (B.hPut h (mediaBufferToByteString d))

@@ -0,0 +1,75 @@+-- | Simple, preliminary (raw-)audio resampling+module Data.MediaBus.Conduit.Audio.Raw.Resample+  ( resample8to16kHz'+  ) where++import Conduit+import Control.Lens+import Control.Monad.ST (ST)+import Control.Monad.State.Strict+import Control.Parallel.Strategies (NFData, rdeepseq, using)+import Data.MediaBus.Media.Audio.Raw+import Data.MediaBus.Media.Buffer+import Data.MediaBus.Media.Samples+import Data.MediaBus.Media.Stream+import Data.MediaBus.Conduit.Stream+import Data.MediaBus.Basics.Ticks+import qualified Data.Vector.Storable as V+import qualified Data.Vector.Storable.Mutable as M++-- | Resample 'RawAudio' 'IsMedia' from an 8kHz sample rate to 16 kHz, using a+--   simple (and fast) linear interpolation between each sample.+resample8to16kHz'+  :: forall m i s t p cIn cOut ch sa.+     ( Monad m+     , NFData i+     , NFData s+     , NFData t+     , NFData p+     , NFData cIn+     , NFData cOut+     , HasRate cIn+     , GetRate cIn ~ Hz 8000+     , cOut ~ SetRate cIn (Hz 16000)+     , HasRate cOut+     , GetRate cOut ~ Hz 16000+     , EachSampleL cIn cOut (Pcm ch sa) (Pcm ch sa)+     , IsPcmValue (Pcm ch sa)+     , HasMediaBufferL cIn cOut (MediaBuffer (SamplesFrom cIn)) (MediaBuffer (SamplesTo cOut))+     )+  => Pcm ch sa -> Conduit (Stream i s t p cIn) m (Stream i s t p cOut)+resample8to16kHz' !sa =+  evalStateC sa (mapFrameContentMC' (mapMOf mediaBuffer resample))+  where+    resample :: MediaBuffer (Pcm ch sa)+             -> StateT (Pcm ch sa) m (MediaBuffer (Pcm ch sa))+    resample !sb = do+      !lastVal <- get+      let !lastVal' =+            if V.length (sb ^. mediaBufferVector) > 0+              then V.last (sb ^. mediaBufferVector)+              else lastVal+      put lastVal'+      let !sb' =+            createMediaBuffer (interpolate lastVal (sb ^. mediaBufferVector))+      return sb'+      where+        interpolate+          :: Pcm ch sa+          -> V.Vector (Pcm ch sa)+          -> forall st. ST st (V.MVector st (Pcm ch sa))+        interpolate !lastVal !vIn = do+          let !lenOut = 2 * lenIn+          !vOut <- M.new lenOut+          void $ lerpSamples vOut lastVal 0+          return (vOut `using` rdeepseq)+          where+            !lenIn = V.length vIn+            lerpSamples !vOut !prev !i =+              when (i < lenIn) $ do+                !nextHalfRate <- V.indexM vIn i+                let !next = nextHalfRate+                let !smpl = pcmAverage prev next+                M.unsafeWrite vOut (2 * i) smpl+                M.unsafeWrite vOut (2 * i + 1) next+                lerpSamples vOut next (i + 1)

@@ -0,0 +1,19 @@+-- | A conduit that conceals 'Missing' frames.+module Data.MediaBus.Conduit.Discontinous+  ( concealMissing+  ) where++import Conduit+import Control.Parallel.Strategies (NFData)+import Data.MediaBus.Media.Discontinous+import Data.MediaBus.Media.Stream+import Data.MediaBus.Conduit.Stream++-- | Replace 'Missing' parts with the given concealment value.+concealMissing+  :: (NFData c, Monad m)+  => c -> Conduit (Stream i s t p (Discontinous c)) m (Stream i s t p c)+concealMissing conceal = mapFrameContentC' go+  where+    go (Got !b) = b+    go Missing = conceal -- TODO delete ??

@@ -0,0 +1,111 @@+-- | Reorder the 'Frame's in 'Conduit' of a 'Stream'.+module Data.MediaBus.Conduit.Reorder+  ( reorderFramesBySeqNumC+  , reorderFramesByC+  ) where++import Conduit+import Control.Lens+import Control.Monad.State.Strict+import Data.Default+import Data.MediaBus.Basics.OrderedBy+import Data.MediaBus.Basics.Sequence+import Data.MediaBus.Basics.Series+import Data.MediaBus.Media.Stream+import qualified Data.Set as Set++data ReorderSt a b c = MkReorderSt+  { _expectedRank :: !a+  , _frameQueue :: !(Set.Set (OrderedBy a b))+  , _frameDrops :: !Int+  , _lastFrameCtx :: !c+  }++makeLenses ''ReorderSt++-- | Reorder the 'Frame's in 'Conduit' of a 'Stream' according to the 'Ord'+-- instance of the the sequence numbers of 'seqNum'. This function will buffer e+-- certain number of frames that are out of order, and drops frames if they are+-- too late. Also, when too many consecutive frames have all been dropped, a new+-- 'Start' will be created, and the buffered elements are silently dropped, too.+-- When a 'Start' is received that internal buffer is flushed and all queued+-- frames are transmitted.+reorderFramesBySeqNumC+  :: (Default s, Default i, Default t, Default p, Num s, Ord s, Monad m)+  => Int -- ^ The maximun number of out-of-order frames to buffer.+  -> Conduit (Stream i s t p c) m (Stream i s t p c)+reorderFramesBySeqNumC = reorderFramesByC seqNum (+ 1)++-- | Like 'reorderFramesBySeqNumC' but more general. This function allows to+-- pass a 'Lens' to the specific field of each 'Frame', that shall be used for+-- comparison, which governs the order.+reorderFramesByC+  :: ( Monad m+     , Ord rank+     , Default i+     , Default t+     , Default s+     , Default p+     , Default rank+     )+  => Lens' (Stream i s t p c) rank -- ^ A lens for the value to be used as comparison+  -> (rank -> rank) -- ^ A function that returns the **expected next value** of the comparison value+  -> Int -- ^ The maximum number of frames to buffer+  -> Conduit (Stream i s t p c) m (Stream i s t p c)+reorderFramesByC !frameRank !getNextRank !maxQueueLen =+  evalStateC (MkReorderSt def Set.empty 0 def) go+  where+    maxDrops = maxQueueLen+    go = do+      awaitForever handleNext+      flushQueue+      where+        handleNext s@(MkStream (Start !ctx)) = do+          flushQueue+          yield s+          put (MkReorderSt (s ^. frameRank) Set.empty 0 ctx)+        handleNext !frm = do+          !expRank <- use expectedRank+          let !currRank = frm ^. frameRank+          case compare currRank expRank of+            EQ -> do+              yieldNext frm+              maybeYieldNextFromQueue+            LT+                    -- drop the frame, it lacks behind+             -> do+              framesDropped <- frameDrops <+= 1+              when (framesDropped == maxDrops) $ do+                flushQueue+                        -- yield a new Start frame+                ctx <- use lastFrameCtx+                let start =+                      MkStream (Start ctx) & frameRank .~ (frm ^. frameRank)+                    MkStream (Start ctx') = start+                lastFrameCtx .= ctx'+                yield start+                yieldNext frm+            GT -> do+              frameQueue %= Set.insert (MkOrderedBy (view frameRank frm) frm)+              maybeYieldNextFromQueue+        yieldNext !frm = do+          expectedRank .= frm ^. frameRank+          updateExpectedRank+          frameDrops .= 0+          yield frm+        flushQueue = do+          !q <- frameQueue <<.= Set.empty+          mapM_ (yieldNext . orderedByValue) (Set.toAscList q)+        maybeYieldNextFromQueue = do+          !q <- use frameQueue+          !expRank <- use expectedRank+          case Set.minView q of+            Nothing -> return ()+            Just (MkOrderedBy !currRank !candidate, !q') ->+              let !isQueueFull = Set.size q == maxQueueLen+                  !isNextInQueue = currRank <= expRank+              in when (isQueueFull || isNextInQueue) $ do+                   frameQueue .= q'+                   yieldNext candidate+                   maybeYieldNextFromQueue+        updateExpectedRank = expectedRank %= getNextRank

@@ -0,0 +1,67 @@+-- | Make a 'Stream' of media a segmented stream by using that has content which is an instance of 'CanSegment'.+-- TODO move or merge - after deciding howto proceed with the package structure in general+module Data.MediaBus.Conduit.Segment+    ( segmentC+    , segmentC'+    , forgetSegmentationC+    ) where++import           Conduit+import           Data.Monoid+import           Data.MediaBus.Basics.Series+import           Data.MediaBus.Basics.Ticks+import           Data.MediaBus.Media.Segment+import           Data.MediaBus.Media.Stream+import           Data.MediaBus.Conduit.Stream+import           Control.Lens+import           Data.Default+import           Data.Proxy+import           Control.Parallel.Strategies ( NFData )++-- | The packetizer recombines incoming packets into 'Segment's of the given+-- size. The sequence numbers will be offsetted by the number extra frames+-- generated.+segmentC :: (Num s, Monad m, CanSegment c, Monoid c, Default i, CanBeTicks r t, HasDuration c, HasStaticDuration d)+         => Conduit (Stream i s (Ticks r t) p c) m (Stream i s (Ticks r t) p (Segment d c))+segmentC = segmentC' Proxy++segmentC' :: (Num s, Monad m, CanSegment c, Monoid c, Default i, CanBeTicks r t, HasDuration c, HasStaticDuration d)+          => proxy d+          -> Conduit (Stream i s (Ticks r t) p c) m (Stream i s (Ticks r t) p (Segment d c))+segmentC' dpx = evalStateC (0, Nothing) $ awaitForever go+  where+    segmentDurationInTicks =+        nominalDiffTime # segmentDuration+    segmentDuration = getStaticDuration dpx+    go (MkStream (Next (MkFrame !t !s !cIn))) = do+        !cRest <- _2 <<.= Nothing+        let tsOffset = negate (getDurationTicks cRest)+        !cRest' <- yieldLoop (maybe cIn (<> cIn) cRest) tsOffset+        _2 .= cRest'+      where+        yieldLoop !c !timeOffset =+            if getDuration c == segmentDuration+            then do+                yieldWithAdaptedSeqNumAndTimestamp (MkSegment c)+                return Nothing+            else case splitAfterDuration dpx c of+                Just (!packet, !rest) -> do+                    yieldWithAdaptedSeqNumAndTimestamp packet+                    _1 += 1+                    yieldLoop rest (timeOffset + segmentDurationInTicks)+                Nothing -> do+                    -- we just swallowed an incoming packet, therefore we need+                    -- to decrease the seqnums+                    _1 -=+                        1+                    return (Just c)+          where+            yieldWithAdaptedSeqNumAndTimestamp !p = do+                !seqNumOffset <- use _1+                yieldNextFrame (MkFrame (t + timeOffset) (s + seqNumOffset) p)+    go (MkStream (Start !frmCtx)) =+        yieldStartFrameCtx frmCtx++forgetSegmentationC :: (NFData c, Monad m)+                    => Conduit (Stream i s t p (Segment d c)) m (Stream i s t p c)+forgetSegmentationC = mapFrameContentC' _segmentContent

@@ -0,0 +1,173 @@+-- | Conduit combinators for 'Stream's+module Data.MediaBus.Conduit.Stream+  ( yieldStreamish+  , yieldStreamish'+  , yieldNextFrame+  , yieldNextFrame'+  , yieldStartFrameCtx+  , yieldStartFrameCtx'+  , toFramesC+  , overStreamC+  , mapFramesC+  , mapFramesC'+  , mapSeqNumC+  , mapTicksC+  , mapTicksC'+  , mapFrameContentMC+  , mapFrameContentMC'+  , mapFrameContentC'+  , foldStream+  , foldStreamM+  , concatStreamContents+  ) where++import Conduit+import Control.Lens+import Control.Monad+import Control.Monad.Writer.Strict (tell)+import Control.Parallel.Strategies (NFData, rdeepseq, withStrategy)+import Data.Maybe+import Data.MediaBus.Basics.Sequence+import Data.MediaBus.Basics.Series+import Data.MediaBus.Basics.Ticks+import Data.MediaBus.Media.Stream++-- * Yielding 'Stream' content+-- | Yield a 'Stream' from 'Streamish'+yieldStreamish+  :: Monad m+  => Streamish i s t p c -> Conduit a m (Stream i s t p c)+yieldStreamish = yield . MkStream++-- | Strict version of 'yieldStreamish'+yieldStreamish'+  :: (NFData i, NFData s, NFData t, NFData c, NFData p, Monad m)+  => Streamish i s t p c -> Conduit a m (Stream i s t p c)+yieldStreamish' = yield . withStrategy rdeepseq . MkStream++-- | Yield the next 'Frame' of a 'Stream'+yieldNextFrame+  :: Monad m+  => Frame s t c -> Conduit a m (Stream i s t p c)+yieldNextFrame = yieldStreamish . Next++-- | Strict version of 'yieldNextFrame'+yieldNextFrame'+  :: (NFData i, NFData s, NFData t, NFData c, NFData p, Monad m)+  => Frame s t c -> Conduit a m (Stream i s t p c)+yieldNextFrame' = yieldStreamish' . Next++-- | Yield the starting 'FrameCtx' of a 'Stream'+yieldStartFrameCtx+  :: Monad m+  => FrameCtx i s t p -> Conduit a m (Stream i s t p c)+yieldStartFrameCtx = yieldStreamish . Start++-- | Strict version of 'yieldStartFrameCtx'+yieldStartFrameCtx'+  :: ( NFData i+     , NFData s+     , NFData t+     , NFData c+     , NFData p+     , NFData (FrameCtx i s t p)+     , Monad m+     )+  => FrameCtx i s t p -> Conduit a m (Stream i s t p c)+yieldStartFrameCtx' = yieldStreamish' . Start++-- * Conversion from/to 'Stream' 'Conduit's+-- | Create a 'Stream' conduit from a 'Streamish' conduit.+overStreamC+  :: Monad m+  => Conduit (Streamish i s t p c) m (Streamish i' s' t' p' c')+  -> Conduit (Stream i s t p c) m (Stream i' s' t' p' c')+overStreamC = mapInput _stream (Just . MkStream) . mapOutput MkStream++-- | A conduit that receives 'Stream's and yields all 'Frames'+toFramesC+  :: Monad m+  => Conduit (Stream i s t p c) m (Frame s t c)+toFramesC = awaitForever go+  where+    go (MkStream (Start _)) = return ()+    go (MkStream (Next !frm)) = yield frm++-- * Pure Mapping over 'Streams'+-- | A conduit that applies the given function to every 'Frame' of a 'Stream'.+mapFramesC+  :: Monad m+  => (Frame s t c -> m (Frame s t c'))+  -> Conduit (Stream i s t p c) m (Stream i s t p c')+mapFramesC !f = mapMC (mapMOf (stream . _Next) f)++-- | Strict version of 'mapFramesC'+mapFramesC'+  :: (NFData i, NFData s, NFData t, NFData c', Monad m)+  => (Frame s t c -> Frame s t c')+  -> Conduit (Stream i s t p c) m (Stream i s t p c')+mapFramesC' !f = mapC (over (stream . _Next) (withStrategy rdeepseq f))++-- | A conduit that applies the given function to every sequence number of a+-- 'Stream', in 'Frame's as well as 'FrameCtx's.+mapSeqNumC+  :: Monad m+  => (s -> s') -> Conduit (Stream i s t p c) m (Stream i s' t p c)+mapSeqNumC = mapC . over seqNum++-- | A conduit that applies the given function to every time stamp of a+-- 'Stream', in 'Frame's as well as 'FrameCtx's.+mapTicksC+  :: Monad m+  => (t -> t') -> Conduit (Stream i s t p c) m (Stream i s t' p c)+mapTicksC = mapC . over timestamp++-- | A strict version of 'mapTicksC'.+mapTicksC'+  :: (NFData t, Monad m)+  => (t -> t') -> Conduit (Stream i s t p c) m (Stream i s t' p c)+mapTicksC' = mapC . withStrategy rdeepseq . over timestamp++-- | A conduit that applies the given pure function to 'eachFrameContent' of a 'Stream'.+mapFrameContentC'+  :: (NFData c', Monad m)+  => (c -> c') -> Conduit (Stream i s t p c) m (Stream i s t p c')+mapFrameContentC' !f = mapC (over eachFrameContent (withStrategy rdeepseq . f))++-- * Monadic mapping over 'Stream' conduits+-- | A conduit that applies the given monadic function to 'eachFrameContent' of a 'Stream'.+mapFrameContentMC+  :: Monad m+  => (c -> m c') -> Conduit (Stream i s t p c) m (Stream i s t p c')+mapFrameContentMC = mapMC . mapMOf eachFrameContent++-- | A strict variant of 'mapFrameContentMC'+mapFrameContentMC'+  :: (NFData (Stream i s t p c'), Monad m)+  => (c -> m c') -> Conduit (Stream i s t p c) m (Stream i s t p c')+mapFrameContentMC' !f =+  mapMC (mapMOf eachFrameContent f >=> return . withStrategy rdeepseq)++-- * Folding over 'Stream' conduits+-- | Like 'Data.Foldable.foldMap' this uses the given function to extract a+-- monoidal value and 'mappend's all results into a single value, which is+-- returned when the 'Conduit' terminates.+foldStream+  :: (Monoid o, Monad m)+  => (Stream i s t p c -> o) -> Sink (Stream i s t p c) m o+foldStream !f = execWriterC $ awaitForever $ tell . f++-- | Monadic variant of 'foldStream'+foldStreamM+  :: (Monoid o, Monad m)+  => (Stream i s t p c -> m o) -> Sink (Stream i s t p c) m o+foldStreamM !f = execWriterC $ awaitForever (lift . lift . f >=> tell)++-- | Under the constraint that the stream content is a monoid, fold over the+-- stream appending all frame contents, i.e. 'foldStream' of 'eachFrameContent'.+-- When the conduit finishes the monoidal value is returned.+concatStreamContents+  :: (Monoid c, Monad m)+  => Sink (Stream i s t p c) m c+concatStreamContents =+  foldStream (fromMaybe mempty . (^? stream . _Next . framePayload))

@@ -0,0 +1,38 @@+-- | Conduits to create and convert the time stamps in 'Stream's+module Data.MediaBus.Conduit.Timing+  ( convertTicksC'+  , deriveFrameTimestamp+  ) where++import Conduit+import Control.DeepSeq (NFData)+import Control.Lens+import Control.Monad.State.Strict+import Data.MediaBus.Basics.Ticks+import Data.MediaBus.Media.Stream+import Data.MediaBus.Conduit.Stream++-- | Overwrite the timestamp of a stream of things that  have a time stamp field+--  (i.e. 'HasTimestamp' instances)  and also a duration, such that the+--  timestamps increment by the duration starting from 0.+deriveFrameTimestamp+  :: forall m r t a.+     (Monad m, CanBeTicks r t, HasDuration a, HasTimestamp a)+  => Ticks r t -> Conduit a m (SetTimestamp a (Ticks r t))+deriveFrameTimestamp t0 = evalStateC t0 (awaitForever yieldSync)+  where+    yieldSync :: a+              -> Conduit a (StateT (Ticks r t) m) (SetTimestamp a (Ticks r t))+    yieldSync sb = do+      t <- get+      modify (+ (nominalDiffTime # getDuration sb))+      yield (sb & timestamp .~ t)++-- | Recalculate all timestamps in a 'Stream'+convertTicksC'+  :: forall proxy0 proxy1 m r t r' t' i s c p.+     (NFData t, NFData t', CanBeTicks r t, CanBeTicks r' t', Monad m, NFData t')+  => proxy0 '( r, t)+  -> proxy1 '( r', t')+  -> Conduit (Stream i s (Ticks r t) p c) m (Stream i s (Ticks r' t') p c)+convertTicksC' _ _ = mapTicksC' convertTicks

@@ -0,0 +1,51 @@+-- | Probabilistic tracing conduits using 'Debug.Trace'+module Data.MediaBus.Conduit.Trace+    ( exitAfterC+    , traceShowC+    , traceShowSink+    ) where++import           Conduit+import           Data.Conduit.List+import           Control.Monad.State.Strict as State+import           Debug.Trace+import           System.Random++-- | Receive and trace the 'Show'n value prefixed by a message and then yield+-- down the stream. Since the number of elements sent over a conduit can be+-- tremendous, a tracing probability parameter was added, that can be between+-- @0.0@ - @1.0@, and sets the probability of with which a message will be+-- traced. This uses 'Debug.Trace.traceM' internally. Do not use this for+-- logging.+traceShowC :: (Show a, Monad m) => Double -> String -> Conduit a m a+traceShowC probability msg =+    evalStateC (mkStdGen 100, 0 :: Integer) $+        awaitForever $+        \x -> do+            (g, omitted) <- State.get+            let (p, g') = randomR (0, 1) g+            if p < probability+                then do+                    let omittedmsg = if omitted == 0+                                     then ""+                                     else " *** " +++                                         show omitted +++                                         " messages omitted"+                    traceM ((if null msg then "" else msg ++ ": ") ++ show x +++                                omittedmsg)+                    State.put (g', 0)+                else State.put (g', omitted + 1)+            yield x++-- | Like 'traceShowC' but implemented as a 'Consumer' that also returns all+-- received inputs as a list when the conduit terminates.+traceShowSink :: (Show a, Monad m) => Double -> String -> Consumer a m [a]+traceShowSink probability msg =+    traceShowC probability msg .| consume++-- | For profiling and debugging it can sometimes be useful, to have a circuit+-- breaker, like this conduit, that exists after an given number of items have+-- been processed, and, until then just yields all inputs.+exitAfterC :: Monad m => Int -> Conduit a m a+exitAfterC 0 = return ()+exitAfterC n = await >>= maybe (return ()) (yield >=> const (exitAfterC (n - 1)))

@@ -0,0 +1,32 @@+-- | Conduit combinators that make the type of a conduit unambiguous to the+-- compiler via proxies.+module Data.MediaBus.Conduit.TypeAnnotations+  ( annotateTypeC+  , annotateTypeCIn+  , annotateTypeCOut+  , annotateTypeSource+  , annotateTypeSink+  ) where++import Conduit++-- * Generic Conduits+-- | Annotate the type of a 'Conduit' where input and output are the same+annotateTypeC :: proxy a -> Conduit a m a -> Conduit a m a+annotateTypeC _ = id++-- | Annotate the input type of a 'Conduit'+annotateTypeCIn :: proxy a -> Conduit a m b -> Conduit a m b+annotateTypeCIn _ = id++-- | Annotate the output type of a 'Conduit'+annotateTypeCOut :: proxy b -> Conduit a m b -> Conduit a m b+annotateTypeCOut _ = id++-- | Annotate the output type of a 'Source'+annotateTypeSource :: proxy a -> Source m a -> Source m a+annotateTypeSource _ = id++-- | Annotate the input type of a 'Sink'+annotateTypeSink :: proxy a -> Sink a m r -> Sink a m r+annotateTypeSink _ = id

@@ -1,49 +0,0 @@-module Data.MediaBus.DebugSink-    ( HasDebugPlaybackSink(..)-    , streamDebugPlaybackSink-    ) where--import           Data.MediaBus.Audio.Raw-import           Data.MediaBus.Sample-import           Data.MediaBus.Segment-import           Data.MediaBus.Stream-import           System.IO               ( Handle, hClose )-import           System.Process          ( shell )-import           Data.Streaming.Process  ( Inherited(..), streamingProcess-                                         , waitForStreamingProcess )-import qualified Data.ByteString         as B-import           Data.Conduit-import           Control.Monad.IO.Class-import           Data.Proxy-import           Text.Printf-import           GHC.TypeLits-import           Data.Default-import           Control.Lens--class HasDebugPlaybackSink s t c where-    debugPlaybackSink :: MonadIO m => Sink (Frame s t c) m ()--instance HasDebugPlaybackSink s t c =>-         HasDebugPlaybackSink s t (Segment d c) where-    debugPlaybackSink = mapInput (over payload _segmentContent)-                                 (Just . over payload MkSegment)-                                 debugPlaybackSink--instance KnownNat r =>-         HasDebugPlaybackSink s t (SampleBuffer (S16 r)) where-    debugPlaybackSink = do-        let cp = shell (printf "play -r %d -b 16 -c1  -e signed-integer -t raw -"-                               (natVal (Proxy :: Proxy r)))-        (!(sinH :: Handle), Inherited, Inherited, cph) <- streamingProcess cp-        awaitForever (pcmToByteString sinH)-        liftIO (hClose sinH)-        _ <- waitForStreamingProcess cph-        return ()-      where-        pcmToByteString !h (MkFrame _ _ !d) =-            liftIO (B.hPut h (byteStringFromSampleBuffer d))--streamDebugPlaybackSink :: (Default i, HasDebugPlaybackSink s t c, MonadIO m)-                        => Sink (Stream i s t p c) m ()-streamDebugPlaybackSink =-    toFramesC .| debugPlaybackSink

@@ -1,48 +0,0 @@-module Data.MediaBus.Discontinous-    ( Discontinous(..)-    , _Missing-    , _Got-    , concealMissing-    ) where--import           Conduit-import           Control.Lens-import           Control.Parallel.Strategies ( NFData )-import           Data.Default-import           Data.MediaBus.Ticks-import           Data.MediaBus.Payload-import           Data.MediaBus.Stream-import           GHC.Generics                ( Generic )----  TODO create a gap detection mechanism, a simple stateful conduit that knows the next timestamp-data Discontinous a = Missing-                    | Got !a-    deriving (Show, Generic)--instance NFData a =>-         NFData (Discontinous a)--instance Default (Discontinous a) where-    def = Missing--makePrisms ''Discontinous--instance (HasDuration a) =>-         HasDuration (Discontinous a) where-    getDuration Missing = 0-    getDuration (Got !x) = getDuration x--instance HasPayload a =>-         HasPayload (Discontinous a) where-    type GetPayload (Discontinous a) = GetPayload a-    type SetPayload (Discontinous a) b = Discontinous (SetPayload a b)-    payload = _Got . payload--concealMissing :: (NFData c, Monad m)-               => c-               -> Conduit (Stream i s t p (Discontinous c)) m (Stream i s t p c)-concealMissing conceal =-    mapPayloadC' go-  where-    go (Got !b) = b-    go Missing = conceal-- TODO delete ??

@@ -0,0 +1,32 @@+-- | This module centers around the data family 'Audio' that provides general+-- info about an audio stream, such as sampling rate and channel layout and+-- codec.+module Data.MediaBus.Media.Audio+  ( Audio+  ) where++import Data.MediaBus.Media.Media+import Data.MediaBus.Media.Channels+import Data.MediaBus.Basics.Ticks+import Control.Lens++-- | Family of audio media types, indexed by the sampleRate, the channel layout+--   and a /codec/ parameter. This class is intended as a basis for all audio+--   media, raw as well as encoded audio.+data family Audio (sampleRate :: Rate) channelLayout encoding++instance (KnownRate r) =>+         HasRate (Audio r c t) where+  type GetRate (Audio r c t) = r+  type SetRate (Audio r c t) x = Audio x c t++instance (KnownChannelLayout c) =>+         HasChannelLayout (Audio r c t) where+  type ChannelLayout (Audio r c t) = c+  type SetChannelLayout (Audio r c t) c' = Audio r c' t++instance (IsMedia (Audio r c e), IsMedia (Audio r' c' e')) =>+  HasMedia (Audio r c e) (Audio r' c' e') where+    type MediaFrom (Audio r c e) = Audio r c e+    type MediaTo (Audio r' c' e') = Audio r' c' e'+    media = iso id id

@@ -0,0 +1,128 @@+{-# LANGUAGE UndecidableInstances #-}++-- | Sub-types of 'Audio' for uncompressed audio.+module Data.MediaBus.Media.Audio.Raw+  ( Raw+  , Pcm+  , pcmMediaBuffer+  , IsPcmValue(..)+  ) where++import Control.DeepSeq+import Control.Lens+import Data.MediaBus.Media.Media+import Data.MediaBus.Media.Audio+import Data.MediaBus.Media.Blank+import Data.MediaBus.Media.Buffer+import Data.MediaBus.Media.Channels+import Data.MediaBus.Media.Samples+import Data.MediaBus.Media.Segment+import Data.MediaBus.Basics.Ticks+import Data.Typeable+import qualified Data.Vector.Storable as V+import qualified Data.Vector.Storable.Mutable as M+import Test.QuickCheck++-- | An indicator for uncompressed audio with a given per sample encoding type.+data Raw encoding++-- | A family of multi-channel audio samples, this will be stored in a 'MediaBuffer'+-- if audio is represented by @Audio r (Pcm c t)@+data family Pcm c t++-- | Types of per channel PCM audio sample value.+class (CanBeBlank a, CanBeSample a, Arbitrary a) =>+      IsPcmValue a where+  -- | Calculate the average of two pcm samples+  pcmAverage :: a -> a -> a++-- | All 'Pcm' audio is audio. An 'Audio' instance with 'Pcm's in a 'MediaBuffer'.+newtype instance  Audio r c (Raw t) = MkPcm {_pcmMediaBuffer :: MediaBuffer (Pcm c t)}++-- | An isomorphism for 'Audio' and 'MediaBuffer'+pcmMediaBuffer :: Iso (Audio r c (Raw t)) (Audio r' c' (Raw t')) (MediaBuffer (Pcm c t)) (MediaBuffer (Pcm c' t'))+pcmMediaBuffer = iso _pcmMediaBuffer MkPcm++instance (KnownRate r, CanBeSample (Pcm c t), CanBeBlank (Pcm c t)) =>+         CanGenerateBlankMedia (Audio r c (Raw t)) where+  blankFor dt =+    MkPcm $+    createMediaBuffer $+    let numberOfSamples =+          ceiling (dt * fromIntegral (rateVal (MkRateProxy :: RateProxy r)))+    in M.replicate numberOfSamples blank++instance (KnownRate r, CanBeSample (Pcm c t)) =>+         HasDuration (Audio r c (Raw t)) where+  getDuration (MkPcm !buf) =+    let pd = getPeriodDuration (Proxy :: Proxy (Audio r c (Raw t)))+        n = fromIntegral $ mediaBufferLength buf+    in pd * n++instance CanBeSample (Pcm c t) =>+         NFData (Audio r c (Raw t)) where+  rnf (MkPcm !buf) = rnf buf++instance CanBeSample (Pcm c t) =>+         Eq (Audio r c (Raw t)) where+  (==) (MkPcm !buf1) (MkPcm !buf2) = buf1 == buf2++instance (Typeable t, KnownRate r, KnownChannelLayout c, CanBeSample (Pcm c t)) =>+         IsMedia (Audio r c (Raw t))++instance (Typeable t, KnownRate r, KnownChannelLayout c) =>+         Show (MediaDescription (Audio r c (Raw t))) where+  showsPrec d _ =+    showParen+      (d > 10)+      (showString "pcm-audio " .+       showsPrec 11 (typeRep (Proxy :: Proxy t)) .+       showString " " .+       showsPrec 11 (MkRateProxy :: RateProxy r) .+       showString " " . showsPrec 11 (MkRateProxy :: RateProxy r))++instance (Typeable t, KnownRate r, KnownChannelLayout c, CanBeSample (Pcm c t)) =>+         Show (Audio r c (Raw t)) where+  showsPrec d (MkPcm !c) =+    showParen (d > 10) $+    shows (MkShowMedia :: MediaDescription (Audio r c (Raw t))) . showsPrec 11 c++instance (CanBeSample (Pcm ca a), CanBeSample (Pcm cb b)) =>+         HasMediaBuffer (Audio r ca (Raw a)) (Audio r' cb (Raw b)) where+  type MediaBufferFrom (Audio r ca (Raw a)) = (MediaBuffer (Pcm ca a))+  type MediaBufferTo (Audio r' cb (Raw b)) = (MediaBuffer (Pcm cb b))+  mediaBuffer = pcmMediaBuffer++instance (CanBeSample (Pcm c t), CanBeSample (Pcm c' t')) =>+         EachSample (Audio r c (Raw t)) (Audio r' c' (Raw t')) where+  type SamplesFrom (Audio r c (Raw t)) = (Pcm c t)+  type SamplesTo (Audio r' c' (Raw t')) = (Pcm c' t')+  eachSample = pcmMediaBuffer . each++instance ( CanBeSample (Pcm c t)+         , CanBeSample (Pcm c' t')+         , EachSampleL (Audio r c (Raw t)) (Audio r' c' (Raw t')) (Pcm c t) (Pcm c' t')+         , EachChannelL (Pcm c t) (Pcm c' t') t t'+         ) =>+         EachChannel (Audio r c (Raw t)) (Audio r' c' (Raw t')) where+  type ChannelsFrom (Audio r c (Raw t)) = ChannelsFrom (Pcm c t)+  type ChannelsTo (Audio r' c' (Raw t')) = ChannelsTo (Pcm c' t')+  eachChannel = eachSample . eachChannel++instance (CanBeSample (Pcm c t), KnownRate r) =>+         CanSegment (Audio r c (Raw t)) where+  splitAfterDuration proxy buf@(MkPcm (MkMediaBuffer !bufV))+    | getDuration buf >= tPacket =+      let (!nextPacket, !rest) = V.splitAt n bufV+      in Just+           ( segmentContent . pcmMediaBuffer . mediaBufferVector # V.force nextPacket+           , pcmMediaBuffer . mediaBufferVector # rest)+    | otherwise = Nothing+    where+      !tPacket = getStaticDuration proxy+      !n = ceiling (tPacket / tSample)+      !tSample = getPeriodDuration (Proxy :: Proxy (Audio r c (Raw t)))++instance CanBeSample (Pcm c t) => Monoid (Audio r c (Raw t)) where+  mempty = pcmMediaBuffer # mempty+  mappend x y = pcmMediaBuffer # mappend (x ^. pcmMediaBuffer) (y ^. pcmMediaBuffer)

@@ -0,0 +1,122 @@+-- | This module defines the **Alaw** audio sample type, as well as compading+-- conversion functions from/to 'S16' values.+module Data.MediaBus.Media.Audio.Raw.Alaw+  ( ALaw()+  , encodeALawSample+  , decodeALawSample+  , alawSample+  , alawValue+  ) where++import Control.Lens+import Control.DeepSeq (NFData)+import Data.Bits+import Data.Default+import Data.Function (on)+import Data.Int+import Data.MediaBus.Media.Audio.Raw+import Data.MediaBus.Media.Audio.Raw.Signed16bit+import Data.MediaBus.Media.Blank+import Data.Typeable+import Data.Word+import Foreign.Storable+import GHC.Generics (Generic)+import Test.QuickCheck (Arbitrary(..))++-- | A PCM audio sample represented by a single byte, that can be converted to a+-- signed 13bit audio sample.+newtype ALaw = MkALaw+  { _alawValue :: Word8+  } deriving ( Show+             , Storable+             , Num+             , Eq+             , Bits+             , Arbitrary+             , Generic+             , NFData+             , Default+             , Typeable+             )++-- | An 'Iso' for 'ALaw' sample values.+alawValue :: Iso' ALaw Word8+alawValue = iso _alawValue MkALaw++-- | An 'Iso' between 'ALaw' and 'S16' using 'encodeALawSample' and+-- 'decodeALawSample'.+alawSample :: Iso' ALaw S16+alawSample = iso decodeALawSample encodeALawSample++instance CanBeBlank ALaw where+  blank = 0xD5++instance IsPcmValue ALaw where+  pcmAverage !x !y = encodeALawSample $ (pcmAverage `on` decodeALawSample) x y++-- | Uncompress an alaw sample into a linear 16 signed value, see+-- 'encodeALawSample' for more information.+decodeALawSample :: ALaw -> S16+decodeALawSample (MkALaw !a') =+  let !a = a' `xor` 85+      !quant_mask = 15+      !quant_shift = 4+      !seg_mask = 112+      !seg_shift = 4+      tBase, tAbs, seg :: Int16+      !seg = (fromIntegral a .&. seg_mask) `shiftR` seg_shift+      !tBase = (fromIntegral a .&. quant_mask) `shiftL` quant_shift+      !tAbs =+        case seg of+          0 -> tBase + 8+          1 -> tBase + 264+          _ -> (tBase + 264) `shiftL` fromIntegral (seg - 1)+      !isPos = testBit a 7+  in MkS16 $+     if isPos+       then tAbs+       else tAbs * (-1)++-- | See http://opensource.apple.com//source/tcl/tcl-20/tcl_ext/snack/snack/generic/g711.c+--+-- >	Linear Input Code	 Compressed Code+-- >	-----------------  ---------------+-- >	  0000000wxyza         000wxyz+-- >	  0000001wxyza         001wxyz+-- >	  000001wxyzab         010wxyz+-- >	  00001wxyzabc         011wxyz+-- >	  0001wxyzabcd         100wxyz+-- >	  001wxyzabcde         101wxyz+-- >	  01wxyzabcdef         110wxyz+-- >	  1wxyzabcdefg         111wxyz+--+-- For further information see John C. Bellamy's Digital Telephony, 1982, John+-- Wiley & Sons, pps 98-111 and 472-476.+encodeALawSample :: S16 -> ALaw+encodeALawSample (MkS16 !pcmVal') =+  let !pcmVal = pcmVal' `shiftR` 3 -- to 13 bit+      (!mask, !pcmValAbs) =+        if pcmVal >= 0+          then ( 0xD5 -- sign bit (bit 7) = 1+               , pcmVal)+          else ( 0x55 -- sign bit = 0+               , (-1) * pcmVal - 1)+      !segment+        | pcmValAbs <= 31 = 0+        | pcmValAbs <= 63 = 1+        | pcmValAbs <= 127 = 2+        | pcmValAbs <= 255 = 3+        | pcmValAbs <= 511 = 4+        | pcmValAbs <= 1023 = 5+        | pcmValAbs <= 2047 = 6+        | pcmValAbs <= 4095 = 7+        | otherwise = 8+      !res =+        if segment == 8+          then 0x7F+          else let !segShift =+                     if segment < 2+                       then 1+                       else fromIntegral segment+               in shiftL segment 4 .|. (shiftR pcmValAbs segShift .&. 0xF)+  in MkALaw (fromIntegral res `xor` mask)

@@ -0,0 +1,35 @@+-- | Single channel (Mono) PCM audio+module Data.MediaBus.Media.Audio.Raw.Mono+  ( Mono()+  ) where++import Control.DeepSeq+import Control.Lens+import Data.Default+import Data.MediaBus.Media.Audio.Raw+import Data.MediaBus.Media.Blank+import Data.MediaBus.Media.Channels+import Data.Typeable+import Foreign.Storable+import Test.QuickCheck++-- | The channel layout indicator type for **mono** audio+data Mono++instance KnownChannelLayout Mono where+  numberOfChannels _ = 1++newtype instance  Pcm Mono s = MkMonoSample{_monoSample :: s}+                             deriving (CanBeBlank, NFData, Eq, Storable, Default, Typeable,+                                       Arbitrary, IsPcmValue, Num, Ord, Integral, Real, Enum)++instance (IsPcmValue a, IsPcmValue b) =>+         EachChannel (Pcm Mono a) (Pcm Mono b) where+  type ChannelsFrom (Pcm Mono a) = a+  type ChannelsTo (Pcm Mono b) = b+  eachChannel = iso _monoSample MkMonoSample++instance Show s =>+         Show (Pcm Mono s) where+  showsPrec d (MkMonoSample !s) =+    showParen (d > 10) $ showString "M " . showsPrec 11 s

@@ -0,0 +1,47 @@+-- | This module defines the 16-bit PCM audio sample type.+module Data.MediaBus.Media.Audio.Raw.Signed16bit+  ( S16(..)+  , s16Sample+  ) where++import Control.DeepSeq (NFData)+import Control.Lens+import Data.Bits+import Data.Default (Default)+import Data.Int+import Data.MediaBus.Media.Audio.Raw+import Data.MediaBus.Media.Blank+import Data.Typeable+import Data.Vector.Storable (Storable)+import Test.QuickCheck+import Text.Printf++-- | A value representing a signed PCM audio sample with a width of 16 bit.+newtype S16 = MkS16+  { _s16Sample :: Int16+  } deriving ( Eq+             , Ord+             , Arbitrary+             , Bits+             , NFData+             , Storable+             , Num+             , Default+             , Typeable+             )++-- | An 'Iso' from/to the sample value of an 'S16'+s16Sample :: Iso' S16 Int16+s16Sample = iso _s16Sample MkS16++instance Show S16 where+  show (MkS16 !x) = printf "S16: %6d" x++instance CanBeBlank S16 where+  blank = 0++instance IsPcmValue S16 where+  pcmAverage !x !y =+    if abs x < 16382 && abs y < 16382+      then (x + y) `unsafeShiftR` 1+      else (x `unsafeShiftR` 1) + (y `unsafeShiftR` 1)

@@ -0,0 +1,63 @@+-- | Stereo PCM audio+module Data.MediaBus.Media.Audio.Raw.Stereo+  ( Stereo()+  ) where++import Control.DeepSeq+import Data.Default+import Data.MediaBus.Media.Audio.Raw+import Data.MediaBus.Media.Blank+import Data.MediaBus.Media.Channels+import Data.Typeable+import Foreign.Storable+import GHC.Generics (Generic)+import Test.QuickCheck++-- | The channel layout indicator type for **stereo** audio+data Stereo++instance KnownChannelLayout Stereo where+  numberOfChannels _ = 2++data instance  Pcm Stereo t = MkStereo{_leftSample :: !t,+                                       _rightSample :: !t}+                            deriving (Eq, Ord, Generic, Typeable)++instance NFData t =>+         NFData (Pcm Stereo t)++instance Arbitrary t =>+         Arbitrary (Pcm Stereo t) where+  arbitrary = MkStereo <$> arbitrary <*> arbitrary++instance EachChannel (Pcm Stereo a) (Pcm Stereo b) where+  type ChannelsFrom (Pcm Stereo a) = a+  type ChannelsTo (Pcm Stereo b) = b+  eachChannel f (MkStereo !l !r) = MkStereo <$> f l <*> f r++instance IsPcmValue a =>+         IsPcmValue (Pcm Stereo a) where+  pcmAverage (MkStereo !l0 !r0) (MkStereo !l1 !r1) =+    MkStereo (pcmAverage l0 l1) (pcmAverage r0 r1)++instance CanBeBlank a =>+         CanBeBlank (Pcm Stereo a) where+  blank = MkStereo blank blank++instance Default a =>+         Default (Pcm Stereo a) where+  def = MkStereo def def++instance Storable s =>+         Storable (Pcm Stereo s) where+  sizeOf s = 2 * sizeOf s+  alignment = alignment+  peekByteOff ptr off = do+    l <- peekByteOff ptr off+    let rOffset = sizeOf l+    r <- peekByteOff ptr (rOffset + off)+    return (MkStereo l r)+  pokeByteOff ptr off (MkStereo l r) = do+    pokeByteOff ptr off l+    let rOffset = sizeOf l+    pokeByteOff ptr (off + rOffset) r

@@ -0,0 +1,34 @@+-- | Type class for media content that has /blank/ values, that represent a+-- neutral media content such as silence or a black image.+module Data.MediaBus.Media.Blank+    ( CanGenerateBlankMedia(..)+    , CanBeBlank(..)+    ) where++import           Data.MediaBus.Basics.Ticks+import           Data.MediaBus.Media.Segment+import           Data.Time.Clock+import           Control.Lens+import           Data.Proxy++-- | Types that can have /blank/ values.+class CanBeBlank a where+    -- | Generate the value that represents neutral media content.+    blank :: a++-- | Types that have a dynamic duration, for example a audio sample buffers, can+-- implement this type class to provide methods for generating blank media+-- content (e.g. silence) for a certain duration.+class CanGenerateBlankMedia a where+    -- | Generate the value that represents neutral media content, and has at+    -- least the given duration.+    blankFor :: NominalDiffTime -> a+    blankFor dt = blankForTicks (nominalDiffTime # dt :: PicoSeconds)+    -- | Generate the value that represents neutral media content, and has at+    -- least the given duration given as 'Ticks'+    blankForTicks :: CanBeTicks r i => Ticks r i -> a+    blankForTicks ticks = blankFor (from nominalDiffTime # ticks)++instance (HasStaticDuration d, CanGenerateBlankMedia a) =>+         CanBeBlank (Segment d a) where+    blank = MkSegment (blankFor (getStaticDuration (Proxy :: Proxy d)))

@@ -0,0 +1,153 @@+-- | Media with a content stored in a 'Vector'+module Data.MediaBus.Media.Buffer+  ( type CanBeSample+  , HasMediaBuffer(..)+  , type HasMediaBuffer'+  , type HasMediaBufferL+  , type HasMediaBufferL'+  , mediaBuffer'+  , MediaBuffer(..)+  , mediaBufferVector+  , mediaBufferLength+  , mediaBufferFromList+  , mediaBufferToList+  , mediaBufferFromByteString+  , mediaBufferToByteString+  , createMediaBuffer+  , modifyMediaBuffer+  , unsafeModifyMediaBuffer+  ) where++import Control.DeepSeq+import Control.Lens+import Control.Monad.ST (ST, runST)+import qualified Data.ByteString as B+import Data.Default+import Data.MediaBus.Media.Samples+import Data.Typeable+import qualified Data.Vector.Storable as V+import qualified Data.Vector.Storable.ByteString as Spool+import GHC.Exts (IsList(..))+import GHC.Generics (Generic)++-- ** Types using 'MediaBuffer'+-- | Types containing a 'MediaBuffer'+class HasMediaBuffer s t where+  -- | The media buffer type contained in 's'+  type MediaBufferFrom s+  -- | The type that results from changing the media buffer type in 's' to 'b'+  type MediaBufferTo t+  -- | A lens for converting the media buffer+  mediaBuffer :: Lens s t (MediaBufferFrom s) (MediaBufferTo t)++-- | Like 'HasMediaBuffer' but with @s ~ t@ and @MediaBufferFrom s ~ MediaBufferTo t@+type HasMediaBuffer' s = (HasMediaBuffer s s, MediaBufferFrom s ~ MediaBufferTo s)++-- | Like 'mediaBuffer' but with @s ~ t@ and @MediaBufferFrom s ~ MediaBufferTo t@+mediaBuffer' :: HasMediaBuffer' s => Lens' s (MediaBufferFrom s)+mediaBuffer' = mediaBuffer++-- | Like 'HasMediaBuffer' but with the typical lens type parameters @s t a b@+type HasMediaBufferL s t a b = (HasMediaBuffer s t, MediaBufferFrom s ~ a, MediaBufferTo t ~ b)++-- | Like 'HasMediaBufferL' but with the typical **simple** lens type parameters @s a@+type HasMediaBufferL' s a = (HasMediaBuffer s s, MediaBufferFrom s ~ a, MediaBufferTo s ~ a)++-- | A buffer for media data. The type parameter @t@ is supposed to be an+-- instance of `IsMedia`.+newtype MediaBuffer t = MkMediaBuffer+  { _mediaBufferVector :: V.Vector t+  } deriving (Generic, NFData, Monoid, Eq)++-- | 'MediaBuffer' to 'Vector' isomorphism+mediaBufferVector :: Iso (MediaBuffer s) (MediaBuffer t) (V.Vector s) (V.Vector t)+mediaBufferVector = iso _mediaBufferVector MkMediaBuffer++-- | Traversal instance+instance (V.Storable a, V.Storable b) =>+         Each (MediaBuffer a) (MediaBuffer b) a b where+  each = mediaBufferVector . each++-- ** Instances+instance CanBeSample s =>+         IsList (MediaBuffer s) where+  type Item (MediaBuffer s) = s+  fromList = mediaBufferFromList+  toList = mediaBufferToList++instance (CanBeSample a) =>+         Show (MediaBuffer a) where+  show m =+    "MediaBuffer: " +++    show (mediaBufferLength m) ++ " x " ++ show (typeRep (Proxy :: Proxy a))++instance CanBeSample sampleType =>+         Default (MediaBuffer sampleType) where+  def = mempty++-- | Return the number of 'BufferElement's in the 'MediaBuffer' buffer.+mediaBufferLength+  :: CanBeSample t+  => MediaBuffer t -> Int+mediaBufferLength = view (mediaBufferVector . to V.length)++-- ** Conversion+-- *** List Conversion++-- | Convert the media buffer vector contents to a list in O(n).+mediaBufferToList+  :: CanBeSample s+  => MediaBuffer s -> [s]+mediaBufferToList = view (mediaBufferVector . to V.toList)++-- | Create a 'MediaBuffer' from a list in O(n).+mediaBufferFromList+  :: CanBeSample s+  => [s] -> MediaBuffer s+mediaBufferFromList = MkMediaBuffer . V.fromList++-- *** 'ByteString' Conversion++-- | An efficient conversion of a 'ByteString' to a 'MediaBuffer'+mediaBufferFromByteString+  :: CanBeSample a+  => B.ByteString -> MediaBuffer a+mediaBufferFromByteString = MkMediaBuffer . Spool.byteStringToVector++-- | An efficient conversion of a 'MediaBuffer' to a 'ByteString'+mediaBufferToByteString+  :: CanBeSample a+  => MediaBuffer a -> B.ByteString+mediaBufferToByteString = Spool.vectorToByteString . _mediaBufferVector++-- ** Construction+-- | Create a new 'MediaBuffer' using an 'ST` action that returns a mutable+-- 'MVector'.+createMediaBuffer+  :: CanBeSample t+  => (forall s. ST s (V.MVector s t)) -> MediaBuffer t+createMediaBuffer f = MkMediaBuffer (V.create f)++-- ** Fast manipulation+-- | Modify the underlying 'Vector' of some 'MediaBuffer' with a function that is+-- applied to the mutable vector of that 'MediaBuffer'. The function must result+-- in a 'ST' action that does the modifications.+modifyMediaBuffer+  :: CanBeSample a+  => (forall s. V.MVector s a -> ST s ()) -> MediaBuffer a -> MediaBuffer a+modifyMediaBuffer f = over mediaBufferVector (V.modify f)++-- | Modify the underlying 'Vector' of some 'MediaBuffer' with a function that is+-- applied to the mutable vector of that 'MediaBuffer'. The function must result+-- in a 'ST' action that does the modifications.+--+-- Unsafe because results can be returned, so the /thawn/ mutable vector might escape.+unsafeModifyMediaBuffer+  :: CanBeSample a+  => (forall s. V.MVector s a -> ST s r) -> MediaBuffer a -> (r, MediaBuffer a)+unsafeModifyMediaBuffer f (MkMediaBuffer !v) =+  runST $ do+    !mv <- V.unsafeThaw v+    !r <- f mv+    !v' <- V.unsafeFreeze mv+    return (r, MkMediaBuffer v')

@@ -0,0 +1,64 @@+-- |  Channel representation types.+module Data.MediaBus.Media.Channels+    ( KnownChannelLayout(..)+    , ChannelLayoutProxy(..)+    , HasChannelLayout(..)+    , EachChannel(..)+    , type EachChannelL+    , type EachChannelL'+    , type EachChannel'+    , eachChannel'+    ) where++import           Control.Lens+import           Data.Typeable++-- | Like 'KnownNat' but for promoted 'ChannelLayout's.+class Typeable c =>+      KnownChannelLayout c where+    -- | Return the 'ChannelLayout' for type @c@+    numberOfChannels :: proxy c -> Int++-- | A Proxy specifically to prevent orphan instances of e.g. @Proxy channelLayoyt@.+data ChannelLayoutProxy c where+        MkChannelLayoutProxy :: ChannelLayoutProxy c+        ConvertChannelLayoutProxy :: proxy c -> ChannelLayoutProxy c++-- | Create a textual representation of the channel layout.+instance KnownChannelLayout c =>+         Show (ChannelLayoutProxy c) where+    showsPrec d px = showParen (d > 10)+                               (showsPrec 11 (typeRep px) .+                                    showString " " .+                                        showsPrec 11 (numberOfChannels px))++-- | Types that have some 'KnownChannelLayout'+class (SetChannelLayout s (ChannelLayout s) ~ s) =>+      HasChannelLayout s where+    -- | The channel layout contained in 's'+    type ChannelLayout s+    -- | The type resulting from changing the channel layout type in 's' to 'b'+    type SetChannelLayout s b++-- | Types, e.g samples, that have one or more channels+class EachChannel s t where+    -- | The channel layout contained in 's'+    type ChannelsFrom s+    -- | The channel layout contained in 't'+    type ChannelsTo t++    --  | Traversal for accessing each individual channel+    eachChannel :: Traversal s t (ChannelsFrom s) (ChannelsTo t)++-- | A constraint type alias for 'EachChannel' similar to the parameters of type class 'Each' from the lens package.+type EachChannelL s t a b = (EachChannel s t, ChannelsFrom s ~ a, ChannelsTo t ~ b)++-- | A constraint type alias for 'EachChannel' with a simple traversal+type EachChannelL' s a = (EachChannel s s, ChannelsFrom s ~ a, ChannelsTo s ~ a)++-- | A simple 'Traversal' for the channels in samples+type EachChannel' s = (ChannelsFrom s ~ ChannelsTo s, EachChannel s s)++-- | A simple 'Traversal' for the channels in samples+eachChannel' :: EachChannel' i => Traversal' i (ChannelsFrom i)+eachChannel' = eachChannel

@@ -0,0 +1,72 @@+-- | Discontinous content. Some media streams, like e.g. RTP streams received+-- via UDP, have the characteristic, that some times packages are lost. This+-- module provides a type that is isomorphic to 'Maybe' to indicate that the+-- content for a media frame is missing.+-- It might take some effort to detect missing content, like a jitter buffer, or the comparison of sequence numbers.+--+--  TODO: Create a gap detection mechanism, a simple stateful monad that knows the next timestamp etc.+module Data.MediaBus.Media.Discontinous+  ( Discontinous(..)+  , _Missing+  , _Got+  ) where++import Control.Lens+import Control.Parallel.Strategies (NFData)+import Data.Default+import Data.MediaBus.Media.Media+import Data.MediaBus.Media.Channels+import Data.MediaBus.Media.Samples+import Data.MediaBus.Basics.Ticks+import GHC.Generics (Generic)++-- | Content that can be 'Missing'.+data Discontinous a+  = Missing -- ^ A place holder for frame content that is missing+  | Got !a -- ^ Available content+  deriving (Show, Generic)++instance NFData a =>+         NFData (Discontinous a)++instance Default (Discontinous a) where+  def = Missing++makePrisms ''Discontinous++instance (HasDuration a) =>+         HasDuration (Discontinous a) where+  getDuration Missing = 0+  getDuration (Got !x) = getDuration x++instance EachMedia a b =>+         EachMedia (Discontinous a) (Discontinous b) where+  type MediaFromE (Discontinous a) = MediaFromE a+  type MediaToE (Discontinous b) = MediaToE b+  eachMedia = _Got . eachMedia++instance EachSample a b =>+         EachSample (Discontinous a) (Discontinous b) where+  type SamplesFrom (Discontinous a) = SamplesFrom a+  type SamplesTo (Discontinous b) = SamplesTo b+  eachSample = _Got . eachSample++instance EachChannel a b =>+         EachChannel (Discontinous a) (Discontinous b) where+  type ChannelsFrom (Discontinous a) = ChannelsFrom a+  type ChannelsTo (Discontinous b) = ChannelsTo b+  eachChannel = _Got . eachChannel++instance (HasRate c) =>+         HasRate (Discontinous c) where+  type GetRate (Discontinous c) = GetRate c+  type SetRate (Discontinous c) r' = Discontinous (SetRate c r')++instance ( HasRate i+         , GetRate i ~ ri+         , SetRate i rj ~ j+         , KnownRate rj+         , CoerceRate i j ri rj+         ) =>+         CoerceRate (Discontinous i) (Discontinous j) ri rj where+  coerceRate px = over _Got (coerceRate px)

@@ -0,0 +1,84 @@+-- | This module contains mainly the informative 'IsMedia' type class and+-- corresponding type classes for media lenses.+module Data.MediaBus.Media.Media+  ( IsMedia()+  , MediaDescription(..)+  , HasMedia(..)+  , type HasMedia'+  , media'+  , type HasMediaL+  , type HasMediaL'+  , EachMedia(..)+  , type EachMedia'+  , eachMedia'+  , type EachMediaL+  , type EachMediaL'+  ) where++import Control.DeepSeq+import Control.Lens++-- * Media+-- | Very abstract class of media content types. The only universal feature is that it has a static description.+class ( NFData i+      , Show (MediaDescription i) -- TODO HasDuration instance??+      ) =>+      IsMedia i++-- | A proxy type to display static media info via a 'Show' instance+data MediaDescription i where+        MkShowMedia :: (Show (MediaDescription i)) => MediaDescription i++-- * Media container 'Lens'es+-- | Types that contain an 'IsMedia' instance.+class (IsMedia (MediaFrom s), IsMedia (MediaTo t)) =>+      HasMedia s t where+  type MediaFrom s+  type MediaTo t+  -- | A 'Lens' for the media within 's'+  media :: Lens s t (MediaFrom s) (MediaTo t)++-- | Types that contain an 'IsMedia' instance.+type HasMedia' s = (IsMedia (MediaFrom s), HasMedia s s, MediaFrom s ~ MediaTo s)++-- | A simple 'Lens' for the media within 's'+media'+  :: HasMedia' s+  => Lens' s (MediaFrom s)+media' = media++-- | Types that contain an 'IsMedia' instance with the traditional lens-like type parameters+type HasMediaL s t a b = (IsMedia a, HasMedia s t, MediaFrom s ~ a, MediaTo t ~ b)++-- | Like 'HasMedia' but with the **simple** lens-like type parameters+type HasMediaL' s a = (IsMedia a, HasMedia s s, MediaFrom s ~ a, MediaTo s ~ a, MediaFrom s ~ MediaTo s)++-- * Media container 'Traversal's+-- | Types that contain zero or more 'IsMedia' instance.+class (IsMedia (MediaFromE s), IsMedia (MediaToE t)) =>+      EachMedia s t where+  -- | The contained input media type, since the name 'MediaFrom' was taken+  -- , this is named 'MediaFromE' where the @E@ is supposed to hint at the fact+  -- that this class is called 'EachMedia'.+  type MediaFromE s+  type MediaToE t+  -- | A 'Traversal' for the media within 's'+  eachMedia :: Traversal s t (MediaFromE s) (MediaToE t)+  default eachMedia :: HasMediaL s t (MediaFromE s) (MediaToE t) =>+    Traversal s t (MediaFromE s) (MediaToE t)+  eachMedia = media++-- | Types that contain zero or more 'IsMedia' instance.+type EachMedia' s = (IsMedia (MediaFromE s), EachMedia s s, MediaFromE s ~ MediaToE s)++-- | A simple 'Traversal' for the media within 's'+eachMedia'+  :: EachMedia' s+  => Traversal' s (MediaFromE s)+eachMedia' = eachMedia++-- | Types that contain zero or more 'IsMedia' instance with the traditional lens-like type parameters+type EachMediaL s t a b = (IsMedia a, EachMedia s t, MediaFromE s ~ a, MediaToE t ~ b)++-- | Like 'EachMedia' but with the **simple** lens-like type parameters+type EachMediaL' s a = (IsMedia a, EachMedia s s, MediaFromE s ~ a, MediaToE s ~ a, MediaFromE s ~ MediaToE s)

@@ -0,0 +1,61 @@+-- | Media represented by samples in the time domain.+--   What is meant by media sample?+--   For example the microphone value captured at a certain point in time for mono audio,+--   or the pair of values from the left and right channel of a stereo audio track,+--   or a pixel; the common characteristic is that a sample encompasses+--   the (aggregate) value representing smallest piece of media.+--   A sample may be composed of components, like in a stereo audio sample,+--   or color channels in an YUV pixel, but since they are played/recorded at+--   the same time instances, they form a sample only when combined not when+--   regarded indivudually.+module Data.MediaBus.Media.Samples+  ( IsSampledMedia()+  , type CanBeSample+  , EachSample(..)+  , type EachSampleL+  , type EachSampleL'+  , type EachSample'+  , eachSample'+  ) where++import Control.DeepSeq+import Control.Lens+import Data.MediaBus.Media.Media+import Data.MediaBus.Basics.Ticks+import Data.Typeable+import Foreign.Storable++-- | Types that are 'IsMedia' instances with sampled content.+class (IsMedia i, HasRate i) =>+      IsSampledMedia i++-- | Always recurring contraints on 'Sample' types.+type CanBeSample i = (Typeable i, Eq i, NFData i, Storable i)++-- | A type class for types that contain samples which can be converted into+-- other sample types.+class (CanBeSample (SamplesFrom s), CanBeSample (SamplesTo t)) =>+      EachSample s t where+  -- | The type of the contained media samples passed as input by 'eachSample'.+  type SamplesFrom s+  -- | The type of the contained media samples from the output of 'eachSample'.+  type SamplesTo t+  --  | Traversal for accessing each individual sample.+  -- The default implementation uses an 'EachSampleL' instance+  eachSample :: Traversal s t (SamplesFrom s) (SamplesTo t)++-- | A lens-stype type alias for 'EachSample' with the full @s t a b@ parameter set.+type EachSampleL s t a b = (EachSample s t, SamplesFrom s ~ a, SamplesTo t ~ b)++-- | A lens-stype type alias for 'EachSample' for cases where+--  @'SamplesFrom' ~ 'SamplesTo'@ with the full @s a@ parameter set.+type EachSampleL' s a = (EachSample s s, SamplesFrom s ~ a, SamplesTo s ~ a)++-- | A lens-stype type alias for 'EachSample' for cases where @'SamplesFrom' ~ 'SamplesTo'@+type EachSample' s = (EachSample s s, SamplesFrom s ~ SamplesTo s)++-- | A variant of 'eachSample' for cases where @'SamplesFrom' ~ 'SamplesTo'@.+eachSample'+  :: EachSample' i+  => Traversal' i (SamplesFrom i)+eachSample' = eachSample

@@ -0,0 +1,80 @@+-- | Media segments with a fixed duration++{-# LANGUAGE UndecidableInstances #-}++module Data.MediaBus.Media.Segment+    ( Segment(..)+    , segmentContent+    , CanSegment(..)+    ) where++import           Data.MediaBus.Basics.Ticks+import           Data.MediaBus.Media.Media+import           Data.MediaBus.Media.Channels+import           Data.MediaBus.Media.Samples+import           Control.Lens+import           Data.Default+import           Data.Proxy+import           Test.QuickCheck+import           Control.DeepSeq+import           Text.Printf++-- | A segment is some content with a fixed (type level) duration.+newtype Segment (duration :: StaticTicks) c = MkSegment { _segmentContent :: c }+    deriving (NFData, Default, Arbitrary, Functor, Eq)++-- | An 'Iso' for the 'Segment' newtype.+segmentContent :: Iso (Segment d c) (Segment d c') c c'+segmentContent = iso _segmentContent MkSegment++instance (HasMedia c c') => HasMedia (Segment d c)  (Segment d c') where+  type MediaFrom (Segment d c) = MediaFrom c+  type MediaTo (Segment d c') = MediaTo c'+  media = segmentContent . media++instance (EachSample c c') => EachSample (Segment d c)  (Segment d c') where+  type SamplesFrom (Segment d c) = SamplesFrom c+  type SamplesTo (Segment d c') = SamplesTo c'+  eachSample = segmentContent . eachSample++instance (EachChannel c c') => EachChannel (Segment d c)  (Segment d c') where+  type ChannelsFrom (Segment d c) = ChannelsFrom c+  type ChannelsTo (Segment d c') = ChannelsTo c'+  eachChannel = segmentContent . eachChannel++instance (HasRate c) => HasRate (Segment d c) where+  type GetRate (Segment d c) = GetRate c+  type SetRate (Segment d c) r' = Segment d (SetRate c r')++instance (HasRate i, GetRate i ~ ri, SetRate i rj ~ j, KnownRate rj, CoerceRate i j ri rj) =>+      CoerceRate (Segment d i) (Segment d j) ri rj+    where+  coerceRate px (MkSegment !c) = MkSegment (coerceRate px c)++instance (HasStaticDuration d, Show c) =>+         Show (Segment d c) where+    showsPrec d (MkSegment c) =+      showParen (d > 10) $+          showString "[| "+          . shows c+          . showString (printf " |%10s]" (show (getStaticDuration (Proxy :: Proxy d))))++instance KnownStaticTicks d =>+         HasStaticDuration (Segment d x) where+    type SetStaticDuration (Segment d x) pt = Segment pt x+    type GetStaticDuration (Segment d x) = d++instance HasStaticDuration d =>+         HasDuration (Segment d x) where+    getDuration _ = getStaticDuration (Proxy :: Proxy d)++-- | Class of types that support splitting values into parts with a certain+--   duration.+class CanSegment a where+    -- | Try to split the packet into the a part which has the given+    -- duration and a rest. If it is not possible to split of the desired duration,+    --  e.g. because the input data is too short, return `Nothing`.+    splitAfterDuration :: (HasStaticDuration d)+                       => proxy d+                       -> a+                       -> Maybe (Segment d a, a)

@@ -0,0 +1,210 @@+-- | A media 'Stream' is often represented by a 'Series' of related 'Frame's+-- with a 'FrameCtx' created when the 'Stream' 'Start's. This module contains+-- the basic definitions of the building blocks of media content that is create,+-- processed, and presented by a possibly infinite 'Series' of chunks called+-- 'Frame's.+module Data.MediaBus.Media.Stream+  ( FrameCtx(..)+  , frameCtxSourceId+  , frameCtxSeqNumRef+  , frameCtxTimestampRef+  , frameCtxInit+  , EachFrameCtxInit(..)+  , Frame(..)+  , EachFrameContent(..)+  , frameSeqNum+  , frameTimestamp+  , framePayload+  , Stream(..)+  , type Streamish+  , stream+  ) where++import Control.DeepSeq (NFData)+import Control.Lens+import Data.Default+import Data.MediaBus.Basics.Sequence+import Data.MediaBus.Basics.Series+import Data.MediaBus.Basics.Ticks+import Data.MediaBus.Media.Media+import Data.MediaBus.Media.Channels+import GHC.Generics (Generic)+import Test.QuickCheck+import Text.Printf++-- | Meta information about a media stream.+data FrameCtx i s t p = MkFrameCtx+  { _frameCtxSourceId :: !i -- ^ An identifier for the stream, e.g. a track name+                           -- or an RTP SSRC+  , _frameCtxTimestampRef :: !t -- ^ The start time stamp of a stream all time+                               -- stamps in the 'Frame's are relative to this.+  , _frameCtxSeqNumRef :: !s -- ^ The start sequence number of a stream all+                            -- sequence numbers in the 'Frame's are relative to+                            -- this.+  , _frameCtxInit :: !p -- ^ An extra field for media type specific extra+                       -- information, like the init segment of an ISOBMFF+                       -- media.+  } deriving (Eq, Ord, Generic)++instance (NFData i, NFData s, NFData t, NFData p) =>+         NFData (FrameCtx i s t p)++makeLenses ''FrameCtx++-- | Class for types that have a 'Traversal' for '_frameCtxInit'+class EachFrameCtxInit s t where+  type FrameCtxInitFrom s+  type FrameCtxInitTo t+  -- | A traversal for the 'FrameCtx' initial content, skipping over any 'Frame'+  eachFrameCtxInit :: Traversal s t (FrameCtxInitFrom s) (FrameCtxInitTo t)++instance HasTimestamp (FrameCtx i s t p) where+  type GetTimestamp (FrameCtx i s t p) = t+  type SetTimestamp (FrameCtx i s t p) t' = (FrameCtx i s t' p)+  timestamp = frameCtxTimestampRef++instance HasDuration (FrameCtx i s t p) where+  getDuration _ = 0++instance HasSeqNum (FrameCtx i s t p) where+  type GetSeqNum (FrameCtx i s t p) = s+  type SetSeqNum (FrameCtx i s t p) x = FrameCtx i x t p+  seqNum = frameCtxSeqNumRef++instance (Arbitrary i, Arbitrary s, Arbitrary t, Arbitrary p) =>+         Arbitrary (FrameCtx i s t p) where+  arbitrary = MkFrameCtx <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++instance (Default i, Default s, Default t, Default p) =>+         Default (FrameCtx i s t p) where+  def = MkFrameCtx def def def def++instance (Show i, Show s, Show t, Show p) =>+         Show (FrameCtx i s t p) where+  show (MkFrameCtx sid tsr snr spr) =+    printf+      "FRAME-CTX: %15s | %15s | %15s | %s"+      (show sid)+      (show snr)+      (show tsr)+      (show spr)++-- | A 'Frame' can be anything that has a start time and is exactly one time+-- unit long, it can respresent anything ranging from an audio buffer with 20ms+-- of audio to a single pulse coded audio sample, of course it could also be a+-- video frame or a chat message.+data Frame s t c = MkFrame+  { _frameTimestamp :: !t -- ^ The timestamp at which the representation of the+                         -- media content in this frame **begins**+  , _frameSeqNum :: !s -- ^ The sequence number of that frame, useful to detect+                      -- missing frames+  , _framePayload :: !c -- ^ The actual (media) content.+  } deriving (Eq, Ord, Generic)++instance (NFData c, NFData s, NFData t) =>+         NFData (Frame s t c)++deriving instance Functor (Frame s t)++makeLenses ''Frame++-- | Class for types that have a 'Traversal' for '_framePayload'+class EachFrameContent s t where+  type FrameContentFrom s+  type FrameContentTo t+  -- | A traversal for the frame content of all 'Frame's, skipping over any+  -- 'FrameCtx'+  eachFrameContent :: Traversal s t (FrameContentFrom s) (FrameContentTo t)++instance EachFrameContent (Frame s t c) (Frame s t c') where+  type FrameContentFrom (Frame s t c) = c+  type FrameContentTo (Frame s t c') = c'+  eachFrameContent = framePayload++instance (EachChannel c c') =>+         EachChannel (Frame s t c) (Frame s t c') where+  type ChannelsFrom (Frame s t c) = c+  type ChannelsTo (Frame s t c') = c'+  eachChannel = framePayload++instance (HasMedia c c') =>+         HasMedia (Frame s t c) (Frame s t c') where+  type MediaFrom (Frame s t c) = MediaFrom c+  type MediaTo (Frame s t c') = MediaTo c'+  media = framePayload . media++instance HasTimestamp (Frame s t c) where+  type GetTimestamp (Frame s t c) = t+  type SetTimestamp (Frame s t c) t' = Frame s t' c+  timestamp = frameTimestamp++instance HasSeqNum (Frame s t c) where+  type GetSeqNum (Frame s t c) = s+  type SetSeqNum (Frame s t c) x = Frame x t c+  seqNum = frameSeqNum++instance HasDuration c =>+         HasDuration (Frame s t c) where+  getDuration = getDuration . _framePayload++instance (Arbitrary c, Arbitrary s, Arbitrary t) =>+         Arbitrary (Frame s t c) where+  arbitrary = MkFrame <$> arbitrary <*> arbitrary <*> arbitrary++instance (Default s, Default t, Default c) =>+         Default (Frame s t c) where+  def = MkFrame def def def++instance (Show s, Show t, Show v) =>+         Show (Frame s t v) where+  show (MkFrame ts sn v) =+    printf "FRAME: %15s | %15s | %s" (show sn) (show ts) (show v)++-- | A type for values that belong to a 'Series' of 'Frame's started by a+-- 'FrameCtx'. This combines the sum type 'Series' which has either 'Start' or+-- 'Next' with 'FrameCtx' and 'Frame'.+newtype Stream i s t p c = MkStream+  { _stream :: Streamish i s t p c+  } deriving (Ord, Eq, Arbitrary, Generic)++instance (NFData i, NFData s, NFData t, NFData c, NFData p) =>+         NFData (Stream i s t p c)++-- | This is the type alias that 'Stream' is a newtype wrapper of, see the+-- description of 'Stream'.+type Streamish i s t p c = Series (FrameCtx i s t p) (Frame s t c)++makeLenses ''Stream++instance EachChannel (Frame s t c) (Frame s t c') =>+         EachChannel (Stream i s t p c) (Stream i s t p c') where+  type ChannelsFrom (Stream i s t p c) = ChannelsFrom (Frame s t c)+  type ChannelsTo (Stream i s t p c') = ChannelsTo (Frame s t c')+  eachChannel = stream . _Next . eachChannel++instance HasDuration c =>+         HasDuration (Stream i s t p c) where+  getDuration = maybe 0 getDuration . preview (stream . _Next)++instance HasSeqNum (Stream i s t p c) where+  type GetSeqNum (Stream i s t p c) = s+  type SetSeqNum (Stream i s t p c) x = Stream i x t p c+  seqNum = stream . seqNum++instance HasTimestamp (Stream i s t p c) where+  type GetTimestamp (Stream i s t p c) = t+  type SetTimestamp (Stream i s t p c) t' = Stream i s t' p c+  timestamp = stream . timestamp++instance EachFrameContent (Stream i s t p c) (Stream i s t p c') where+  type FrameContentFrom (Stream i s t p c) = c+  type FrameContentTo (Stream i s t p c') = c'+  eachFrameContent = stream . _Next . framePayload++instance (Default c, Default s, Default t) =>+         Default (Stream i s t p c) where+  def = MkStream (Next (MkFrame def def def))++instance (Show i, Show s, Show t, Show c, Show p) =>+         Show (Stream i s t p c) where+  show (MkStream s) = show s

@@ -1,36 +0,0 @@-module Data.MediaBus.Monotone-    ( LocalOrd(..)-    ) where--import           Data.Word-import           Data.Int---- | Class of numbers that are monotone increasing (or decreasing) and have a--- relative order, that is not necessarily transitive.------ For example, for a series of 'Word8' values: @0 64 128 192 0 64 128 ...@--- could be interpreted as a monotone series of consecutive increasing values,--- that wrap around after 255. But note that the 'Ord' instance is not--- sufficient to express that @0@ is __after__ @192@, since @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)--instance LocalOrd Word8--instance LocalOrd Word16--instance LocalOrd Word32--instance LocalOrd Word64--instance LocalOrd Int8--instance LocalOrd Int16--instance LocalOrd Int32--instance LocalOrd Int64--instance LocalOrd Int

@@ -1,13 +0,0 @@-module Data.MediaBus.OrderedBy ( OrderedBy(..) ) where--import Data.Function (on)--data OrderedBy a = MkOrderedBy { orderedByCompare :: a -> a -> Ordering-                              , orderedByValue   :: a-                              }--instance Eq (OrderedBy a) where-    l == r = EQ == ((orderedByCompare l `on` orderedByValue) l r)--instance Ord (OrderedBy a) where-    l `compare` r = (orderedByCompare l `on` orderedByValue) l r

@@ -1,9 +0,0 @@-module Data.MediaBus.Payload ( HasPayload(..) ) where--import           Control.Lens--class (SetPayload a (GetPayload a) ~ a) =>-      HasPayload a where-    type GetPayload a-    type SetPayload a b-    payload :: Traversal a (SetPayload a b) (GetPayload a) b

@@ -1,102 +0,0 @@-{-# OPTIONS -Wno-unused-top-binds #-}-module Data.MediaBus.Reorder-    ( reorderFramesBySeqNumC-    , reorderFramesByC-    ) where--import           Data.MediaBus.Stream-import           Data.MediaBus.Sequence-import           Data.MediaBus.OrderedBy-import           Data.MediaBus.Series-import qualified Data.Set                         as Set-import           Conduit-import           Control.Lens-import           Control.Monad.State.Strict-import           Data.Function                    ( on )-import           Data.Default--data ReorderSt a b c = MkReorderSt { _expectedRank :: !a-                                   , _frameQueue   :: !(Set.Set (OrderedBy b))-                                   , _frameDrops   :: !Int-                                   , _lastFrameCtx :: !c-                                   }--makeLenses ''ReorderSt--reorderFramesBySeqNumC :: (Default s, Default i, Default t, Default p, Num s, Ord s, Monad m)-                       => Int-                       -> Conduit (Stream i s t p c) m (Stream i s t p c)-reorderFramesBySeqNumC =-    reorderFramesByC seqNum (+ 1)--reorderFramesByC :: (Monad m, Ord rank, Default i, Default t, Default s, Default p, Default rank)-                 => Lens' (Stream i s t p c) rank-                 -> (rank -> rank)-                 -> Int-                 -> Conduit (Stream i s t p c) m (Stream i s t p c)-reorderFramesByC !frameRank !getNextRank !maxQueueLen =-    evalStateC (MkReorderSt def Set.empty 0 def) go-  where-    maxDrops = maxQueueLen-    go = do-        awaitForever handleNext-        flushQueue-      where-        handleNext s@(MkStream (Start !ctx)) = do-            flushQueue-            yield s-            put (MkReorderSt (s ^. frameRank) Set.empty 0 ctx)--        handleNext !frm = do-            !expRank <- use expectedRank-            let !currRank = frm ^. frameRank-            case compare currRank expRank of-                EQ -> do-                    yieldNext frm-                    maybeYieldNextFromQueue-                LT -> do-                    -- drop the frame, it lacks behind-                    framesDropped <- frameDrops <+= 1-                    when (framesDropped == maxDrops) $ do-                        flushQueue-                        -- yield a new Start frame-                        ctx <- use lastFrameCtx-                        let start = MkStream (Start ctx) & frameRank .~-                                (frm ^. frameRank)-                            MkStream (Start ctx') = start-                        lastFrameCtx .= ctx'-                        yield start-                        yieldNext frm--                GT -> do-                    frameQueue %= Set.insert (MkOrderedBy rankCmp frm)-                    maybeYieldNextFromQueue--        yieldNext !frm = do-            expectedRank .= frm ^. frameRank-            updateExpectedRank-            frameDrops .= 0-            yield frm--        flushQueue = do-            !q <- frameQueue <<.= Set.empty-            mapM_ (yieldNext . orderedByValue) (Set.toAscList q)--        maybeYieldNextFromQueue = do-            !q <- use frameQueue-            !expRank <- use expectedRank-            case Set.minView q of-                Nothing -> return ()-                Just (MkOrderedBy _ !candidate, !q') ->-                    let !currRank = candidate ^. frameRank-                        !isQueueFull = Set.size q == maxQueueLen-                        !isNextInQueue = currRank <= expRank-                    in-                        when (isQueueFull || isNextInQueue) $ do-                            frameQueue .= q'-                            yieldNext candidate-                            maybeYieldNextFromQueue--        updateExpectedRank = expectedRank %= getNextRank--        rankCmp = compare `on` view frameRank

@@ -1,158 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}--module Data.MediaBus.Sample-    ( SampleBuffer(..)-    , sampleBufferFromByteString-    , byteStringFromSampleBuffer-    , sampleBufferToList-    , sampleBufferFromList-    , sampleVector-    , createSampleBufferFrom-    , HasSampleBuffer(..)-    , type GetSampleBuffer-    , mutateSamples-    , unsafeMutateSamples-    ) where--import           Control.Lens-import qualified Data.Vector.Storable            as SV-import           Data.Vector.Storable.Mutable    as M-import           Control.Monad.ST                ( ST, runST )-import           GHC.Exts                        ( IsList(..) )-import           Data.Typeable-import           Data.MediaBus.BlankMedia-import           Data.MediaBus.Segment-import           Data.MediaBus.Ticks-import qualified Data.ByteString                 as B-import qualified Data.Vector.Storable.ByteString as Spool-import           Data.Default-import           GHC.Generics                    ( Generic )-import           Control.DeepSeq---- | A sample is a discrete value of a continuous signal, periodically sampled--- at the sampling frequency. This is a full buffer of those things.-newtype SampleBuffer sampleType =-      MkSampleBuffer { _sampleVector :: SV.Vector sampleType }-    deriving (Eq, Monoid, Generic)--instance NFData sampleType =>-         NFData (SampleBuffer sampleType)--instance (SV.Storable sampleType, Typeable sampleType, Show sampleType) =>-         Show (SampleBuffer sampleType) where-    show (MkSampleBuffer sampleVec) =-        let l = SV.length sampleVec-            sampleTypeRep = typeRep (Proxy :: Proxy sampleType)-            samples = SV.toList sampleVec-        in-            "SampleBuffer: " ++-                show l ++-                    " × " ++-                        show sampleTypeRep ++-                            if l > 10 then "" else " " ++ show samples--makeLenses ''SampleBuffer--instance (CanBeBlank sa, SV.Storable sa, HasDuration (Proxy sa)) =>-         CanGenerateBlankMedia (SampleBuffer sa) where-    blankFor !dur = let !sampleDuration = getDuration (Proxy :: Proxy sa)-                        !samples = ceiling (dur / sampleDuration)-                        !blankSample = blank-                    in-                        MkSampleBuffer (SV.replicate samples blankSample)--instance SV.Storable sampleType =>-         Default (SampleBuffer sampleType) where-    def = mempty--instance (HasDuration (Proxy sampleType), SV.Storable sampleType) =>-         HasDuration (SampleBuffer sampleType) where-    getDuration sb = let sampleDur = getDuration (Proxy :: Proxy sampleType)-                     in-                         sampleDur * fromIntegral (sampleCount sb)-    getDurationTicks sb = getDurationTicks (Proxy :: Proxy sampleType) *-        fromIntegral (sampleCount sb)--instance (SV.Storable a, HasDuration (Proxy a)) =>-         CanSegment (SampleBuffer a) where-    splitAfterDuration proxy buf@(MkSampleBuffer !bufV)-        | getDuration buf >= tPacket =-              let (!nextPacket, !rest) = SV.splitAt n bufV--              in-                  Just ( MkSegment (MkSampleBuffer (SV.force nextPacket))-                       , MkSampleBuffer rest-                       )-        | otherwise = Nothing-      where-        !tPacket = getStaticDuration proxy-        !n = ceiling (tPacket / tSample)-        !tSample = getDuration (Proxy :: Proxy a)--instance SV.Storable s =>-         IsList (SampleBuffer s) where-    type Item (SampleBuffer s) = s-    fromList = sampleBufferFromList-    toList = sampleBufferToList--sampleBufferFromByteString :: SV.Storable a => B.ByteString -> SampleBuffer a-sampleBufferFromByteString =-    MkSampleBuffer . Spool.byteStringToVector--byteStringFromSampleBuffer :: SV.Storable a => SampleBuffer a -> B.ByteString-byteStringFromSampleBuffer =-    Spool.vectorToByteString . _sampleVector--sampleBufferToList :: SV.Storable s => SampleBuffer s -> [s]-sampleBufferToList = SV.toList . _sampleVector--sampleBufferFromList :: SV.Storable s => [s] -> SampleBuffer s-sampleBufferFromList = MkSampleBuffer . SV.fromList--createSampleBufferFrom :: (SV.Storable sample')-                       => (forall s.-                           SV.Vector sample -> ST s (MVector s sample'))-                       -> SampleBuffer sample-                       -> SampleBuffer sample'-createSampleBufferFrom f =-    over sampleVector (\ !v -> SV.create (f v))---- | A type class for media formats, like encodings, sample rate, etc...-class (SV.Storable (GetSampleType s), SetSampleType s (GetSampleType s) ~ s) =>-      HasSampleBuffer s where-    type SetSampleType s t-    type GetSampleType s-    sampleCount :: s -> Int-    eachSample :: SV.Storable t-               => Traversal s (SetSampleType s t) (GetSampleType s) t-    sampleBuffer :: SV.Storable t-                 => Lens s (SetSampleType s t) (SampleBuffer (GetSampleType s)) (SampleBuffer t)--type GetSampleBuffer s = SampleBuffer (GetSampleType s)--instance SV.Storable a =>-         HasSampleBuffer (SampleBuffer a) where-    type GetSampleType (SampleBuffer a) = a-    type SetSampleType (SampleBuffer a) t = SampleBuffer t-    sampleCount = SV.length . _sampleVector-    eachSample = sampleBuffer . sampleVector . each-    sampleBuffer = lens id (flip const)--mutateSamples :: SV.Storable a-              => (forall s. M.MVector s a -> ST s ())-              -> SampleBuffer a-              -> SampleBuffer a-mutateSamples f (MkSampleBuffer v) =-    MkSampleBuffer (SV.modify f v)---- | Unsafe because results can be returned, which might contain the /thawn/ vector.-unsafeMutateSamples :: SV.Storable a-                    => (forall s. M.MVector s a -> ST s r)-                    -> SampleBuffer a-                    -> (r, SampleBuffer a)-unsafeMutateSamples f (MkSampleBuffer !v) =-    runST $ do-        !mv <- SV.unsafeThaw v-        !r <- f mv-        !v' <- SV.unsafeFreeze mv-        return (r, MkSampleBuffer v')

@@ -1,49 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}--module Data.MediaBus.Segment-    ( CanSegment(..)-    , Segment(..)-    , segmentContent-    ) where--import           Data.MediaBus.Ticks-import           Control.Lens-import           Data.Default-import           Data.Proxy-import           Test.QuickCheck-import           Control.DeepSeq-import           Text.Printf---- | A segment is some content with a fixed (type level) duration.-newtype Segment (duration :: StaticTicks) c = MkSegment { _segmentContent :: c }-    deriving (NFData, Default, Arbitrary, Functor, Eq)--instance (HasStaticDuration d, Show c) =>-         Show (Segment d c) where-    show (MkSegment c) = printf "[| %s |%10s]"-                                (show c)-                                (show (getStaticDuration (Proxy :: Proxy d)))--makeLenses ''Segment--instance KnownStaticTicks d =>-         HasStaticDuration (Segment d x) where-    type SetStaticDuration (Segment d x) pt = Segment pt x-    type GetStaticDuration (Segment d x) = d--instance HasStaticDuration d =>-         HasDuration (Segment d x) where-    getDuration _ = getStaticDuration (Proxy :: Proxy d)---- | Class of types that support splitting of from the front a packet containing--- roughly a certain duration.-class CanSegment a where-    -- | Try to split the packet into the a part which has at most the given-    -- duration and a rest. If not possible, e.g. because the input data is-    -- already shorter than the given duration, return `Nothing`.-    splitAfterDuration :: (HasStaticDuration d)-                       => proxy d-                       -> a-                       -> Maybe (Segment d a, a)-- TODO make the repacketization create ONLY valid sized packets, even if that means dropping content-                                                       -- TODO allow repacketization to combine the packets-                                                       -- TODO use 'Segment' to automatically derive the ptime

@@ -1,94 +0,0 @@-module Data.MediaBus.Sequence-    ( SeqNum(..)-    , type SeqNum8-    , type SeqNum16-    , type SeqNum32-    , type SeqNum64-    , HasSeqNumT(..)-    , HasSeqNum(..)-    , fromSeqNum-    , synchronizeToSeqNum-    ) where--import           Test.QuickCheck            ( Arbitrary(..) )-import           Conduit-import           Data.MediaBus.Monotone-import           Data.MediaBus.Series-import           Control.Lens-import           Control.Monad.State.Strict-import           Data.Default-import           Text.Printf-import           GHC.Generics               ( Generic )-import           Control.DeepSeq-import           System.Random-import           Data.Word--class SetSeqNum t (GetSeqNum t) ~ t =>-      HasSeqNumT t where-    type GetSeqNum t-    type SetSeqNum t s--class HasSeqNumT t =>-      HasSeqNum t where-    seqNum :: Lens t (SetSeqNum t s) (GetSeqNum t) s--instance (HasSeqNumT a, HasSeqNumT b, GetSeqNum a ~ GetSeqNum b) =>-         HasSeqNumT (Series a b) where-    type GetSeqNum (Series a b) = GetSeqNum a-    type SetSeqNum (Series a b) t = Series (SetSeqNum a t) (SetSeqNum b t)--instance (HasSeqNum a, HasSeqNum b, GetSeqNum a ~ GetSeqNum b) =>-         HasSeqNum (Series a b) where-    seqNum f (Start !a) = Start <$> seqNum f a-    seqNum f (Next !b) = Next <$> seqNum f b--newtype SeqNum s = MkSeqNum { _fromSeqNum :: s }-    deriving (Num, Eq, Bounded, Enum, LocalOrd, Arbitrary, Default, Generic, Random)--type SeqNum8 = SeqNum Word8--type SeqNum16 = SeqNum Word16--type SeqNum32 = SeqNum Word32--type SeqNum64 = SeqNum Word64--instance NFData s =>-         NFData (SeqNum s)--makeLenses ''SeqNum--instance HasSeqNumT (SeqNum s) where-    type GetSeqNum (SeqNum s) = s-    type SetSeqNum (SeqNum s) s' = SeqNum s'--instance HasSeqNum (SeqNum s) where-    seqNum = fromSeqNum--instance Show s =>-         Show (SeqNum s) where-    show (MkSeqNum s) = printf "SEQNUM: %10s" (show s)--instance (Eq a, LocalOrd a) =>-         Ord (SeqNum a) where-    compare !x !y-        | x == y = EQ-        | x `succeeds` y = GT-        | otherwise = LT--deriving instance (Real a, Num a, Eq a, LocalOrd a) => Real-         (SeqNum a)--deriving instance (Integral a, Enum a, Real a, Eq a, LocalOrd a) =>-         Integral (SeqNum a)--synchronizeToSeqNum :: (HasSeqNum a, Monad m, Integral i)-                    => i-                    -> Conduit a m (SetSeqNum a i)-synchronizeToSeqNum startSeq =-    evalStateC startSeq (awaitForever yieldSeq)-  where-    yieldSeq !a = do-        !nextSeq <- get-        modify (+ 1)-        yield (a & seqNum .~ nextSeq)

@@ -1,135 +0,0 @@-module Data.MediaBus.Series-    ( Series(..)-    , type Series'-    , _Next-    , _Start-    , AsSeries(..)-    , AsSeriesStart(..)-    , AsSeriesNext(..)-    , StartingFrom(..)-    , startingFromValue-    , toNextsC'-    , toStartsC'-    , monotoneSeriesC-    ) where--import           Control.Lens-import           Conduit-import           Control.Monad.Reader-import           Test.QuickCheck-import           Data.Bifunctor-import           GHC.Generics         ( Generic )-import           Control.DeepSeq--class (SetSeriesStart s (GetSeriesStart s) ~ s) =>-      AsSeriesStart s where-    type GetSeriesStart s-    type SetSeriesStart s t-    seriesStart :: Prism s (SetSeriesStart s n) (GetSeriesStart s) n--class (SetSeriesNext s (GetSeriesNext s) ~ s) =>-      AsSeriesNext s where-    type GetSeriesNext s-    type SetSeriesNext s t-    seriesNext :: Prism s (SetSeriesNext s n) (GetSeriesNext s) n--class AsSeries s a b | s -> a, s -> b where-    seriesStart' :: Prism' s a-    seriesNext' :: Prism' s b--instance AsSeries (Either a b) a b where-    seriesStart' = _Left-    seriesNext' = _Right--instance AsSeriesStart (Either a b) where-    type GetSeriesStart (Either a b) = a-    type SetSeriesStart (Either a b) n = (Either n b)-    seriesStart = _Left--instance AsSeriesNext (Either a b) where-    type GetSeriesNext (Either a b) = b-    type SetSeriesNext (Either a b) n = (Either a n)-    seriesNext = _Right--data Series a b = Next { _seriesValue :: !b }-                | Start { _seriesStartValue :: !a }-    deriving (Eq, Generic)--instance (NFData a, NFData b) =>-         NFData (Series a b)--instance (Show a, Show b) =>-         Show (Series a b) where-    show (Start !x) = "(START: " ++ show x ++ ")"-    show (Next !x) = show x--instance (Ord a, Ord b) =>-         Ord (Series a b) where-    compare (Next !l) (Next !r) =-        compare l r-    compare _ _ = EQ--type Series' a = Series a a--instance (Arbitrary a, Arbitrary b) =>-         Arbitrary (Series a b) where-    arbitrary = do-        isNext <- choose (0.0, 1.0)-        if isNext < (0.95 :: Double)-            then Next <$> arbitrary-            else Start <$> arbitrary--makePrisms ''Series--instance AsSeries (Series a b) a b where-    seriesNext' = _Next-    seriesStart' = _Start--instance AsSeriesNext (Series a b) where-    type GetSeriesNext (Series a b) = b-    type SetSeriesNext (Series a b) n = (Series a n)-    seriesNext = _Next--instance AsSeriesStart (Series a b) where-    type GetSeriesStart (Series a b) = a-    type SetSeriesStart (Series a b) n = (Series n b)-    seriesStart = _Start--instance Functor (Series a) where-    fmap = over _Next--instance Bifunctor Series where-    first = over _Start-    second = over _Next--newtype StartingFrom a = MkStartingFrom { _startingFromValue :: a }-    deriving (Eq, Ord, Arbitrary)--makeLenses ''StartingFrom--instance Show a =>-         Show (StartingFrom a) where-    show (MkStartingFrom !x) =-        "(STARTING-FROM: " ++ show x ++ ")"--toNextsC' :: Monad m => Conduit (Series a b) m b-toNextsC' = awaitForever go-  where-    go (Start !_a) = return ()-    go (Next !b) = yield b--toStartsC' :: Monad m => Conduit (Series a b) m a-toStartsC' = awaitForever go-  where-    go (Start !a) = yield a-    go (Next !_b) = return ()--monotoneSeriesC :: Monad m => m a -> (i -> m b) -> Conduit i m (Series a b)-monotoneSeriesC !initSeries !continueSeries = do-    !rStart <- lift initSeries-    yield (Start rStart)-    !mi <- await-    mapM_ (lift . continueSeries >=>-               yield . Next >=>-                   const (awaitForever (lift . continueSeries >=> yield . Next)))-          mi

@@ -1,37 +0,0 @@-module Data.MediaBus.SourceId-    ( HasSourceIdT(..)-    , SourceId(..)-    , type SrcId32-    , type SrcId64-    , sourceId-    ) where--import           Control.Lens-import           Test.QuickCheck-import           Data.Default-import           GHC.Generics    ( Generic )-import           Control.DeepSeq-import           Data.Word--class SetSourceId a (GetSourceId a) ~ a =>-      HasSourceIdT a where-    type GetSourceId a-    type SetSourceId a b---- | Things that can be uniquely identified by a looking at a (much simpler)--- representation, the 'identity'.-newtype SourceId i = MkSourceId { _sourceId :: i }-    deriving (Eq, Arbitrary, Default, Ord, Generic)--type SrcId32 = SourceId Word32--type SrcId64 = SourceId Word64--instance (NFData i) =>-         NFData (SourceId i)--makeLenses ''SourceId--instance Show i =>-         Show (SourceId i) where-    show (MkSourceId x) = "SOURCE-ID: " ++ show x

@@ -1,302 +0,0 @@-module Data.MediaBus.Stream-    ( HasPayload(..)-    , FrameCtx(..)-    , frameCtxSourceId-    , frameCtxSeqNumRef-    , frameCtxTimestampRef-    , frameCtxInit-    , Frame(..)-    , frameSeqNum-    , frameTimestamp-    , framePayload-    , Stream(..)-    , stream-    , yieldStreamish-    , yieldStreamish'-    , yieldNextFrame-    , yieldNextFrame'-    , yieldStartFrameCtx-    , yieldStartFrameCtx'-    , toFramesC-    , overStreamC-    , mapFramesC-    , mapFramesC'-    , mapSeqNumC-    , mapTicksC-    , mapTicksC'-    , mapPayloadMC-    , mapPayloadMC'-    , mapPayloadC'-    , convertTicksC'-    , foldStream-    , foldStreamM-    , concatStreamContents-    ) where--import           Conduit-import           Control.Monad-import           Control.Lens-import           Data.MediaBus.Sequence-import           Data.MediaBus.Payload-import           Data.MediaBus.Ticks-import           Data.MediaBus.Series-import           Control.Monad.Writer.Strict ( tell )-import           Data.Maybe-import           Test.QuickCheck-import           Data.Default-import           Text.Printf-import           GHC.TypeLits-import           GHC.Generics                ( Generic )-import           Control.Parallel.Strategies ( NFData, rdeepseq, withStrategy )---- TODO remove Ticks' or create Ticks32/64/...-data FrameCtx i s t p = MkFrameCtx { _frameCtxSourceId     :: !i-                                   , _frameCtxTimestampRef :: !t-                                   , _frameCtxSeqNumRef    :: !s-                                   , _frameCtxInit         :: !p-                                   }-    deriving (Eq, Ord, Generic)--instance (NFData i, NFData s, NFData t, NFData p) =>-         NFData (FrameCtx i s t p)--makeLenses ''FrameCtx--instance HasTimestampT (FrameCtx i s t p) where-    type GetTimestamp (FrameCtx i s t p) = t-    type SetTimestamp (FrameCtx i s t p) t' = (FrameCtx i s t' p)--instance HasTimestamp (FrameCtx i s t p) where-    timestamp = frameCtxTimestampRef--instance HasSeqNumT (FrameCtx i s t p) where-    type GetSeqNum (FrameCtx i s t p) = s-    type SetSeqNum (FrameCtx i s t p) x = FrameCtx i x t p--instance HasDuration (FrameCtx i s t p) where-    getDuration _ = 0--instance HasSeqNum (FrameCtx i s t p) where-    seqNum = frameCtxSeqNumRef--instance (Arbitrary i, Arbitrary s, Arbitrary t, Arbitrary p) =>-         Arbitrary (FrameCtx i s t p) where-    arbitrary = MkFrameCtx <$> arbitrary-                           <*> arbitrary-                           <*> arbitrary-                           <*> arbitrary--instance (Default i, Default s, Default t, Default p) =>-         Default (FrameCtx i s t p) where-    def = MkFrameCtx def def def def--instance (Show i, Show s, Show t, Show p) =>-         Show (FrameCtx i s t p) where-    show (MkFrameCtx sid tsr snr spr) =-        printf "FRAME-CTX: %15s | %15s | %15s | %s"-               (show sid)-               (show snr)-               (show tsr)-               (show spr)---- | A 'Frame' can be anything that has a start time and is exactly one time--- unit long, it can respresent anything ranging from an audio buffer with 20ms--- of audio to a single pulse coded audio sample, of course it could also be a--- video frame or a chat message.-data Frame s t c = MkFrame { _frameTimestamp :: !t-                           , _frameSeqNum    :: !s-                           , _framePayload   :: !c-                           }-    deriving (Eq, Ord, Generic)--instance (NFData c, NFData s, NFData t) =>-         NFData (Frame s t c)--deriving instance Functor (Frame s t)--makeLenses ''Frame--instance HasPayload (Frame s t c) where-    type GetPayload (Frame s t c) = c-    type SetPayload (Frame s t c) d = Frame s t d-    payload = framePayload--instance HasTimestampT (Frame s t c) where-    type GetTimestamp (Frame s t c) = t-    type SetTimestamp (Frame s t c) t' = Frame s t' c--instance HasTimestamp (Frame s t c) where-    timestamp = frameTimestamp--instance HasSeqNumT (Frame s t c) where-    type GetSeqNum (Frame s t c) = s-    type SetSeqNum (Frame s t c) x = Frame x t c--instance HasSeqNum (Frame s t c) where-    seqNum = frameSeqNum--instance HasDuration c =>-         HasDuration (Frame s t c) where-    getDuration = getDuration . _framePayload--instance (Arbitrary c, Arbitrary s, Arbitrary t) =>-         Arbitrary (Frame s t c) where-    arbitrary = MkFrame <$> arbitrary <*> arbitrary <*> arbitrary--instance (Default s, Default t, Default c) =>-         Default (Frame s t c) where-    def = MkFrame def def def--instance (Show s, Show t, Show v) =>-         Show (Frame s t v) where-    show (MkFrame ts sn v) =-        printf "FRAME: %15s | %15s | %s" (show sn) (show ts) (show v)--newtype Stream i s t p c = MkStream { _stream :: Streamish i s t p c }-    deriving (Ord, Eq, Arbitrary, Generic)--instance (NFData i, NFData s, NFData t, NFData c, NFData p) =>-         NFData (Stream i s t p c)--type Streamish i s t p c = Series (FrameCtx i s t p) (Frame s t c)--makeLenses ''Stream--instance HasPayload (Stream i s t p c) where-    type GetPayload (Stream i s t p c) = c-    type SetPayload (Stream i s t p c) d = Stream i s t p d-    payload = stream . _Next . payload--instance HasDuration c =>-         HasDuration (Stream i s t p c) where-    getDuration = maybe 0 getDuration . preview (stream . _Next)--instance HasSeqNumT (Stream i s t p c) where-    type GetSeqNum (Stream i s t p c) = s-    type SetSeqNum (Stream i s t p c) x = Stream i x t p c--instance HasSeqNum (Stream i s t p c) where-    seqNum = stream . seqNum--instance HasTimestampT (Stream i s t p c) where-    type GetTimestamp (Stream i s t p c) = t-    type SetTimestamp (Stream i s t p c) t' = Stream i s t' p c--instance HasTimestamp (Stream i s t p c) where-    timestamp = stream . timestamp--instance (Default c, Default s, Default t) =>-         Default (Stream i s t p c) where-    def = MkStream (Next (MkFrame def def def))--instance (Show i, Show s, Show t, Show c, Show p) =>-         Show (Stream i s t p c) where-    show (MkStream s) = show s--yieldStreamish :: Monad m-               => Streamish i s t p c-               -> Conduit a m (Stream i s t p c)-yieldStreamish = yield . MkStream--yieldStreamish' :: (NFData i, NFData s, NFData t, NFData c, NFData p, Monad m)-                => Streamish i s t p c-                -> Conduit a m (Stream i s t p c)-yieldStreamish' = yield . withStrategy rdeepseq . MkStream--yieldNextFrame :: Monad m => Frame s t c -> Conduit a m (Stream i s t p c)-yieldNextFrame = yieldStreamish . Next--yieldNextFrame' :: (NFData i, NFData s, NFData t, NFData c, NFData p, Monad m)-                => Frame s t c-                -> Conduit a m (Stream i s t p c)-yieldNextFrame' = yieldStreamish' . Next--yieldStartFrameCtx :: Monad m-                   => FrameCtx i s t p-                   -> Conduit a m (Stream i s t p c)-yieldStartFrameCtx = yieldStreamish . Start--yieldStartFrameCtx' :: (NFData i, NFData s, NFData t, NFData c, NFData p, NFData (FrameCtx i s t p), Monad m)-                    => FrameCtx i s t p-                    -> Conduit a m (Stream i s t p c)-yieldStartFrameCtx' = yieldStreamish' . Start--overStreamC :: Monad m-            => Conduit (Series (FrameCtx i s t p) (Frame s t c)) m (Series (FrameCtx i' s' t' p') (Frame s' t' c'))-            -> Conduit (Stream i s t p c) m (Stream i' s' t' p' c')-overStreamC = mapInput _stream (Just . MkStream) . mapOutput MkStream--toFramesC :: Monad m => Conduit (Stream i s t p c) m (Frame s t c)-toFramesC = awaitForever go-  where-    go (MkStream (Start _)) =-        return ()-    go (MkStream (Next !frm)) =-        yield frm--mapFramesC' :: (NFData i, NFData s, NFData t, NFData c', Monad m)-            => (Frame s t c -> Frame s t c')-            -> Conduit (Stream i s t p c) m (Stream i s t p c')-mapFramesC' !f = mapC (over (stream . _Next) (withStrategy rdeepseq f))--mapFramesC :: Monad m-           => (Frame s t c -> m (Frame s t c'))-           -> Conduit (Stream i s t p c) m (Stream i s t p c')-mapFramesC !f = mapMC (mapMOf (stream . _Next) f)--mapSeqNumC :: Monad m-           => (s -> s')-           -> Conduit (Stream i s t p c) m (Stream i s' t p c)-mapSeqNumC = mapC . over seqNum--mapTicksC :: Monad m-          => (t -> t')-          -> Conduit (Stream i s t p c) m (Stream i s t' p c)-mapTicksC = mapC . over timestamp--mapTicksC' :: (NFData t, Monad m)-           => (t -> t')-           -> Conduit (Stream i s t p c) m (Stream i s t' p c)-mapTicksC' = mapC . withStrategy rdeepseq . over timestamp--mapPayloadMC :: Monad m-             => (c -> m c')-             -> Conduit (Stream i s t p c) m (Stream i s t p c')-mapPayloadMC = mapMC . mapMOf payload--mapPayloadMC' :: (NFData (Stream i s t p c'), Monad m)-              => (c -> m c')-              -> Conduit (Stream i s t p c) m (Stream i s t p c')-mapPayloadMC' !f = mapMC (mapMOf payload f >=> return . withStrategy rdeepseq)--mapPayloadC' :: (NFData c', Monad m)-             => (c -> c')-             -> Conduit (Stream i s t p c) m (Stream i s t p c')-mapPayloadC' !f = mapC (over payload (withStrategy rdeepseq . f))--convertTicksC' :: forall proxy0 proxy1 m r t r' t' i s c p.-               (NFData t, NFData t', KnownNat r, KnownNat r', Integral t, Integral t', Monad m, NFData t')-               => proxy0 '(r, t)-               -> proxy1 '(r', t')-               -> Conduit (Stream i s (Ticks r t) p c) m (Stream i s (Ticks r' t') p c)-convertTicksC' _ _ = mapTicksC' convertTicks--foldStream :: (Monoid o, Monad m)-           => (Stream i s t p c -> o)-           -> Sink (Stream i s t p c) m o-foldStream !f = execWriterC $-    awaitForever $-        tell .-            f--foldStreamM :: (Monoid o, Monad m)-            => (Stream i s t p c -> m o)-            -> Sink (Stream i s t p c) m o-foldStreamM !f = execWriterC $-    awaitForever (lift . lift . f >=> tell)--concatStreamContents :: (Monoid c, Monad m) => Sink (Stream i s t p c) m c-concatStreamContents = foldStream (fromMaybe mempty .-                                       (^? stream .-                                               _Next .-                                                   framePayload))

@@ -1,59 +0,0 @@-module Data.MediaBus.StreamSegment-    ( segmentC-    , segmentC'-    ) where--import           Conduit-import           Data.Monoid-import           Data.MediaBus.Stream-import           Data.MediaBus.Ticks-import           Data.MediaBus.Segment-import           Control.Lens-import           Data.Default-import           Data.MediaBus.Series-import           Data.Proxy-import           GHC.TypeLits---- | The packetizer recombines incoming packets into 'Segment's of the given--- size. The sequence numbers will be offsetted by the number extra frames--- generated.-segmentC :: (Num s, Monad m, HasDuration c, CanSegment c, Monoid c, Default i, KnownNat r, Integral t, HasStaticDuration d)-         => Conduit (Stream i s (Ticks r t) p c) m (Stream i s (Ticks r t) p (Segment d c))-segmentC = segmentC' Proxy--segmentC' :: (Num s, Monad m, HasDuration c, CanSegment c, Monoid c, Default i, KnownNat r, Integral t, HasStaticDuration d)-          => proxy d-          -> Conduit (Stream i s (Ticks r t) p c) m (Stream i s (Ticks r t) p (Segment d c))-segmentC' dpx = evalStateC (0, Nothing) $ awaitForever go-  where-    segmentDurationInTicks =-        nominalDiffTime # segmentDuration-    segmentDuration = getStaticDuration dpx-    go (MkStream (Next (MkFrame !t !s !cIn))) = do-        !cRest <- _2 <<.= Nothing-        let tsOffset = negate (getDurationTicks cRest)-        !cRest' <- yieldLoop (maybe cIn (<> cIn) cRest) tsOffset-        _2 .= cRest'-      where-        yieldLoop !c !timeOffset =-            if getDuration c == segmentDuration-            then do-                yieldWithAdaptedSeqNumAndTimestamp (MkSegment c)-                return Nothing-            else case splitAfterDuration dpx c of-                Just (!packet, !rest) -> do-                    yieldWithAdaptedSeqNumAndTimestamp packet-                    _1 += 1-                    yieldLoop rest (timeOffset + segmentDurationInTicks)-                Nothing -> do-                    -- we just swallowed an incoming packet, therefore we need-                    -- to decrease the seqnums-                    _1 -=-                        1-                    return (Just c)-          where-            yieldWithAdaptedSeqNumAndTimestamp !p = do-                !seqNumOffset <- use _1-                yieldNextFrame (MkFrame (t + timeOffset) (s + seqNumOffset) p)-    go (MkStream (Start !frmCtx)) =-        yieldStartFrameCtx frmCtx

@@ -1,231 +0,0 @@-module Data.MediaBus.Ticks-    ( HasDuration(..)-    , HasTimestampT(..)-    , HasTimestamp(..)-    , Ticks(..)-    , type Ticks32-    , type Ticks64-    , type Ticks32At8000-    , type Ticks32At16000-    , type Ticks32At48000-    , type Ticks64At8000-    , type Ticks64At16000-    , type Ticks64At48000-    , mkTicks-    , at8kHzU32-    , at16kHzU32-    , at48kHzU32-    , at16kHzU64-    , at48kHzU64-    , nominalDiffTime-    , convertTicks-    , deriveFrameTimestamp-    , StaticTicks(..)-    , KnownStaticTicks(..)-    , Rate(..)-    , type (:@)-    , type StaticTicksRate-    , type StaticTicksTicks-    , HasStaticDuration(..)-    , toStaticDurationProxy-    , getStaticDuration-    , getStaticTicks-    , getStaticRate-    , ticksFromStaticDuration-    , rateFromStaticDuration-    ) where--import           Conduit-import           Control.Lens-import           Control.Monad.State.Strict-import           Data.Default-import           Data.MediaBus.Monotone-import           Data.MediaBus.Series-import           Data.Proxy-import           Data.Time.Clock-import           Data.Word-import           GHC.TypeLits-import           Test.QuickCheck-import           GHC.Generics               ( Generic )-import           Control.DeepSeq-import           System.Random-import Text.Printf--newtype Ticks (rate :: Nat) w = MkTicks { _ticks :: w }-    deriving (Eq, Real, Integral, Enum, LocalOrd, Num, Arbitrary, Default, Generic, Random)--type Ticks32 r = Ticks r Word32-type Ticks64 r = Ticks r Word64--type Ticks32At8000 = Ticks32 8000-type Ticks32At16000 = Ticks32 16000-type Ticks32At48000 = Ticks32 48000--type Ticks64At8000 = Ticks64 8000-type Ticks64At16000 = Ticks64 16000-type Ticks64At48000 = Ticks64 48000--instance NFData w =>-         NFData (Ticks rate w)--mkTicks :: forall proxy rate baseType.-        proxy '(rate, baseType)-        -> baseType-        -> Ticks rate baseType-mkTicks _ = MkTicks--at8kHzU32 :: Proxy '(8000, Word32)-at8kHzU32 = Proxy--at16kHzU32 :: Proxy '(16000, Word32)-at16kHzU32 = Proxy--at48kHzU32 :: Proxy '(48000, Word32)-at48kHzU32 = Proxy--at16kHzU64 :: Proxy '(16000, Word64)-at16kHzU64 = Proxy--at48kHzU64 :: Proxy '(48000, Word64)-at48kHzU64 = Proxy--convertTicks :: (Integral w, Integral w', KnownNat r, KnownNat r')-             => Ticks r w-             -> Ticks r' w'-convertTicks = view (from nominalDiffTime) . view nominalDiffTime--nominalDiffTime :: forall r w.-                (Integral w, KnownNat r)-                => Iso' (Ticks r w) NominalDiffTime-nominalDiffTime = iso (toNDT . _ticks) (MkTicks . fromNDT)-  where-    toNDT = (/ rate) . fromIntegral-    fromNDT = round . (* rate)-    rate = fromInteger $ natVal (Proxy :: Proxy r)--instance (KnownNat r, Integral w, Show w) =>-         Show (Ticks r w) where-    show tix@(MkTicks x) =-      printf "%10s (%10d @ %10d Hz)"-             (show (view nominalDiffTime tix))-             (toInteger x)-             (natVal (Proxy :: Proxy r))--instance (Eq w, LocalOrd w) =>-         Ord (Ticks rate w) where-    (<=) = flip succeeds---- | Types with a duration (e.g. audio samples).-class HasDuration a where-    getDuration :: a -> NominalDiffTime-    getDuration !x = from nominalDiffTime #-        (getDurationTicks x :: Ticks 1000000000000 Integer)-    getDurationTicks :: (Integral i, KnownNat r) => a -> Ticks r i-    getDurationTicks !x = nominalDiffTime # getDuration x--instance HasDuration a => HasDuration (Maybe a) where-  getDuration Nothing = 0-  getDuration (Just !a) = getDuration a-  getDurationTicks Nothing = 0-  getDurationTicks (Just !a) = getDurationTicks a---- TODO rename *Timestamp to *Tick-class SetTimestamp t (GetTimestamp t) ~ t =>-      HasTimestampT t where-    type GetTimestamp t-    type SetTimestamp t s--class HasTimestampT t -- TODO inline HasTimestampT again-       =>-      HasTimestamp t where-    timestamp :: Lens t (SetTimestamp t s) (GetTimestamp t) s-    timestamp' :: Lens' t (GetTimestamp t)-    timestamp' = timestamp--instance (HasTimestampT a, HasTimestampT b, GetTimestamp a ~ GetTimestamp b) =>-         HasTimestampT (Series a b) where-    type GetTimestamp (Series a b) = GetTimestamp a-    type SetTimestamp (Series a b) t = Series (SetTimestamp a t) (SetTimestamp b t)--instance (HasTimestamp a, HasTimestamp b, GetTimestamp a ~ GetTimestamp b) =>-         HasTimestamp (Series a b) where-    timestamp f (Start a) = Start <$> timestamp f a-    timestamp f (Next b) = Next <$> timestamp f b---- * Media Data Synchronization-deriveFrameTimestamp :: (Monad m, KnownNat r, Integral t, HasDuration a, HasTimestamp a)-                     => Ticks r t-                     -> Conduit a m (SetTimestamp a (Ticks r t))-deriveFrameTimestamp t0 =-    evalStateC t0 (awaitForever yieldSync)-  where-    yieldSync sb = do-        t <- get-        modify (+ (nominalDiffTime # getDuration sb))-        yield (sb & timestamp .~ t)--data StaticTicks where-  MkStaticTicks :: Nat -> Rate -> StaticTicks--data Rate = MkRate Nat--type ticks :@ rate = 'MkStaticTicks ticks ('MkRate rate)--instance (KnownNat r, KnownNat t) =>-         HasStaticDuration (t :@ r) where-    type SetStaticDuration (t :@ r) (t' :@ r') =  t' :@ r'-    type GetStaticDuration (t :@ r) = t :@ r--type family StaticTicksRate (s :: StaticTicks) :: Nat where-        StaticTicksRate (t :@ r) = r--type family StaticTicksTicks (s :: StaticTicks) :: Nat where-        StaticTicksTicks (t :@ r) = t--class KnownStaticTicks (s :: StaticTicks) where-    staticTicksVal :: KnownNat r => proxy s -> Ticks r Integer--instance (KnownNat d, KnownNat r) => KnownStaticTicks ('MkStaticTicks d ('MkRate r)) where-    staticTicksVal _ =-      convertTicks (MkTicks (natVal (Proxy :: Proxy d)) :: Ticks r Integer)--class (KnownStaticTicks (GetStaticDuration s), SetStaticDuration s (GetStaticDuration s) ~ s) =>-      HasStaticDuration (s :: k) where-    type SetStaticDuration s (pt :: StaticTicks) :: k'-    type GetStaticDuration s :: StaticTicks--toStaticDurationProxy :: (HasStaticDuration s)-                      => proxy s-                      -> Proxy (GetStaticDuration s)-toStaticDurationProxy _ = Proxy--getStaticDuration :: forall proxy s.-                  HasStaticDuration s-                  => proxy s-                  -> NominalDiffTime-getStaticDuration px = from nominalDiffTime #-    (staticTicksVal (toStaticDurationProxy px) :: Ticks 1000000000000 Integer)--getStaticTicks :: forall proxy s r t i.-               (KnownNat r, KnownNat t, HasStaticDuration s, GetStaticDuration s ~ (t :@ r), Integral i)-               => proxy s-               -> Ticks r i-getStaticTicks px = ticksFromStaticDuration (toStaticDurationProxy px)--getStaticRate :: forall proxy s r t.-              (KnownNat r, KnownNat t, HasStaticDuration s, GetStaticDuration s ~ (t :@ r))-              => proxy s-              -> Integer-getStaticRate px = rateFromStaticDuration (toStaticDurationProxy px)--ticksFromStaticDuration :: forall proxy rate ticks i.-                (KnownNat rate, KnownNat ticks, Integral i)-                => proxy (ticks :@ rate)-                -> Ticks rate i-ticksFromStaticDuration _ = MkTicks (fromIntegral (natVal (Proxy :: Proxy ticks)))--rateFromStaticDuration :: forall proxy rate ticks.-               (KnownNat rate, KnownNat ticks)-               => proxy (ticks :@ rate)-               -> Integer-rateFromStaticDuration _ = fromIntegral (natVal (Proxy :: Proxy rate))

@@ -1,22 +0,0 @@-module Data.MediaBus.Transcoder-    ( Transcoder(..)-    , transcodeStreamC'-    ) where--import           Conduit-import           Data.MediaBus.Stream-import           Data.Kind-import           Control.Parallel.Strategies ( NFData )--class Transcoder from to where-    type TranscodingSeqNum from to s :: Constraint-    type TranscodingSeqNum from to s = ()-    type TranscodingTicks from to t :: Constraint-    type TranscodingTicks from to t = ()-    transcode :: (TranscodingSeqNum from to s, TranscodingTicks from to t)-              => Frame s t from-              -> Frame s t to--transcodeStreamC' :: (NFData to, NFData p, NFData i, NFData s, NFData t, NFData p, Monad m, Transcoder from to, TranscodingSeqNum from to s, TranscodingTicks from to t)-                  => Conduit (Stream i s t p from) m (Stream i s t p to)-transcodeStreamC' = mapFramesC' transcode

@@ -5,10 +5,11 @@ import           Control.Monad.Trans.Resource import           Conduit import           Data.Conduit.Network.UDP-import           Data.MediaBus.Clock-import           Data.MediaBus.Stream-import           Data.MediaBus.SourceId-import           Data.MediaBus.Sequence+import           Data.MediaBus.Basics.Clock+import           Data.MediaBus.Conduit.Stream+import           Data.MediaBus.Media.Stream+import           Data.MediaBus.Basics.SourceId+import           Data.MediaBus.Basics.Sequence import           Data.Streaming.Network import           Network.Socket               ( SockAddr, close ) import qualified Data.ByteString              as B