{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Plain.File (
   render,
   renderToInt16,
   renderMonoToInt16,
   renderStereoToInt16,
   write,
   writeToInt16,
   writeMonoToInt16,
   writeStereoToInt16,
   writeRaw,
   writeRawCompressed,
   rawToAIFF,
   compress,
   readAIFFMono,
   readMonoFromInt16,
   -- will no longer be exported
   getInt16List,
   ) where

import qualified Sound.Sox.Convert as Convert
import qualified Sound.Sox.Frame as Frame
import qualified Sound.Sox.Frame.Stereo as Stereo
import qualified Sound.Sox.Option.Format as SoxOpt
import qualified Sound.Sox.Write as Write
import qualified Sound.Sox.Read as Read
import qualified Sound.Sox.Signal.List as SoxList

import qualified Synthesizer.Plain.IO as FileL
import qualified Synthesizer.Plain.Builder as Builder

import qualified Data.ByteString.Lazy as B
import qualified Data.Binary.Get as Get
import qualified Synthesizer.Basic.Binary as BinSmp
import Foreign.Storable (Storable, )
import Data.Int (Int16, )

import qualified System.FilePath as FilePath
import System.Process (rawSystem, )
import System.Exit (ExitCode, )

import qualified Control.Monad.Exception.Synchronous as Exc
import Control.Monad.Trans.Class (lift, )
import Control.Monad (liftM2, )

import Data.Monoid (mconcat, )

import qualified Algebra.ToInteger          as ToInteger
import qualified Algebra.RealRing           as RealRing
import qualified Algebra.Field              as Field

import NumericPrelude.Numeric
import NumericPrelude.Base



{- |
See 'write'.
-}
render ::
   (Storable int, Frame.C int, ToInteger.C int, Bounded int,
    RealRing.C a, BinSmp.C v) =>
   Builder.Put int -> FilePath -> a -> (a -> [v]) -> IO ExitCode
render :: forall int a v.
(Storable int, C int, C int, Bounded int, C a, C v) =>
Put int -> FilePath -> a -> (a -> [v]) -> IO ExitCode
render Put int
put FilePath
fileName a
sampleRate a -> [v]
renderer =
   forall int a v.
(Storable int, C int, C int, Bounded int, C a, C v) =>
Put int -> FilePath -> a -> [v] -> IO ExitCode
write Put int
put FilePath
fileName a
sampleRate (a -> [v]
renderer a
sampleRate)

renderToInt16 :: (RealRing.C a, BinSmp.C v) =>
   FilePath -> a -> (a -> [v]) -> IO ExitCode
renderToInt16 :: forall a v.
(C a, C v) =>
FilePath -> a -> (a -> [v]) -> IO ExitCode
renderToInt16 FilePath
fileName a
sampleRate a -> [v]
renderer =
   forall a v. (C a, C v) => FilePath -> a -> [v] -> IO ExitCode
writeToInt16 FilePath
fileName a
sampleRate (a -> [v]
renderer a
sampleRate)

renderMonoToInt16 :: (RealRing.C a) =>
   FilePath -> a -> (a -> [a]) -> IO ExitCode
renderMonoToInt16 :: forall a. C a => FilePath -> a -> (a -> [a]) -> IO ExitCode
renderMonoToInt16 FilePath
fileName a
sampleRate a -> [a]
renderer =
   forall a. C a => FilePath -> a -> [a] -> IO ExitCode
writeMonoToInt16 FilePath
fileName a
sampleRate (a -> [a]
renderer a
sampleRate)

renderStereoToInt16 :: (RealRing.C a) =>
   FilePath -> a -> (a -> [(a,a)]) -> IO ExitCode
renderStereoToInt16 :: forall a. C a => FilePath -> a -> (a -> [(a, a)]) -> IO ExitCode
renderStereoToInt16 FilePath
fileName a
sampleRate a -> [(a, a)]
renderer =
   forall a. C a => FilePath -> a -> [(a, a)] -> IO ExitCode
writeStereoToInt16 FilePath
fileName a
sampleRate (a -> [(a, a)]
renderer a
sampleRate)


{- |
The output format is determined by SoX by the file name extension.
The sample precision is determined by the provided 'Builder.Put' function.

Example:

> import qualified Synthesizer.Plain.Builder as Builder
>
> write (Builder.put :: Builder.Put Int16) "test.aiff" 44100 sound
-}
write ::
   (Storable int, Frame.C int, ToInteger.C int, Bounded int,
    RealRing.C a, BinSmp.C v) =>
   Builder.Put int -> FilePath -> a -> [v] -> IO ExitCode
write :: forall int a v.
(Storable int, C int, C int, Bounded int, C a, C v) =>
Put int -> FilePath -> a -> [v] -> IO ExitCode
write Put int
put FilePath
fileName a
sampleRate [v]
signal =
   forall a v.
(C a, C v, Storable v) =>
T -> FilePath -> a -> [v] -> IO ExitCode
writeRaw
      (Int -> T
SoxOpt.numberOfChannels (forall yv (sig :: * -> *). C yv => sig yv -> Int
BinSmp.numberOfSignalChannels [v]
signal))
      FilePath
fileName
      a
sampleRate
      (forall a. T a -> [a]
Builder.run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a int out.
(C a, Bounded int, C int, Monoid out) =>
(int -> out) -> a -> out
BinSmp.outputFromCanonical Put int
put) forall a b. (a -> b) -> a -> b
$
       [v]
signal)

