DebugSink.hs

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