{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
-- | Mix multiple directories of rendered chunks into a single audio file.
module Synth.MixDown where
import qualified Control.Monad.Trans.Resource as Resource
import qualified Data.List as List
import qualified System.Directory as Directory
import qualified System.Environment as Environment
import qualified System.Exit as Exit
import           System.FilePath ((</>))
import qualified System.IO as IO

import qualified Util.Audio.Audio as Audio
import qualified Util.Audio.File as Audio.File
import qualified Synth.Shared.Config as Config

import           Global


main :: IO ()
main :: IO ()
main = do
    ([Char]
out, [[Char]]
dirs) <- IO [[Char]]
Environment.getArgs IO [[Char]]
-> ([[Char]] -> IO ([Char], [[Char]])) -> IO ([Char], [[Char]])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        [Char]
out : [[Char]]
dirs
            | [Char]
".wav" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isSuffixOf` [Char]
out -> ([Char], [[Char]]) -> IO ([Char], [[Char]])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
out, [[Char]]
dirs)
            | Bool
otherwise -> [Char] -> IO ([Char], [[Char]])
forall a. [Char] -> IO a
usage [Char]
"out arg should be .wav!"
        [] -> [Char] -> IO ([Char], [[Char]])
forall a. [Char] -> IO a
usage [Char]
""
    IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (([Char] -> IO Bool) -> [[Char]] -> IO Bool
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
allM [Char] -> IO Bool
Directory.doesDirectoryExist [[Char]]
dirs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        [Char] -> IO ()
forall a. [Char] -> IO a
usage [Char]
"non-directory arg"
    [AudioIO SamplingRate 2]
streams <- ([Char] -> IO (AudioIO SamplingRate 2))
-> [[Char]] -> IO [AudioIO SamplingRate 2]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Char] -> IO (AudioIO SamplingRate 2)
streamDir [[Char]]
dirs
    ResourceT IO () -> IO ()
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
Resource.runResourceT (ResourceT IO () -> IO ()) -> ResourceT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Format -> [Char] -> AudioIO SamplingRate 2 -> ResourceT IO ()
forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Format -> [Char] -> AudioIO rate chan -> ResourceT IO ()
Audio.File.write Format
Audio.File.wavFormat [Char]
out (AudioIO SamplingRate 2 -> ResourceT IO ())
-> AudioIO SamplingRate 2 -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$
        [AudioIO SamplingRate 2] -> AudioIO SamplingRate 2
forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
Monad m =>
[Audio m rate chan] -> Audio m rate chan
Audio.mix [AudioIO SamplingRate 2]
streams

usage :: String -> IO a
usage :: forall a. [Char] -> IO a
usage [Char]
msg = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
msg) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Handle -> [Char] -> IO ()
IO.hPutStrLn Handle
IO.stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"error: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
msg
    Handle -> [Char] -> IO ()
IO.hPutStrLn Handle
IO.stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"usage: mixdown out.wav [ dir1 dir2 ... ]"
    IO a
forall a. IO a
Exit.exitFailure

streamDir :: FilePath -> IO (Audio.AudioIO Config.SamplingRate 2)
streamDir :: [Char] -> IO (AudioIO SamplingRate 2)
streamDir [Char]
dir = do
    [[Char]]
chunks <- [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
List.sort ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char]
".wav" `List.isSuffixOf`) ([[Char]] -> [[Char]]) -> IO [[Char]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        [Char] -> IO [[Char]]
Directory.listDirectory [Char]
dir
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
chunks) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Handle -> [Char] -> IO ()
IO.hPutStrLn Handle
IO.stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"WARNING: no *.wav in " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
dir
    AudioIO SamplingRate 2 -> IO (AudioIO SamplingRate 2)
forall (m :: * -> *) a. Monad m => a -> m a
return (AudioIO SamplingRate 2 -> IO (AudioIO SamplingRate 2))
-> AudioIO SamplingRate 2 -> IO (AudioIO SamplingRate 2)
forall a b. (a -> b) -> a -> b
$ Frames -> [[Char]] -> AudioIO SamplingRate 2
forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Frames -> [[Char]] -> AudioIO rate chan
Audio.File.readCheckpoints Frames
Config.chunkSize (([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
dir</>) [[Char]]
chunks)