-- Copyright 2017 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
-- | Audio utilities.  This is named AUtil instead of the more obvious
-- Audio to avoid clashing with Util.Audio.Audio.
module Synth.Lib.AUtil where
import qualified Control.Exception as Exception
import qualified Control.Monad.Trans.Resource as Resource
import qualified Sound.File.Sndfile as Sndfile
import qualified System.IO.Unsafe as Unsafe

import qualified Util.Audio.Audio as Audio
import qualified Util.Num as Num
import qualified Perform.RealTime as RealTime
import qualified Synth.Shared.Config as Config
import qualified Synth.Shared.Control as Control

import           Global


type Audio = Audio.AudioIO Config.SamplingRate Channels
type Audio1 = Audio.AudioIO Config.SamplingRate 1
type NAudio = Audio.NAudioIO Config.SamplingRate

-- | Synth output is pretty tied to 2 channels, but I may as well at least
-- document the things that depend on that.
type Channels = 2

toFrames :: RealTime.RealTime -> Audio.Frames
toFrames :: RealTime -> Frames
toFrames = Rate -> Seconds -> Frames
Audio.secondsToFrames Rate
Config.samplingRate forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealTime -> Seconds
RealTime.to_seconds

toSeconds :: Audio.Frames -> RealTime.RealTime
toSeconds :: Frames -> RealTime
toSeconds = Seconds -> RealTime
RealTime.seconds forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rate -> Frames -> Seconds
Audio.framesToSeconds Rate
Config.samplingRate

blockFrames2 :: Audio.Block -> Audio.Frames
blockFrames2 :: Block -> Frames
blockFrames2 = forall (chan :: Nat).
KnownNat chan =>
Proxy chan -> Block -> Frames
Audio.blockFrames (forall {k} (t :: k). Proxy t
Proxy @2)

framesCount2 :: Audio.Frames -> Audio.Count
framesCount2 :: Frames -> Rate
framesCount2 = forall (chan :: Nat). KnownNat chan => Proxy chan -> Frames -> Rate
Audio.framesCount (forall {k} (t :: k). Proxy t
Proxy @2)

outputFormat :: Sndfile.Format
outputFormat :: Format
outputFormat = Sndfile.Format
    { headerFormat :: HeaderFormat
headerFormat = HeaderFormat
Sndfile.HeaderFormatWav
    , sampleFormat :: SampleFormat
sampleFormat = SampleFormat
Sndfile.SampleFormatFloat
    , endianFormat :: EndianFormat
endianFormat = EndianFormat
Sndfile.EndianFile
    }

catchSndfile :: IO a -> IO (Either Text a)
catchSndfile :: forall a. IO a -> IO (Either Text a)
catchSndfile = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {b}. Either Exception b -> Either Text b
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => IO a -> IO (Either e a)
Exception.try
    where try :: Either Exception b -> Either Text b
try = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exception -> String
Sndfile.errorString) forall a b. b -> Either a b
Right

-- | Convert a volume in dB to linear.
dbToLinear :: Float -> Float
dbToLinear :: Float -> Float
dbToLinear = Float -> Float
Audio.dbToLinear forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Eq a, Num a) => a -> a -> a -> a
Num.scale (Seconds -> Float
Num.d2f Seconds
Control.minimumDb) Float
0

volume :: Audio1 -> Audio -> Audio
volume :: Audio1 -> Audio -> Audio
volume = forall (m :: * -> *) (chan :: Nat) (rate :: Nat).
(Monad m, KnownNat chan) =>
Audio m rate chan -> Audio m rate chan -> Audio m rate chan
Audio.multiply forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
(Monad m, KnownNat chan) =>
Audio m rate 1 -> Audio m rate chan
Audio.expandChannels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
Monad m =>
(Float -> Float) -> Audio m rate chan -> Audio m rate chan
Audio.mapSamples Float -> Float
dbToLinear

-- * debug utils

debugAudio :: Audio.Audio (Resource.ResourceT IO) rate chan -> [Audio.Block]
debugAudio :: forall (rate :: Nat) (chan :: Nat).
Audio (ResourceT IO) rate chan -> [Block]
debugAudio = forall a. IO a -> a
Unsafe.unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
Resource.runResourceT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
Monad m =>
Audio m rate chan -> m [Block]
Audio.toBlocks

debugAudioN :: Audio.NAudio (Resource.ResourceT IO) rate -> [[Audio.Block]]
debugAudioN :: forall (rate :: Nat). NAudio (ResourceT IO) rate -> [[Block]]
debugAudioN = forall a. IO a -> a
Unsafe.unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
Resource.runResourceT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (rate :: Nat).
Monad m =>
NAudio m rate -> m [[Block]]
Audio.toBlocksN