module Sound.Sox.Read (
   Handle,
   open, close,
   -- withFile,
   withHandle1,
   withHandle2,
   ) 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, )


data Handle signal =
   Handle {
      forall signal. Handle signal -> Handle
pipeInput, forall signal. Handle signal -> Handle
pipeOutput, forall signal. Handle signal -> Handle
pipeError :: IO.Handle,
      forall signal. Handle signal -> ProcessHandle
processId :: Proc.ProcessHandle
   }

{-
withFile ::
   (Frame.C y) =>
   (IO.Handle -> IO (sig y))
      {- ^ Reader routine -
           e.g. 'Sound.Sox.Signal.List.put'
           or 'Data.StorableVector.hPut' -} ->
   Option.T ->
   FilePath ->
   IO ExitCode
withFile = undefined
-}

{- |
Unfortunately we cannot retrieve the sample rate using @sox@.
However there is @soxi@ for this purpose, which we may support in future.

> :load Sound.Sox.Read Sound.Sox.Signal.List
> :module + Control.Exception
> bracket (open Option.none "test.aiff") close $ \h -> withHandle2 Sound.Sox.Signal.List.getContents h >>= \x -> print (Control.Monad.Exception.Asynchronous.result x :: [Data.Int.Int16])
-}
open ::
   (Frame.C y) =>
   Option.T ->
   FilePath ->
   IO (Handle (sig y))
open :: forall y (sig :: * -> *).
C y =>
T -> FilePath -> IO (Handle (sig y))
open T
opts =
   forall y (sig :: * -> *).
C y =>
y -> T -> T -> FilePath -> IO (Handle (sig y))
openAux forall a. HasCallStack => a
undefined T
opts T
Option.none

openAux ::
   (Frame.C y) =>
   y ->
   Option.T ->
   Option.T ->
   FilePath ->
   IO (Handle (sig y))
openAux :: forall y (sig :: * -> *).
C y =>
y -> T -> T -> FilePath -> IO (Handle (sig y))
openAux y
frame T
srcOpts T
dstOpts FilePath
fileName =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (\(Handle
input,Handle
output,Handle
err,ProcessHandle
proc) ->
           forall signal.
Handle -> Handle -> Handle -> ProcessHandle -> Handle signal
Handle Handle
input Handle
output Handle
err ProcessHandle
proc)
      (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 T
srcOpts forall a. a -> [a] -> [a]
:
           FilePath -> T
Args.fileName FilePath
fileName forall a. a -> [a] -> [a]
:
           T -> T
OptPriv.toArguments
             (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
              T
dstOpts forall a. a -> [a] -> [a]
:
              Int -> T
Option.numberOfChannels
                 (forall y. C y => y -> Int
Frame.numberOfChannels y
frame) forall a. a -> [a] -> [a]
:
              T -> T
Option.format (forall y. C y => y -> T
Frame.format y
frame) forall a. a -> [a] -> [a]
:
              []) forall a. a -> [a] -> [a]
:
           T
Args.pipe forall a. a -> [a] -> [a]
:
           [])
          forall a. Maybe a
Nothing forall a. Maybe a
Nothing)

close :: Handle signal -> IO ExitCode
close :: forall signal. Handle signal -> IO ExitCode
close Handle signal
h =
   forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Handle -> IO ()
IO.hClose [forall signal. Handle signal -> Handle
pipeInput Handle signal
h, forall signal. Handle signal -> Handle
pipeOutput Handle signal
h, forall signal. Handle signal -> Handle
pipeError Handle signal
h] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
   ProcessHandle -> IO ExitCode
Proc.waitForProcess (forall signal. Handle signal -> ProcessHandle
processId Handle signal
h)

withHandle1 ::
   (IO.Handle -> m signal) ->
   (Handle signal -> m signal)
withHandle1 :: forall (m :: * -> *) signal.
(Handle -> m signal) -> Handle signal -> m signal
withHandle1 Handle -> m signal
act Handle signal
h =
   Handle -> m signal
act (forall signal. Handle signal -> Handle
pipeOutput Handle signal
h)

withHandle2 ::
   (IO.Handle -> m (f signal)) ->
   (Handle signal -> m (f signal))
withHandle2 :: forall (m :: * -> *) (f :: * -> *) signal.
(Handle -> m (f signal)) -> Handle signal -> m (f signal)
withHandle2 Handle -> m (f signal)
act Handle signal
h =
   Handle -> m (f signal)
act (forall signal. Handle signal -> Handle
pipeOutput Handle signal
h)