{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Plain.File 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 System.Cmd (rawSystem, )
import System.Exit (ExitCode, )
import Control.Monad (liftM2, )
import Data.Monoid (mconcat, )

import qualified Algebra.ToInteger          as ToInteger
import qualified Algebra.RealField          as RealField
import qualified Algebra.Field              as Field

import qualified System.FilePath as FilePath

import PreludeBase
import NumericPrelude



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

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

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

renderStereoToInt16 :: (RealField.C a) =>
   FilePath -> a -> (a -> [(a,a)]) -> IO ExitCode
renderStereoToInt16 fileName sampleRate renderer =
   writeStereoToInt16 fileName sampleRate (renderer 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,
    RealField.C a, BinSmp.C v) =>
   Builder.Put int -> FilePath -> a -> [v] -> IO ExitCode
write put fileName sampleRate signal =
   writeRaw
      (SoxOpt.numberOfChannels (BinSmp.numberOfSignalChannels signal))
      fileName
      sampleRate
      (Builder.run . mconcat . map (BinSmp.outputFromCanonical put) $
       signal)

writeToInt16 :: (RealField.C a, BinSmp.C v) =>
   FilePath -> a -> [v] -> IO ExitCode
writeToInt16 =
   write (Builder.put :: Builder.Put Int16)

writeMonoToInt16 :: (RealField.C a) =>
   FilePath -> a -> [a] -> IO ExitCode
writeMonoToInt16 fileName sampleRate signal =
   writeRaw SoxOpt.none fileName sampleRate
      (map BinSmp.int16FromCanonical signal)

writeStereoToInt16 :: (RealField.C a) =>
   FilePath -> a -> [(a,a)] -> IO ExitCode
writeStereoToInt16 fileName sampleRate signal =
   writeRaw SoxOpt.none fileName sampleRate
      (map (fmap BinSmp.int16FromCanonical . uncurry Stereo.cons) signal)

writeRaw :: (RealField.C a, Frame.C v, Storable v) =>
   SoxOpt.T -> FilePath -> a -> [v] -> IO ExitCode
writeRaw opts fileName sampleRate signal =
   Write.extended SoxList.put opts SoxOpt.none fileName (round sampleRate) 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 :: (RealField.C a, Frame.C v, Storable v) =>
   SoxOpt.T -> FilePath -> a -> [v] -> IO ExitCode
writeRawCompressed opts fileName sampleRate signal =
   do writeRaw opts fileName sampleRate signal
      compress 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 :: (RealField.C a) =>
   FilePath -> SoxOpt.T -> a -> Int -> IO ExitCode
rawToAIFF fileName soxOptions sampleRate numChannels =
   let fileNameRaw  = fileName ++ ".sw"
       fileNameAIFF = fileName ++ ".aiff"
   in  Convert.simple
          (mconcat $
           soxOptions :
           SoxOpt.sampleRate (round sampleRate) :
           SoxOpt.numberOfChannels numChannels :
           [])
          fileNameRaw
          SoxOpt.none fileNameAIFF

compress :: FilePath -> IO ExitCode
compress fileName =
   do rawSystem "oggenc" ["--quality", "5", fileName]
      rawSystem "lame"
         ["-h", fileName, FilePath.replaceExtension fileName "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 :: (RealField.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 file =
   do --putStrLn ("sox "++file++" "++tmp)
      let tmp = FilePath.replaceExtension file "sw"
      Convert.simple SoxOpt.none file SoxOpt.none tmp
      fmap (map BinSmp.int16ToCanonical) (FileL.readInt16StreamStrict tmp)


{- |
I suspect we cannot handle file closing properly.
-}
readMonoFromInt16 :: (Field.C a) => FilePath -> IO [a]
readMonoFromInt16 fileName =
   Read.open SoxOpt.none fileName >>=
   Read.withHandle1 (fmap (Get.runGet getInt16List) . B.hGetContents) >>=
   return . map BinSmp.int16ToCanonical

getInt16List :: Get.Get [Int16]
getInt16List =
   do b <- Get.isEmpty
      if b
        then return []
        else liftM2 (:) (fmap fromIntegral Get.getWord16host) getInt16List