{-# 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 =
   Put int -> FilePath -> a -> [v] -> IO ExitCode
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 =
   FilePath -> a -> [v] -> IO ExitCode
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 =
   FilePath -> a -> [a] -> IO ExitCode
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 =
   FilePath -> a -> [(a, a)] -> IO ExitCode
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 =
   T -> FilePath -> a -> [int] -> IO ExitCode
forall a v.
(C a, C v, Storable v) =>
T -> FilePath -> a -> [v] -> IO ExitCode
writeRaw
      (Int -> T
SoxOpt.numberOfChannels ([v] -> Int
forall yv (sig :: * -> *). C yv => sig yv -> Int
BinSmp.numberOfSignalChannels [v]
signal))
      FilePath
fileName
      a
sampleRate
      (T int -> [int]
forall a. T a -> [a]
Builder.run (T int -> [int]) -> ([v] -> T int) -> [v] -> [int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [T int] -> T int
forall a. Monoid a => [a] -> a
mconcat ([T int] -> T int) -> ([v] -> [T int]) -> [v] -> T int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> T int) -> [v] -> [T int]
forall a b. (a -> b) -> [a] -> [b]
map (Put int -> v -> T int
forall a int out.
(C a, Bounded int, C int, Monoid out) =>
(int -> out) -> a -> out
forall int out.
(Bounded int, C int, Monoid out) =>
(int -> out) -> v -> out
BinSmp.outputFromCanonical Put int
put) ([v] -> [int]) -> [v] -> [int]
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 =
   Put Int16 -> FilePath -> a -> [v] -> IO ExitCode
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 Int16
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 =
   T -> FilePath -> a -> [Int16] -> IO ExitCode
forall a v.
(C a, C v, Storable v) =>
T -> FilePath -> a -> [v] -> IO ExitCode
writeRaw T
SoxOpt.none FilePath
fileName a
sampleRate
      ((a -> Int16) -> [a] -> [Int16]
forall a b. (a -> b) -> [a] -> [b]
map a -> Int16
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 =
   T -> FilePath -> a -> [T Int16] -> IO ExitCode
forall a v.
(C a, C v, Storable v) =>
T -> FilePath -> a -> [v] -> IO ExitCode
writeRaw T
SoxOpt.none FilePath
fileName a
sampleRate
      (((a, a) -> T Int16) -> [(a, a)] -> [T Int16]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Int16) -> T a -> T Int16
forall a b. (a -> b) -> T a -> T b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Int16
forall a. C a => a -> Int16
BinSmp.int16FromCanonical (T a -> T Int16) -> ((a, a) -> T a) -> (a, a) -> T Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> T a) -> (a, a) -> T a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> T a
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 =
   (Handle -> [v] -> IO ())
-> T -> T -> FilePath -> Int -> [v] -> IO ExitCode
forall y (sig :: * -> *).
C y =>
(Handle -> sig y -> IO ())
-> T -> T -> FilePath -> Int -> sig y -> IO ExitCode
Write.extended Handle -> [v] -> IO ()
forall a. Storable a => Handle -> [a] -> IO ()
SoxList.put T
opts T
SoxOpt.none FilePath
fileName (a -> Int
forall b. C b => a -> b
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 =
   ExceptionalT Int IO () -> IO ExitCode
forall (m :: * -> *).
Functor m =>
ExceptionalT Int m () -> m ExitCode
Exc.toExitCodeT (ExceptionalT Int IO () -> IO ExitCode)
-> ExceptionalT Int IO () -> IO ExitCode
forall a b. (a -> b) -> a -> b
$
   do IO ExitCode -> ExceptionalT Int IO ()
forall (m :: * -> *).
Functor m =>
m ExitCode -> ExceptionalT Int m ()
Exc.fromExitCodeT (IO ExitCode -> ExceptionalT Int IO ())
-> IO ExitCode -> ExceptionalT Int IO ()
forall a b. (a -> b) -> a -> b
$ T -> FilePath -> a -> [v] -> IO ExitCode
forall a v.
(C a, C v, Storable v) =>
T -> FilePath -> a -> [v] -> IO ExitCode
writeRaw T
opts FilePath
fileName a
sampleRate [v]
signal
      IO ExitCode -> ExceptionalT Int IO ()
forall (m :: * -> *).
Functor m =>
m ExitCode -> ExceptionalT Int m ()
Exc.fromExitCodeT (IO ExitCode -> ExceptionalT Int IO ())
-> IO ExitCode -> ExceptionalT Int IO ()
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 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".sw"
       fileNameAIFF :: FilePath
fileNameAIFF = FilePath
fileName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".aiff"
   in  T -> FilePath -> T -> FilePath -> IO ExitCode
Convert.simple
          ([T] -> T
forall a. Monoid a => [a] -> a
mconcat ([T] -> T) -> [T] -> T
forall a b. (a -> b) -> a -> b
$
           T
soxOptions T -> [T] -> [T]
forall a. a -> [a] -> [a]
:
           Int -> T
SoxOpt.sampleRate (a -> Int
forall b. C b => a -> b
forall a b. (C a, C b) => a -> b
round a
sampleRate) T -> [T] -> [T]
forall a. a -> [a] -> [a]
:
           Int -> T
SoxOpt.numberOfChannels Int
numChannels T -> [T] -> [T]
forall a. a -> [a] -> [a]
:
           [])
          FilePath
fileNameRaw
          T
SoxOpt.none FilePath
fileNameAIFF

compress :: FilePath -> IO ExitCode
compress :: FilePath -> IO ExitCode
compress FilePath
fileName = ExceptionalT Int IO () -> IO ExitCode
forall (m :: * -> *).
Functor m =>
ExceptionalT Int m () -> m ExitCode
Exc.toExitCodeT (ExceptionalT Int IO () -> IO ExitCode)
-> ExceptionalT Int IO () -> IO ExitCode
forall a b. (a -> b) -> a -> b
$
   do IO ExitCode -> ExceptionalT Int IO ()
forall (m :: * -> *).
Functor m =>
m ExitCode -> ExceptionalT Int m ()
Exc.fromExitCodeT (IO ExitCode -> ExceptionalT Int IO ())
-> IO ExitCode -> ExceptionalT Int IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> IO ExitCode
rawSystem FilePath
"oggenc" [FilePath
"--quality", FilePath
"5", FilePath
fileName]
      IO ExitCode -> ExceptionalT Int IO ()
forall (m :: * -> *).
Functor m =>
m ExitCode -> ExceptionalT Int m ()
Exc.fromExitCodeT (IO ExitCode -> ExceptionalT Int IO ())
-> IO ExitCode -> ExceptionalT Int IO ()
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  (Int -> IO [a]) -> ExceptionalT Int IO [a] -> IO [a]
forall (m :: * -> *) e a.
Monad m =>
(e -> m a) -> ExceptionalT e m a -> m a
Exc.resolveT (IO [a] -> Int -> IO [a]
forall a b. a -> b -> a
const (IO [a] -> Int -> IO [a]) -> IO [a] -> Int -> IO [a]
forall a b. (a -> b) -> a -> b
$ [a] -> IO [a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []) (ExceptionalT Int IO [a] -> IO [a])
-> ExceptionalT Int IO [a] -> IO [a]
forall a b. (a -> b) -> a -> b
$ do
          -- lift $ putStrLn ("sox "++file++" "++tmp)
          IO ExitCode -> ExceptionalT Int IO ()
forall (m :: * -> *).
Functor m =>
m ExitCode -> ExceptionalT Int m ()
Exc.fromExitCodeT (IO ExitCode -> ExceptionalT Int IO ())
-> IO ExitCode -> ExceptionalT Int IO ()
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
          ([Int16] -> [a])
-> ExceptionalT Int IO [Int16] -> ExceptionalT Int IO [a]
forall a b.
(a -> b) -> ExceptionalT Int IO a -> ExceptionalT Int IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int16 -> a) -> [Int16] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int16 -> a
forall a. C a => Int16 -> a
BinSmp.int16ToCanonical) (ExceptionalT Int IO [Int16] -> ExceptionalT Int IO [a])
-> ExceptionalT Int IO [Int16] -> ExceptionalT Int IO [a]
forall a b. (a -> b) -> a -> b
$
             IO [Int16] -> ExceptionalT Int IO [Int16]
forall (m :: * -> *) a. Monad m => m a -> ExceptionalT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO [Int16] -> ExceptionalT Int IO [Int16])
-> IO [Int16] -> ExceptionalT Int IO [Int16]
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 =
   T -> FilePath -> IO (Handle [Int16])
forall y (sig :: * -> *).
C y =>
T -> FilePath -> IO (Handle (sig y))
Read.open T
SoxOpt.none FilePath
fileName IO (Handle [Int16]) -> (Handle [Int16] -> IO [Int16]) -> IO [Int16]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
   (Handle -> IO [Int16]) -> Handle [Int16] -> IO [Int16]
forall (m :: * -> *) signal.
(Handle -> m signal) -> Handle signal -> m signal
Read.withHandle1 ((ByteString -> [Int16]) -> IO ByteString -> IO [Int16]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Get [Int16] -> ByteString -> [Int16]
forall a. Get a -> ByteString -> a
Get.runGet Get [Int16]
getInt16ListPrivate) (IO ByteString -> IO [Int16])
-> (Handle -> IO ByteString) -> Handle -> IO [Int16]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ByteString
B.hGetContents) IO [Int16] -> ([Int16] -> IO [a]) -> IO [a]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
   [a] -> IO [a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> IO [a]) -> ([Int16] -> [a]) -> [Int16] -> IO [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int16 -> a) -> [Int16] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int16 -> a
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 [Int16] -> Get [Int16]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return []
        else (Int16 -> [Int16] -> [Int16])
-> Get Int16 -> Get [Int16] -> Get [Int16]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) ((Word16 -> Int16) -> Get Word16 -> Get Int16
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word16 -> Int16
forall a b. (C a, C b) => a -> b
fromIntegral Get Word16
Get.getWord16host) Get [Int16]
getInt16ListPrivate