writeToInt16 :: (RealRing.C a, BinSmp.C v) =>
   FilePath -> a -> [v] -> IO ExitCode
writeToInt16 :: forall a v. (C a, C v) => FilePath -> a -> [v] -> IO ExitCode
writeToInt16 =
   forall int a v.
(Storable int, C int, C int, Bounded int, C a, C v) =>
Put int -> FilePath -> a -> [v] -> IO ExitCode
write (forall a. Put a
Builder.put :: Builder.Put Int16)

writeMonoToInt16 :: (RealRing.C a) =>
   FilePath -> a -> [a] -> IO ExitCode
writeMonoToInt16 :: forall a. C a => FilePath -> a -> [a] -> IO ExitCode
writeMonoToInt16 FilePath
fileName a
sampleRate [a]
signal =
   forall a v.
(C a, C v, Storable v) =>
T -> FilePath -> a -> [v] -> IO ExitCode
writeRaw T
SoxOpt.none FilePath
fileName a
sampleRate
      (forall a b. (a -> b) -> [a] -> [b]
map forall a. C a => a -> Int16
BinSmp.int16FromCanonical [a]
signal)

writeStereoToInt16 :: (RealRing.C a) =>
   FilePath -> a -> [(a,a)] -> IO ExitCode
writeStereoToInt16 :: forall a. C a => FilePath -> a -> [(a, a)] -> IO ExitCode
writeStereoToInt16 FilePath
fileName a
sampleRate [(a, a)]
signal =
   forall a v.
(C a, C v, Storable v) =>
T -> FilePath -> a -> [v] -> IO ExitCode
writeRaw T
SoxOpt.none FilePath
fileName a
sampleRate
      (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. C a => a -> Int16
BinSmp.int16FromCanonical forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> a -> T a
Stereo.cons) [(a, a)]
signal)

writeRaw :: (RealRing.C a, Frame.C v, Storable v) =>
   SoxOpt.T -> FilePath -> a -> [v] -> IO ExitCode
writeRaw :: forall a v.
(C a, C v, Storable v) =>
T -> FilePath -> a -> [v] -> IO ExitCode
writeRaw T
opts FilePath
fileName a
sampleRate [v]
signal =
   forall y (sig :: * -> *).
C y =>
(Handle -> sig y -> IO ())
-> T -> T -> FilePath -> Int -> sig y -> IO ExitCode
Write.extended forall a. Storable a => Handle -> [a] -> IO ()
SoxList.put T
opts T
SoxOpt.none FilePath
fileName (forall a b. (C a, C b) => a -> b
round a
sampleRate) [v]
signal

{- |
You hardly need this routine
since you can use a filename with @.mp3@ or @.ogg@
extension for 'writeRaw'
and SoX will do the corresponding compression for you.
-}
writeRawCompressed :: (RealRing.C a, Frame.C v, Storable v) =>
   SoxOpt.T -> FilePath -> a -> [v] -> IO ExitCode
writeRawCompressed :: forall a v.
(C a, C v, Storable v) =>
T -> FilePath -> a -> [v] -> IO ExitCode
writeRawCompressed T
opts FilePath
fileName a
sampleRate [v]
signal =
   forall (m :: * -> *).
Functor m =>
ExceptionalT Int m () -> m ExitCode
Exc.toExitCodeT forall a b. (a -> b) -> a -> b
$
   do forall (m :: * -> *).
Functor m =>
m ExitCode -> ExceptionalT Int m ()
Exc.fromExitCodeT forall a b. (a -> b) -> a -> b
$ forall a v.
(C a, C v, Storable v) =>
T -> FilePath -> a -> [v] -> IO ExitCode
writeRaw T
opts FilePath
fileName a
sampleRate [v]
signal
      forall (m :: * -> *).
Functor m =>
m ExitCode -> ExceptionalT Int m ()
Exc.fromExitCodeT forall a b. (a -> b) -> a -> b
$ FilePath -> IO ExitCode
compress FilePath
fileName


