module Sound.Sox.Play where

import qualified Sound.Sox.Frame as Frame
import Sound.Sox.System (catchCtrlC, )

import qualified Sound.Sox.Option.Format as Option
import qualified Sound.Sox.Private.Option as OptPriv
import qualified Sound.Sox.Private.Arguments as Args
import Data.Monoid (mconcat, )

import qualified System.Process as Proc
import qualified System.IO as IO
import Control.Exception (bracket, )
import System.Exit (ExitCode, )



{- |
> :load Sound.Sox.Play Sound.Sox.Signal.List
>
> simple Sound.Sox.Signal.List.put Option.none 11025 (iterate (1000+) (0::Data.Int.Int16))
-}
simple ::
   (Frame.C y) =>
   (IO.Handle -> sig y -> IO ())
      {- ^ Writer routine -
           e.g. 'Sound.Sox.Signal.List.put'
           or 'Data.StorableVector.hPut' -} ->
   Option.T ->
   Int
      {- ^ sample rate -} ->
   sig y ->
   IO ExitCode
simple :: forall y (sig :: * -> *).
C y =>
(Handle -> sig y -> IO ()) -> T -> Int -> sig y -> IO ExitCode
simple Handle -> sig y -> IO ()
write T
opts =
   forall y (sig :: * -> *).
C y =>
(Handle -> sig y -> IO ()) -> T -> T -> Int -> sig y -> IO ExitCode
extended Handle -> sig y -> IO ()
write T
Option.none T
opts

extended ::
   (Frame.C y) =>
   (IO.Handle -> sig y -> IO ())
      {- ^ Writer routine -
           e.g. 'Sound.Sox.Signal.List.put'
           or 'Data.StorableVector.hPut' -} ->
   Option.T
      {- ^ source options, usually none -} ->
   Option.T
      {- ^ target options -} ->
   Int
      {- ^ sample rate -} ->
   sig y ->
   IO ExitCode
extended :: forall y (sig :: * -> *).
C y =>
(Handle -> sig y -> IO ()) -> T -> T -> Int -> sig y -> IO ExitCode
extended Handle -> sig y -> IO ()
write T
srcOpts T
dstOpts Int
sampleRate sig y
stream =
   forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
      {-
      Formerly we called 'play' here.
      On Windows the SoX package does not install a 'play' command.
      However using the '-d' argument for the destination always works.
      -}
      (FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> IO (Handle, Handle, Handle, ProcessHandle)
Proc.runInteractiveProcess FilePath
"sox"
          (T -> [FilePath]
Args.decons forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
           T -> T
OptPriv.toArguments
             (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
              T
srcOpts forall a. a -> [a] -> [a]
:
              Int -> T
Option.numberOfChannels
                 (forall y a (sig :: * -> *). (y -> a) -> sig y -> a
Frame.withSignal forall y. C y => y -> Int
Frame.numberOfChannels sig y
stream) forall a. a -> [a] -> [a]
:
              Int -> T
Option.sampleRate Int
sampleRate forall a. a -> [a] -> [a]
:
              T -> T
Option.format (forall y a (sig :: * -> *). (y -> a) -> sig y -> a
Frame.withSignal forall y. C y => y -> T
Frame.format sig y
stream) forall a. a -> [a] -> [a]
:
              []) forall a. a -> [a] -> [a]
:
           T
Args.pipe forall a. a -> [a] -> [a]
:
           T -> T
OptPriv.toArguments T
dstOpts forall a. a -> [a] -> [a]
:
           FilePath -> T
Args.single FilePath
"-d" forall a. a -> [a] -> [a]
:
           [])
          forall a. Maybe a
Nothing forall a. Maybe a
Nothing)
      (\(Handle
input,Handle
output,Handle
err,ProcessHandle
_proc) ->
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Handle -> IO ()
IO.hClose [Handle
input, Handle
output, Handle
err])
      (\(Handle
input,Handle
_,Handle
_,ProcessHandle
proc) ->
         IO ()
catchCtrlC forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
         Handle -> sig y -> IO ()
write Handle
input sig y
stream forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
         forall (m :: * -> *) a. Monad m => a -> m a
return ProcessHandle
proc)
   -- wait for end of replay
   forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcessHandle -> IO ExitCode
Proc.waitForProcess