{- |
This module calls the 'soxi' command
which is available since 'sox' version 14.

This module is very clever as it calls 'soxi' once
with one option per requested piece of information
and parses the results in a correctly typed tuple.
Unfortunately, 'soxi' does not work this way.
It accepts only one option per call.
-}
module Sound.Sox.Private.Information where

import Control.Monad.Trans.Writer (Writer, writer, runWriter, )
import Control.Monad.Trans.State (StateT(StateT), runStateT, )
import Control.Monad.Trans.Class (lift, )
import Control.Applicative (Applicative, pure, liftA3, (<*>), )
import Data.Functor.Compose (Compose(Compose), )
import Data.List.HT (viewL, )
import Data.String.HT (trim, )
import Text.Read.HT (maybeRead, )

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

import Prelude hiding (length, )


{-
Cf. Synthesizer.Basic.Interpolation.PrefixReader.
-}
newtype T a =
   Cons (Compose (Writer [String]) (StateT [String] Maybe) a)

instance Functor T where
   {-# INLINE fmap #-}
   fmap :: forall a b. (a -> b) -> T a -> T b
fmap a -> b
f (Cons Compose (Writer [String]) (StateT [String] Maybe) a
m) = forall a.
Compose (Writer [String]) (StateT [String] Maybe) a -> T a
Cons (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Compose (Writer [String]) (StateT [String] Maybe) a
m)

instance Applicative T where
   {-# INLINE pure #-}
   {-# INLINE (<*>) #-}
   pure :: forall a. a -> T a
pure = forall a.
Compose (Writer [String]) (StateT [String] Maybe) a -> T a
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
   (Cons Compose (Writer [String]) (StateT [String] Maybe) (a -> b)
f) <*> :: forall a b. T (a -> b) -> T a -> T b
<*> (Cons Compose (Writer [String]) (StateT [String] Maybe) a
x) = forall a.
Compose (Writer [String]) (StateT [String] Maybe) a -> T a
Cons (Compose (Writer [String]) (StateT [String] Maybe) (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Compose (Writer [String]) (StateT [String] Maybe) a
x)


simple :: Read a => (String -> Maybe a) -> String -> T a
simple :: forall a. Read a => (String -> Maybe a) -> String -> T a
simple String -> Maybe a
rd String
option =
   forall a.
Compose (Writer [String]) (StateT [String] Maybe) a -> T a
Cons forall a b. (a -> b) -> a -> b
$ forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a w. Monad m => (a, w) -> WriterT w m a
writer
      (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe a
rd forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a. [a] -> Maybe (a, [a])
viewL, [String
option])

format :: T String
format :: T String
format = forall a. Read a => (String -> Maybe a) -> String -> T a
simple forall a. a -> Maybe a
Just String
"-t"

simpleRead :: String -> T Int
simpleRead :: String -> T Int
simpleRead = forall a. Read a => (String -> Maybe a) -> String -> T a
simple (forall a. Read a => String -> Maybe a
maybeRead forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
trim)

sampleRate :: T Int
sampleRate :: T Int
sampleRate = String -> T Int
simpleRead String
"-r"

numberOfChannels :: T Int
numberOfChannels :: T Int
numberOfChannels = String -> T Int
simpleRead String
"-c"

length :: T Int
length :: T Int
length = String -> T Int
simpleRead String
"-s"

bitsPerSample :: T Int
bitsPerSample :: T Int
bitsPerSample = String -> T Int
simpleRead String
"-b"



get :: T a -> FilePath -> IO a
get :: forall a. T a -> String -> IO a
get (Cons (Compose Writer [String] (StateT [String] Maybe a)
w)) String
fileName =
   let (StateT [String] Maybe a
parser, [String]
opts) = forall w a. Writer w a -> (a, w)
runWriter Writer [String] (StateT [String] Maybe a)
w
   in  forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
          (String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> IO (Handle, Handle, Handle, ProcessHandle)
Proc.runInteractiveProcess String
"soxi"
              ([String]
opts forall a. [a] -> [a] -> [a]
++ String
fileName 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] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              ProcessHandle -> IO ()
Proc.terminateProcess ProcessHandle
proc)
          (\(Handle
_,Handle
output,Handle
_,ProcessHandle
_) ->
             forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                (forall a. IOError -> IO a
ioError (String -> IOError
userError String
"soxi returned rubbish"))
                (\(a
x,[String]
str) ->
                    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
str
                      then forall (m :: * -> *) a. Monad m => a -> m a
return a
x
                      else forall a. IOError -> IO a
ioError (String -> IOError
userError String
"soxi returned more lines than expected")) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT [String] Maybe a
parser forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
             Handle -> IO String
IO.hGetContents Handle
output)

exampleMulti :: IO (String, Int, Int)
exampleMulti :: IO (String, Int, Int)
exampleMulti =
   forall a. T a -> String -> IO a
get (forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (,,) T String
format T Int
sampleRate T Int
bitsPerSample) String
"test.aiff"

exampleSingle :: IO Int
exampleSingle :: IO Int
exampleSingle =
   forall a. T a -> String -> IO a
get T Int
sampleRate String
"test.aiff"