{-# DEPRECATED rawToAIFF "If you want to generate AIFF, then just write to files with .aiff filename extension. If you want to convert files to AIFF, use Sound.Sox.Convert." #-}
rawToAIFF :: (RealRing.C a) =>
   FilePath -> SoxOpt.T -> a -> Int -> IO ExitCode
rawToAIFF :: forall a. C a => FilePath -> T -> a -> Int -> IO ExitCode
rawToAIFF FilePath
fileName T
soxOptions a
sampleRate Int
numChannels =
   let fileNameRaw :: FilePath
fileNameRaw  = FilePath
fileName forall a. [a] -> [a] -> [a]
++ FilePath
".sw"
       fileNameAIFF :: FilePath
fileNameAIFF = FilePath
fileName forall a. [a] -> [a] -> [a]
++ FilePath
".aiff"
   in  T -> FilePath -> T -> FilePath -> IO ExitCode
Convert.simple
          (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
           T
soxOptions forall a. a -> [a] -> [a]
:
           Int -> T
SoxOpt.sampleRate (forall a b. (C a, C b) => a -> b
round a
sampleRate) forall a. a -> [a] -> [a]
:
           Int -> T
SoxOpt.numberOfChannels Int
numChannels forall a. a -> [a] -> [a]
:
           [])
          FilePath
fileNameRaw
          T
SoxOpt.none FilePath
fileNameAIFF

compress :: FilePath -> IO ExitCode
compress :: FilePath -> IO ExitCode
compress FilePath
fileName = forall (m :: * -> *).
Functor m =>
ExceptionalT Int m () -> m ExitCode
Exc.toExitCodeT forall a b. (a -> b) -> a -> b
$
   do forall (m :: * -> *).
Functor m =>
m ExitCode -> ExceptionalT Int m ()
Exc.fromExitCodeT forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> IO ExitCode
rawSystem FilePath
"oggenc" [FilePath
"--quality", FilePath
"5", FilePath
fileName]
      forall (m :: * -> *).
Functor m =>
m ExitCode -> ExceptionalT Int m ()
Exc.fromExitCodeT forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> IO ExitCode
rawSystem FilePath
"lame"
         [FilePath
"-h", FilePath
fileName, FilePath -> FilePath -> FilePath
FilePath.replaceExtension FilePath
fileName FilePath
"mp3"]


{-# DEPRECATED readAIFFMono "Use readMonoFromInt16 instead" #-}
{-
This implementation doesn't work properly.
It seems like readFile is run
after all system calls to Sox are performed.
Aren't the calls serialized?

readAIFFMono :: (RealRing.C a, Floating a) => FilePath -> IO [a]
readAIFFMono file =
   do putStrLn ("sox "++file++" /tmp/sample.sw")
      system ("sox "++file++" /tmp/sample.sw")
      str <- readFile "/tmp/sample.sw"
      return (binaryToSignalMono str)
-}
readAIFFMono :: (Field.C a) => FilePath -> IO [a]
readAIFFMono :: forall a. C a => FilePath -> IO [a]
readAIFFMono FilePath
file =
   let tmp :: FilePath
tmp = FilePath -> FilePath -> FilePath
FilePath.replaceExtension FilePath
file FilePath
"s16"
   in  forall (m :: * -> *) e a.
Monad m =>
(e -> m a) -> ExceptionalT e m a -> m a
Exc.resolveT (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return []) forall a b. (a -> b) -> a -> b
$ do
          -- lift $ putStrLn ("sox "++file++" "++tmp)
          forall (m :: * -> *).
Functor m =>
m ExitCode -> ExceptionalT Int m ()
Exc.fromExitCodeT forall a b. (a -> b) -> a -> b
$ T -> FilePath -> T -> FilePath -> IO ExitCode
Convert.simple T
SoxOpt.none FilePath
file T
SoxOpt.none FilePath
tmp
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map forall a. C a => Int16 -> a
BinSmp.int16ToCanonical) forall a b. (a -> b) -> a -> b
$
             forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ FilePath -> IO [Int16]
FileL.readInt16StreamStrict FilePath
tmp


{- |
I suspect we cannot handle file closing properly.
-}
readMonoFromInt16 :: (Field.C a) => FilePath -> IO [a]
readMonoFromInt16 :: forall a. C a => FilePath -> IO [a]
readMonoFromInt16 FilePath
fileName =
   forall y (sig :: * -> *).
C y =>
T -> FilePath -> IO (Handle (sig y))
Read.open T
SoxOpt.none FilePath
fileName forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
   forall (m :: * -> *) signal.
(Handle -> m signal) -> Handle signal -> m signal
Read.withHandle1 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Get a -> ByteString -> a
Get.runGet Get [Int16]
getInt16ListPrivate) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ByteString
B.hGetContents) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
   forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. C a => Int16 -> a
BinSmp.int16ToCanonical

{-# DEPRECATED getInt16List "This function will no longer be exported" #-}
getInt16List, getInt16ListPrivate :: Get.Get [Int16]
getInt16List :: Get [Int16]
getInt16List = Get [Int16]
getInt16ListPrivate
getInt16ListPrivate :: Get [Int16]
getInt16ListPrivate =
   do Bool
b <- Get Bool
Get.isEmpty
      if Bool
b
        then forall (m :: * -> *) a. Monad m => a -> m a
return []
        else forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (C a, C b) => a -> b
fromIntegral Get Word16
Get.getWord16host) Get [Int16]
getInt16ListPrivate