-- | This module exports some functions for simple loading and saving sounds. 
--
-- However, keep in mind that loaded sounds have a fixed amound of samples and thus cannot be stretched
-- in duration losslessly. Stretching a sound results in sub- or supersampling and will also shift the pitch.
-- Pitch-retaining stretching has not been implemented yet!
module LambdaSound.SaveAndLoad
  ( saveWav,
    loadWav,
    saveRaw,
    loadRaw,
    saveRawCompressed,
    loadRawCompressed,
  )
where

import Data.List.NonEmpty
import LambdaSound.Sampling (sampleSound, unsampleSound, unsampleSoundWithHz)
import LambdaSound.SaveAndLoad.RawSamples qualified as RS
import LambdaSound.Sound

-- | Save a sound as a wav file using default 'sampleSound'.
saveWav :: FilePath -> Hz -> Sound T Pulse -> IO ()
saveWav :: FilePath -> Hz -> Sound 'T Pulse -> IO ()
saveWav FilePath
filePath Hz
hz Sound 'T Pulse
sound = do
  Vector S Pulse
floats <- Hz -> Sound 'T Pulse -> IO (Vector S Pulse)
sampleSound Hz
hz Sound 'T Pulse
sound
  FilePath -> Hz -> Vector S Pulse -> IO ()
RS.saveWav FilePath
filePath Hz
hz Vector S Pulse
floats

-- | Load a wav as a sound, mixing channels with 'parallel2'.
--
-- If you want to to use this with `embedIO`, you should probably use `embedIOLazily` instead!
loadWav :: FilePath -> IO (Sound T Pulse)
loadWav :: FilePath -> IO (Sound 'T Pulse)
loadWav FilePath
filePath = do
  (Hz
hz, NonEmpty (Vector S Pulse)
channels) <- FilePath -> IO (Hz, NonEmpty (Vector S Pulse))
RS.loadWav FilePath
filePath
  Sound 'T Pulse -> IO (Sound 'T Pulse)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sound 'T Pulse -> IO (Sound 'T Pulse))
-> Sound 'T Pulse -> IO (Sound 'T Pulse)
forall a b. (a -> b) -> a -> b
$ Hz -> Vector S Pulse -> Sound 'T Pulse
forall r. Source r Pulse => Hz -> Vector r Pulse -> Sound 'T Pulse
unsampleSoundWithHz Hz
hz (Vector S Pulse -> Sound 'T Pulse)
-> Vector S Pulse -> Sound 'T Pulse
forall a b. (a -> b) -> a -> b
$ NonEmpty (Vector S Pulse) -> Vector S Pulse
forall a. NonEmpty a -> a
Data.List.NonEmpty.head NonEmpty (Vector S Pulse)
channels

-- | Save a sound as floats.
saveRaw :: FilePath -> Hz -> Sound T Pulse -> IO ()
saveRaw :: FilePath -> Hz -> Sound 'T Pulse -> IO ()
saveRaw FilePath
filePath Hz
hz Sound 'T Pulse
sound = do
  Vector S Pulse
floats <- Hz -> Sound 'T Pulse -> IO (Vector S Pulse)
sampleSound Hz
hz Sound 'T Pulse
sound
  FilePath -> Vector S Pulse -> IO ()
RS.saveRaw FilePath
filePath Vector S Pulse
floats

-- | Load a sound from floats.
--
-- If you want to to use this with `embedIO`, you should probably use `embedIOLazily` instead!
loadRaw :: FilePath -> IO (Sound I Pulse)
loadRaw :: FilePath -> IO (Sound 'I Pulse)
loadRaw FilePath
filePath = do
  Vector S Pulse
floats <- FilePath -> IO (Vector S Pulse)
RS.loadRaw FilePath
filePath
  Sound 'I Pulse -> IO (Sound 'I Pulse)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sound 'I Pulse -> IO (Sound 'I Pulse))
-> Sound 'I Pulse -> IO (Sound 'I Pulse)
forall a b. (a -> b) -> a -> b
$ Vector S Pulse -> Sound 'I Pulse
forall r. Source r Pulse => Vector r Pulse -> Sound 'I Pulse
unsampleSound Vector S Pulse
floats

-- | Save a sound as gzip-compressed floats.
saveRawCompressed :: FilePath -> Hz -> Sound T Pulse -> IO ()
saveRawCompressed :: FilePath -> Hz -> Sound 'T Pulse -> IO ()
saveRawCompressed FilePath
filePath Hz
hz Sound 'T Pulse
sound = do
  Vector S Pulse
floats <- Hz -> Sound 'T Pulse -> IO (Vector S Pulse)
sampleSound Hz
hz Sound 'T Pulse
sound
  FilePath -> Vector S Pulse -> IO ()
RS.saveRawCompressed FilePath
filePath Vector S Pulse
floats

-- | Load a sound from gzip-compressed floats.
--
-- If you want to to use this with `embedIO`, you should probably use `embedIOLazily` instead!
loadRawCompressed :: FilePath -> IO (Sound I Pulse)
loadRawCompressed :: FilePath -> IO (Sound 'I Pulse)
loadRawCompressed FilePath
filePath = do
  Vector S Pulse
floats <- FilePath -> IO (Vector S Pulse)
RS.loadRawCompressed FilePath
filePath
  Sound 'I Pulse -> IO (Sound 'I Pulse)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sound 'I Pulse -> IO (Sound 'I Pulse))
-> Sound 'I Pulse -> IO (Sound 'I Pulse)
forall a b. (a -> b) -> a -> b
$ Vector S Pulse -> Sound 'I Pulse
forall r. Source r Pulse => Vector r Pulse -> Sound 'I Pulse
unsampleSound Vector S Pulse
floats