module Synthesizer.Encoders.Wav
  where

import qualified Codec.Audio.Wave        as W
import           Control.Exception       (catch, throwIO)
import qualified Data.ByteString         as B
import qualified Data.ByteString.Builder as B
import           Data.Int                (Int16)
import           Prelude                 hiding (catch)
import           Synthesizer.Structure   (Sample, SynSound, soundToSamples)
import           System.Directory        (removeFile)
import           System.IO               (Handle)
import           System.IO.Error         (isDoesNotExistError)

-- | The sampling rate of the WAV file
samplingRate :: Num hz => hz
samplingRate :: hz
samplingRate = hz
44100

-- | Write the given given the callback data. Overwrites the file if it already exists.
writeWaveFile :: FilePath            -- ^ Where to save the file
              -> W.Wave              -- ^ Parameters of the WAVE file
              -> (Handle -> IO ())   -- ^ Callback that will be used to write WAVE data
              -> IO ()
writeWaveFile :: FilePath -> Wave -> (Handle -> IO ()) -> IO ()
writeWaveFile FilePath
path Wave
wave Handle -> IO ()
writeData = do
  FilePath -> IO ()
removeFile FilePath
path IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOError -> IO ()
ignoreDoesNotExists
  FilePath -> Wave -> (Handle -> IO ()) -> IO ()
forall (m :: * -> *).
MonadIO m =>
FilePath -> Wave -> (Handle -> IO ()) -> m ()
W.writeWaveFile FilePath
path Wave
wave Handle -> IO ()
writeData
  where ignoreDoesNotExists :: IOError -> IO ()
ignoreDoesNotExists IOError
e | IOError -> Bool
isDoesNotExistError IOError
e = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                              | Bool
otherwise = IOError -> IO ()
forall e a. Exception e => e -> IO a
throwIO IOError
e

-- | Save the generated sound of the Synthesizer into a WAV file. Overwrites the file if it already exists.
saveSignal :: FilePath     -- ^ The file name or location. A .wav extension will be appended to the file
           -> SynSound     -- ^ The structure representing your sound
           -> IO ()
saveSignal :: FilePath -> SynSound -> IO ()
saveSignal FilePath
filename SynSound
sound = do
  let samples :: [Sample]
samples = SynSound -> SamplingRate -> [Sample]
soundToSamples SynSound
sound SamplingRate
forall hz. Num hz => hz
samplingRate
  let numSamples :: SamplingRate
numSamples = [Sample] -> SamplingRate
forall (t :: * -> *) a. Foldable t => t a -> SamplingRate
length [Sample]
samples
  let wave :: Wave
wave = Wave :: WaveFormat
-> Word32
-> SampleFormat
-> Set SpeakerPosition
-> Word32
-> Word64
-> Word64
-> [(ByteString, ByteString)]
-> Wave
W.Wave {
      waveFileFormat :: WaveFormat
W.waveFileFormat = WaveFormat
W.WaveVanilla
      , waveSampleRate :: Word32
W.waveSampleRate = Word32
forall hz. Num hz => hz
samplingRate
      , waveSampleFormat :: SampleFormat
W.waveSampleFormat = Word16 -> SampleFormat
W.SampleFormatPcmInt Word16
16
      , waveChannelMask :: Set SpeakerPosition
W.waveChannelMask = Set SpeakerPosition
W.speakerMono
      , waveDataOffset :: Word32
W.waveDataOffset = Word32
0
      , waveDataSize :: Word64
W.waveDataSize = SamplingRate -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SamplingRate -> Word64) -> SamplingRate -> Word64
forall a b. (a -> b) -> a -> b
$ SamplingRate
numSamples SamplingRate -> SamplingRate -> SamplingRate
forall a. Num a => a -> a -> a
* SamplingRate
2
      , waveSamplesTotal :: Word64
W.waveSamplesTotal = SamplingRate -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral SamplingRate
numSamples
      , waveOtherChunks :: [(ByteString, ByteString)]
W.waveOtherChunks = []
  }
  let wavfile :: FilePath
wavfile = FilePath
filename FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".wav"
  FilePath -> Wave -> (Handle -> IO ()) -> IO ()
writeWaveFile FilePath
wavfile Wave
wave ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
handle -> Handle -> Builder -> IO ()
B.hPutBuilder Handle
handle ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Int16 -> Builder
B.int16LE (Int16 -> Builder) -> [Int16] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Sample -> Int16) -> [Sample] -> [Int16]
forall a b. (a -> b) -> [a] -> [b]
map Sample -> Int16
sampleToI16 [Sample]
samples)

-- | Convert a sample to an Int16, as that is the biggest amplitude WAV supports
sampleToI16 :: Sample -> Int16
sampleToI16 :: Sample -> Int16
sampleToI16 Sample
s | Sample
s Sample -> Sample -> Bool
forall a. Ord a => a -> a -> Bool
> Sample
32767 = Int16
32767
              | Sample
s Sample -> Sample -> Bool
forall a. Ord a => a -> a -> Bool
< -Sample
32768 = -Int16
32768
              | Bool
otherwise = Integer -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int16) -> Integer -> Int16
forall a b. (a -> b) -> a -> b
$ Sample -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round Sample
s