-- Copyright 2018 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, KindSignatures #-}
{-# LANGUAGE TypeApplications #-}
-- | Functions to read and write audio files.  This should be able to read all
-- formats supported by libsndfile.
module Util.Audio.File (
    -- * read
    check, checkA, getInfo, duration
    , read, read44k, readUnknown
    , readFrom, readFromClose
    , concat
    , readCheckpoints, readCheckpointsFrom
    -- * write
    , write
    , writeHandle
    , writeCheckpoints
    , wavFormat
    -- * misc
    , throwEnoent
) where
import           Prelude hiding (concat, read)
import qualified Control.Exception as Exception
import qualified Control.Monad.Fix as Fix
import qualified Control.Monad.Trans.Resource as Resource

import qualified Data.Vector.Storable as V
import qualified Foreign.Storable as Storable
import qualified GHC.TypeLits as TypeLits
import qualified Sound.File.Sndfile.Buffer.Vector as Sndfile.Buffer.Vector
import qualified Streaming.Prelude as S
import qualified System.Directory as Directory
import qualified System.IO as IO
import qualified System.IO.Error as IO.Error

import qualified Util.Audio.Audio as Audio
import qualified Util.Audio.Sndfile as Sndfile
import qualified Util.Num as Num

import           Global


-- | Check if rate and channels match the file.
check :: forall rate chan. (TypeLits.KnownNat rate, TypeLits.KnownNat chan)
    => Proxy rate -> Proxy chan -> FilePath -> IO (Maybe String)
check :: forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Proxy rate -> Proxy chan -> String -> IO (Maybe String)
check Proxy rate
rate Proxy chan
chan String
fname =
    Maybe String
-> (Info -> Maybe String) -> Maybe Info -> Maybe String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"file not found: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fname) (Proxy rate -> Proxy chan -> Info -> Maybe String
forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Proxy rate -> Proxy chan -> Info -> Maybe String
checkInfo Proxy rate
rate Proxy chan
chan) (Maybe Info -> Maybe String)
-> IO (Maybe Info) -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        String -> IO (Maybe Info)
getInfo String
fname

-- | Like 'check', but take 'Audio.Audio' instead of Proxy.
checkA :: forall m rate chan.
    (TypeLits.KnownNat rate, TypeLits.KnownNat chan) =>
    Proxy (Audio.Audio m rate chan) -> FilePath -> IO (Maybe String)
checkA :: forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Proxy (Audio m rate chan) -> String -> IO (Maybe String)
checkA Proxy (Audio m rate chan)
_ = Proxy rate -> Proxy chan -> String -> IO (Maybe String)
forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Proxy rate -> Proxy chan -> String -> IO (Maybe String)
check (Proxy rate
forall {k} (t :: k). Proxy t
Proxy :: Proxy rate) (Proxy chan
forall {k} (t :: k). Proxy t
Proxy :: Proxy chan)

getInfo :: FilePath -> IO (Maybe Sndfile.Info)
getInfo :: String -> IO (Maybe Info)
getInfo String
fname =
    IO (Maybe Handle)
-> (Maybe Handle -> IO ())
-> (Maybe Handle -> IO (Maybe Info))
-> IO (Maybe Info)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracket (String -> IO (Maybe Handle)
openRead String
fname) (IO () -> (Handle -> IO ()) -> Maybe Handle -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Handle -> IO ()
Sndfile.hClose)
        (Maybe Info -> IO (Maybe Info)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Info -> IO (Maybe Info))
-> (Maybe Handle -> Maybe Info) -> Maybe Handle -> IO (Maybe Info)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Handle -> Info) -> Maybe Handle -> Maybe Info
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Handle -> Info
Sndfile.hInfo)

duration :: FilePath -> IO (Maybe Audio.Frames)
duration :: String -> IO (Maybe Frames)
duration = (Maybe Info -> Maybe Frames)
-> IO (Maybe Info) -> IO (Maybe Frames)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Info -> Frames) -> Maybe Info -> Maybe Frames
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Frames
Audio.Frames (Int -> Frames) -> (Info -> Int) -> Info -> Frames
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Info -> Int
Sndfile.frames)) (IO (Maybe Info) -> IO (Maybe Frames))
-> (String -> IO (Maybe Info)) -> String -> IO (Maybe Frames)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Maybe Info)
getInfo

-- | Since the file is opened only when samples are demanded, a sample rate or
-- channels mismatch will turn into an exception then, not when this is called.
--
-- As a special case, if the file channels is 1, it will be expanded to
-- fit whatever channel count was requested.
read :: forall rate chan. (TypeLits.KnownNat rate, TypeLits.KnownNat chan)
    => FilePath -> Audio.AudioIO rate chan
read :: forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
String -> AudioIO rate chan
read = Frames -> String -> AudioIO rate chan
forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Frames -> String -> AudioIO rate chan
readFrom Frames
0

-- | Like 'readFrom', but return an action that closes the handle.  This is
-- for Audio.takeClose, so it can close the file early if it terminates the
-- stream early.
readFromClose :: forall rate chan.
    (TypeLits.KnownNat rate, TypeLits.KnownNat chan) =>
    Audio.Frames -> FilePath -> IO (IO (), Audio.AudioIO rate chan)
readFromClose :: forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Frames -> String -> IO (IO (), AudioIO rate chan)
readFromClose Frames
frame String
fname = do
    Handle
handle <- String -> IO Handle
openReadThrow String
fname
    (IO (), AudioIO rate chan) -> IO (IO (), AudioIO rate chan)
forall (m :: * -> *) a. Monad m => a -> m a
return ((IO (), AudioIO rate chan) -> IO (IO (), AudioIO rate chan))
-> (IO (), AudioIO rate chan) -> IO (IO (), AudioIO rate chan)
forall a b. (a -> b) -> a -> b
$ (Handle -> IO ()
Sndfile.hClose Handle
handle,) (AudioIO rate chan -> (IO (), AudioIO rate chan))
-> AudioIO rate chan -> (IO (), AudioIO rate chan)
forall a b. (a -> b) -> a -> b
$ Stream (Of Block) (ResourceT IO) () -> AudioIO rate chan
forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
Stream (Of Block) m () -> Audio m rate chan
Audio.Audio (Stream (Of Block) (ResourceT IO) () -> AudioIO rate chan)
-> Stream (Of Block) (ResourceT IO) () -> AudioIO rate chan
forall a b. (a -> b) -> a -> b
$ do
        ResourceT IO ReleaseKey
-> Stream (Of Block) (ResourceT IO) ReleaseKey
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT IO ReleaseKey
 -> Stream (Of Block) (ResourceT IO) ReleaseKey)
-> ResourceT IO ReleaseKey
-> Stream (Of Block) (ResourceT IO) ReleaseKey
forall a b. (a -> b) -> a -> b
$ IO () -> ResourceT IO ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
Resource.register (Handle -> IO ()
Sndfile.hClose Handle
handle)
        (Vector Sample -> Block)
-> Stream (Of (Vector Sample)) (ResourceT IO) ()
-> Stream (Of Block) (ResourceT IO) ()
forall (m :: * -> *) a b r.
Monad m =>
(a -> b) -> Stream (Of a) m r -> Stream (Of b) m r
S.map Vector Sample -> Block
Audio.Block (Stream (Of (Vector Sample)) (ResourceT IO) ()
 -> Stream (Of Block) (ResourceT IO) ())
-> Stream (Of (Vector Sample)) (ResourceT IO) ()
-> Stream (Of Block) (ResourceT IO) ()
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> Frames
-> String
-> Handle
-> Stream (Of (Vector Sample)) (ResourceT IO) ()
forall (m :: * -> *).
MonadIO m =>
Int
-> Int
-> Frames
-> String
-> Handle
-> Stream (Of (Vector Sample)) m ()
readHandle Int
rate Int
chan Frames
frame String
fname Handle
handle
    where
    rate :: Int
rate = Proxy rate -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
Audio.natVal (Proxy rate
forall {k} (t :: k). Proxy t
Proxy :: Proxy rate)
    chanP :: Proxy chan
chanP = Proxy chan
forall {k} (t :: k). Proxy t
Proxy :: Proxy chan
    chan :: Int
chan = Proxy chan -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
Audio.natVal Proxy chan
chanP

readFrom :: forall rate chan. (TypeLits.KnownNat rate, TypeLits.KnownNat chan)
    => Audio.Frames -> FilePath -> Audio.AudioIO rate chan
readFrom :: forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Frames -> String -> AudioIO rate chan
readFrom Frames
frame String
fname =
    AudioIO rate chan -> Frames -> String -> AudioIO rate chan
forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
AudioIO rate chan -> Frames -> String -> AudioIO rate chan
readFrom_ (Text -> AudioIO rate chan
forall (rate :: Nat) (chan :: Nat).
HasCallStack =>
Text -> AudioIO rate chan
Audio.throw (Text -> AudioIO rate chan) -> Text -> AudioIO rate chan
forall a b. (a -> b) -> a -> b
$ Text
"file not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Show a => a -> Text
showt String
fname) Frames
frame String
fname

readFrom_ :: forall rate chan. (TypeLits.KnownNat rate, TypeLits.KnownNat chan)
    => Audio.AudioIO rate chan -> Audio.Frames -> FilePath
    -> Audio.AudioIO rate chan
readFrom_ :: forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
AudioIO rate chan -> Frames -> String -> AudioIO rate chan
readFrom_ AudioIO rate chan
onEnoent Frames
frame String
fname = Stream (Of Block) (ResourceT IO) () -> AudioIO rate chan
forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
Stream (Of Block) m () -> Audio m rate chan
Audio.Audio (Stream (Of Block) (ResourceT IO) () -> AudioIO rate chan)
-> Stream (Of Block) (ResourceT IO) () -> AudioIO rate chan
forall a b. (a -> b) -> a -> b
$ do
    (ReleaseKey
_, Maybe Handle
mbHandle) <- ResourceT IO (ReleaseKey, Maybe Handle)
-> Stream (Of Block) (ResourceT IO) (ReleaseKey, Maybe Handle)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT IO (ReleaseKey, Maybe Handle)
 -> Stream (Of Block) (ResourceT IO) (ReleaseKey, Maybe Handle))
-> ResourceT IO (ReleaseKey, Maybe Handle)
-> Stream (Of Block) (ResourceT IO) (ReleaseKey, Maybe Handle)
forall a b. (a -> b) -> a -> b
$ IO (Maybe Handle)
-> (Maybe Handle -> IO ())
-> ResourceT IO (ReleaseKey, Maybe Handle)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
Resource.allocate (String -> IO (Maybe Handle)
openRead String
fname)
        (IO () -> (Handle -> IO ()) -> Maybe Handle -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Handle -> IO ()
Sndfile.hClose)
    case Maybe Handle
mbHandle of
        Just Handle
handle
            -- If I would have seeked past the end, it's like onEnoent.
            | Frames
0 Frames -> Frames -> Bool
forall a. Ord a => a -> a -> Bool
<= Frames
frame Bool -> Bool -> Bool
&& Frames
frame Frames -> Frames -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Frames
Audio.Frames (Handle -> Int
Sndfile.hFrames Handle
handle) ->
                (Vector Sample -> Block)
-> Stream (Of (Vector Sample)) (ResourceT IO) ()
-> Stream (Of Block) (ResourceT IO) ()
forall (m :: * -> *) a b r.
Monad m =>
(a -> b) -> Stream (Of a) m r -> Stream (Of b) m r
S.map Vector Sample -> Block
Audio.Block (Stream (Of (Vector Sample)) (ResourceT IO) ()
 -> Stream (Of Block) (ResourceT IO) ())
-> Stream (Of (Vector Sample)) (ResourceT IO) ()
-> Stream (Of Block) (ResourceT IO) ()
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> Frames
-> String
-> Handle
-> Stream (Of (Vector Sample)) (ResourceT IO) ()
forall (m :: * -> *).
MonadIO m =>
Int
-> Int
-> Frames
-> String
-> Handle
-> Stream (Of (Vector Sample)) m ()
readHandle Int
rate Int
chan Frames
frame String
fname Handle
handle
        Maybe Handle
_ -> AudioIO rate chan -> Stream (Of Block) (ResourceT IO) ()
forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
Audio m rate chan -> Stream (Of Block) m ()
Audio._stream AudioIO rate chan
onEnoent
    where
    rate :: Int
rate = Proxy rate -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
Audio.natVal (Proxy rate
forall {k} (t :: k). Proxy t
Proxy :: Proxy rate)
    chanP :: Proxy chan
chanP = Proxy chan
forall {k} (t :: k). Proxy t
Proxy :: Proxy chan
    chan :: Int
chan = Proxy chan -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
Audio.natVal Proxy chan
chanP

readHandle :: MonadIO m => Audio.Rate -> Audio.Channels -> Audio.Frames
    -> FilePath -> Sndfile.Handle
    -> S.Stream (S.Of (V.Vector Audio.Sample)) m ()
readHandle :: forall (m :: * -> *).
MonadIO m =>
Int
-> Int
-> Frames
-> String
-> Handle
-> Stream (Of (Vector Sample)) m ()
readHandle Int
rate Int
chan (Audio.Frames Int
frame) String
fname Handle
hdl = do
    let info :: Info
info = Handle -> Info
Sndfile.hInfo Handle
hdl
        fileChan :: Int
fileChan = Info -> Int
Sndfile.channels Info
info
    Bool
-> Stream (Of (Vector Sample)) m ()
-> Stream (Of (Vector Sample)) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Info -> Int
Sndfile.samplerate Info
info Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
rate Bool -> Bool -> Bool
|| Int
fileChan Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Int
1, Int
chan]) (Stream (Of (Vector Sample)) m ()
 -> Stream (Of (Vector Sample)) m ())
-> Stream (Of (Vector Sample)) m ()
-> Stream (Of (Vector Sample)) m ()
forall a b. (a -> b) -> a -> b
$
        String -> Stream (Of (Vector Sample)) m ()
forall {m :: * -> *} {a}. MonadIO m => String -> m a
throw (String -> Stream (Of (Vector Sample)) m ())
-> String -> Stream (Of (Vector Sample)) m ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Info -> String
formatError Int
rate Int
chan Info
info
    Bool
-> Stream (Of (Vector Sample)) m ()
-> Stream (Of (Vector Sample)) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
frame Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Stream (Of (Vector Sample)) m ()
 -> Stream (Of (Vector Sample)) m ())
-> Stream (Of (Vector Sample)) m ()
-> Stream (Of (Vector Sample)) m ()
forall a b. (a -> b) -> a -> b
$
        IO () -> Stream (Of (Vector Sample)) m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Stream (Of (Vector Sample)) m ())
-> IO () -> Stream (Of (Vector Sample)) m ()
forall a b. (a -> b) -> a -> b
$ IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> Int -> IO Int
Sndfile.hSeek Handle
hdl Int
frame
    let size :: Int
size = Frames -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Frames
Audio.blockSize
    (Stream (Of (Vector Sample)) m ()
 -> Stream (Of (Vector Sample)) m ())
-> Stream (Of (Vector Sample)) m ()
forall a. (a -> a) -> a
Fix.fix ((Stream (Of (Vector Sample)) m ()
  -> Stream (Of (Vector Sample)) m ())
 -> Stream (Of (Vector Sample)) m ())
-> (Stream (Of (Vector Sample)) m ()
    -> Stream (Of (Vector Sample)) m ())
-> Stream (Of (Vector Sample)) m ()
forall a b. (a -> b) -> a -> b
$ \Stream (Of (Vector Sample)) m ()
loop -> IO (Maybe (Buffer Sample))
-> Stream (Of (Vector Sample)) m (Maybe (Buffer Sample))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Int -> IO (Maybe (Buffer Sample))
forall e (a :: * -> *).
(Sample e, Buffer a e) =>
Handle -> Int -> IO (Maybe (a e))
Sndfile.hGetBuffer Handle
hdl Int
size) Stream (Of (Vector Sample)) m (Maybe (Buffer Sample))
-> (Maybe (Buffer Sample) -> Stream (Of (Vector Sample)) m ())
-> Stream (Of (Vector Sample)) m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (Buffer Sample)
Nothing -> IO () -> Stream (Of (Vector Sample)) m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Stream (Of (Vector Sample)) m ())
-> IO () -> Stream (Of (Vector Sample)) m ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
Sndfile.hClose Handle
hdl
        Just Buffer Sample
buf -> do
            let block :: Vector Sample
block = Buffer Sample -> Vector Sample
forall a. Buffer a -> Vector a
Sndfile.Buffer.Vector.fromBuffer Buffer Sample
buf
            -- Sndfile should enforce this, but let's be sure.
            Bool
-> Stream (Of (Vector Sample)) m ()
-> Stream (Of (Vector Sample)) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
fileChan Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1 Bool -> Bool -> Bool
&& Vector Sample -> Int
forall a. Storable a => Vector a -> Int
V.length Vector Sample
block Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
chan Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Stream (Of (Vector Sample)) m ()
 -> Stream (Of (Vector Sample)) m ())
-> Stream (Of (Vector Sample)) m ()
-> Stream (Of (Vector Sample)) m ()
forall a b. (a -> b) -> a -> b
$
                String -> Stream (Of (Vector Sample)) m ()
forall {m :: * -> *} {a}. MonadIO m => String -> m a
throw (String -> Stream (Of (Vector Sample)) m ())
-> String -> Stream (Of (Vector Sample)) m ()
forall a b. (a -> b) -> a -> b
$ String
"block length " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Vector Sample -> Int
forall a. Storable a => Vector a -> Int
V.length Vector Sample
block)
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" not a multiple of channels " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
chan
            Vector Sample -> Stream (Of (Vector Sample)) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
S.yield (Vector Sample -> Stream (Of (Vector Sample)) m ())
-> Vector Sample -> Stream (Of (Vector Sample)) m ()
forall a b. (a -> b) -> a -> b
$ if Int
fileChan Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
chan
                then Vector Sample
block
                else Int -> Vector Sample -> Vector Sample
Audio.expandV Int
chan Vector Sample
block
            Stream (Of (Vector Sample)) m ()
loop
    where
    throw :: String -> m a
throw String
msg = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$
        IOError -> IO a
forall e a. Exception e => e -> IO a
Exception.throwIO (IOError -> IO a) -> IOError -> IO a
forall a b. (a -> b) -> a -> b
$ IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
IO.Error.mkIOError IOErrorType
IO.Error.userErrorType
            (String
"reading file: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
msg) Maybe Handle
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
fname)

read44k :: FilePath -> Audio.AudioIO 44100 2
read44k :: String -> AudioIO 44100 2
read44k = String -> AudioIO 44100 2
forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
String -> AudioIO rate chan
read

readUnknown :: FilePath -> IO (Sndfile.Format, Audio.UnknownAudioIO)
readUnknown :: String -> IO (Format, UnknownAudioIO)
readUnknown String
fname = do
    Info
info <- String -> Maybe Info -> IO Info
forall a. String -> Maybe a -> IO a
throwEnoent String
fname (Maybe Info -> IO Info) -> IO (Maybe Info) -> IO Info
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO (Maybe Info)
getInfo String
fname
    case (Int -> SomeNat
Audio.someNat (Info -> Int
Sndfile.samplerate Info
info),
            Int -> SomeNat
Audio.someNat (Info -> Int
Sndfile.channels Info
info)) of
        (TypeLits.SomeNat (Proxy n
_::Proxy rate), TypeLits.SomeNat (Proxy n
_::Proxy chan)) ->
            (Format, UnknownAudioIO) -> IO (Format, UnknownAudioIO)
forall (m :: * -> *) a. Monad m => a -> m a
return
                ( Info -> Format
Sndfile.format Info
info
                , Audio (ResourceT IO) n n -> UnknownAudioIO
forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Audio m rate chan -> UnknownAudio m
Audio.UnknownAudio (Audio (ResourceT IO) n n -> UnknownAudioIO)
-> Audio (ResourceT IO) n n -> UnknownAudioIO
forall a b. (a -> b) -> a -> b
$ forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
String -> AudioIO rate chan
read @rate @chan String
fname
                )

-- | Concatenate multiple files.
concat :: forall rate chan. (TypeLits.KnownNat rate, TypeLits.KnownNat chan)
    => [FilePath] -> Audio.AudioIO rate chan
concat :: forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
[String] -> AudioIO rate chan
concat = [AudioIO rate chan] -> AudioIO rate chan
forall a. Monoid a => [a] -> a
mconcat ([AudioIO rate chan] -> AudioIO rate chan)
-> ([String] -> [AudioIO rate chan])
-> [String]
-> AudioIO rate chan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> AudioIO rate chan) -> [String] -> [AudioIO rate chan]
forall a b. (a -> b) -> [a] -> [b]
map String -> AudioIO rate chan
forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
String -> AudioIO rate chan
read

readCheckpoints :: forall rate chan.
    (TypeLits.KnownNat rate, TypeLits.KnownNat chan)
    => Audio.Frames -> [FilePath] -> Audio.AudioIO rate chan
readCheckpoints :: forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Frames -> [String] -> AudioIO rate chan
readCheckpoints = Frames
-> (String -> IO ()) -> Frames -> [String] -> AudioIO rate chan
forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Frames
-> (String -> IO ()) -> Frames -> [String] -> AudioIO rate chan
readCheckpointsFrom Frames
0 (\String
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | This is like 'concat', but it understands the 0-duration files written
-- by 'writeCheckpoints', and turns them back into silence.
readCheckpointsFrom :: forall rate chan.
    (TypeLits.KnownNat rate, TypeLits.KnownNat chan)
    => Audio.Frames -> (FilePath -> IO ()) -> Audio.Frames -> [FilePath]
    -> Audio.AudioIO rate chan
readCheckpointsFrom :: forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Frames
-> (String -> IO ()) -> Frames -> [String] -> AudioIO rate chan
readCheckpointsFrom Frames
offset String -> IO ()
callback Frames
chunkSize =
    Audio (ResourceT IO) rate chan -> Audio (ResourceT IO) rate chan
forall {rate :: Nat} {chan :: Nat}.
Audio (ResourceT IO) rate chan -> Audio (ResourceT IO) rate chan
untilEof (Audio (ResourceT IO) rate chan -> Audio (ResourceT IO) rate chan)
-> ([String] -> Audio (ResourceT IO) rate chan)
-> [String]
-> Audio (ResourceT IO) rate chan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Audio (ResourceT IO) rate chan] -> Audio (ResourceT IO) rate chan
forall a. Monoid a => [a] -> a
mconcat ([Audio (ResourceT IO) rate chan]
 -> Audio (ResourceT IO) rate chan)
-> ([String] -> [Audio (ResourceT IO) rate chan])
-> [String]
-> Audio (ResourceT IO) rate chan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Frames, String) -> Audio (ResourceT IO) rate chan)
-> [(Frames, String)] -> [Audio (ResourceT IO) rate chan]
forall a b. (a -> b) -> [a] -> [b]
map (Frames, String) -> Audio (ResourceT IO) rate chan
forall {rate :: Nat}.
KnownNat rate =>
(Frames, String) -> Audio (ResourceT IO) rate chan
readFile ([(Frames, String)] -> [Audio (ResourceT IO) rate chan])
-> ([String] -> [(Frames, String)])
-> [String]
-> [Audio (ResourceT IO) rate chan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Frames] -> [String] -> [(Frames, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Frames
chunkOffset Frames -> [Frames] -> [Frames]
forall a. a -> [a] -> [a]
: Frames -> [Frames]
forall a. a -> [a]
repeat Frames
0)
        ([String] -> [(Frames, String)])
-> ([String] -> [String]) -> [String] -> [(Frames, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop (Frames -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Frames
chunkNum)
    where
    readFile :: (Frames, String) -> Audio (ResourceT IO) rate chan
readFile (Frames
chunkOffset, String
fname) =
        -- Round up each chunk to chunkSize, empty and end chunks are short.
        Frames
-> Audio (ResourceT IO) rate chan -> Audio (ResourceT IO) rate chan
forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
(Monad m, KnownNat chan) =>
Frames -> Audio m rate chan -> Audio m rate chan
Audio.take (Frames
chunkSize Frames -> Frames -> Frames
forall a. Num a => a -> a -> a
- Frames
chunkOffset) (Audio (ResourceT IO) rate chan -> Audio (ResourceT IO) rate chan)
-> (String -> Audio (ResourceT IO) rate chan)
-> String
-> Audio (ResourceT IO) rate chan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Audio (ResourceT IO) rate chan
-> Audio (ResourceT IO) rate chan -> Audio (ResourceT IO) rate chan
forall a. Semigroup a => a -> a -> a
<>Audio (ResourceT IO) rate chan
forall (m :: * -> *) (chan :: Nat) (rate :: Nat).
(Monad m, KnownNat chan) =>
Audio m rate chan
Audio.silence)
        (Audio (ResourceT IO) rate chan -> Audio (ResourceT IO) rate chan)
-> (String -> Audio (ResourceT IO) rate chan)
-> String
-> Audio (ResourceT IO) rate chan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO ()
-> Audio (ResourceT IO) rate chan -> Audio (ResourceT IO) rate chan
forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
MonadIO m =>
IO () -> Audio m rate chan -> Audio m rate chan
Audio.effect (String -> IO ()
callback String
fname) (Audio (ResourceT IO) rate chan -> Audio (ResourceT IO) rate chan)
-> (String -> Audio (ResourceT IO) rate chan)
-> String
-> Audio (ResourceT IO) rate chan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Audio (ResourceT IO) rate chan
-> Frames -> String -> Audio (ResourceT IO) rate chan
forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
AudioIO rate chan -> Frames -> String -> AudioIO rate chan
readFrom_ Audio (ResourceT IO) rate chan
forall {rate :: Nat}. Audio (ResourceT IO) rate chan
emitEof Frames
chunkOffset
        (String -> Audio (ResourceT IO) rate chan)
-> String -> Audio (ResourceT IO) rate chan
forall a b. (a -> b) -> a -> b
$ String
fname
    (Frames
chunkNum, Frames
chunkOffset) = Frames
offset Frames -> Frames -> (Frames, Frames)
forall a. Integral a => a -> a -> (a, a)
`divMod` Frames
chunkSize
    -- Encode EOF as a Constant, which 'read' should never return.
    -- This is so I can stop streaming as soon as I run out of files, but not
    -- when I see a zero-length one.
    untilEof :: Audio (ResourceT IO) rate chan -> Audio (ResourceT IO) rate chan
untilEof = (Stream (Of Block) (ResourceT IO) ()
 -> Stream (Of Block) (ResourceT IO) ())
-> Audio (ResourceT IO) rate chan -> Audio (ResourceT IO) rate chan
forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
(Stream (Of Block) m () -> Stream (Of Block) m ())
-> Audio m rate chan -> Audio m rate chan
Audio.apply ((Stream (Of Block) (ResourceT IO) ()
  -> Stream (Of Block) (ResourceT IO) ())
 -> Audio (ResourceT IO) rate chan
 -> Audio (ResourceT IO) rate chan)
-> (Stream (Of Block) (ResourceT IO) ()
    -> Stream (Of Block) (ResourceT IO) ())
-> Audio (ResourceT IO) rate chan
-> Audio (ResourceT IO) rate chan
forall a b. (a -> b) -> a -> b
$ (Block -> Bool)
-> Stream (Of Block) (ResourceT IO) ()
-> Stream (Of Block) (ResourceT IO) ()
forall (m :: * -> *) a r.
Monad m =>
(a -> Bool) -> Stream (Of a) m r -> Stream (Of a) m ()
S.takeWhile (Block -> Block -> Bool
forall a. Eq a => a -> a -> Bool
/= Block
eof)
    emitEof :: Audio (ResourceT IO) rate chan
emitEof = [Block] -> Audio (ResourceT IO) rate chan
forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
(Monad m, KnownNat chan) =>
[Block] -> Audio m rate chan
Audio.fromBlocks [Block
eof]
    eof :: Block
eof = Int -> Sample -> Block
Audio.Constant Int
0 Sample
0

-- ** util

checkInfo :: forall rate chan.
    (TypeLits.KnownNat rate, TypeLits.KnownNat chan)
    => Proxy rate -> Proxy chan -> Sndfile.Info -> Maybe String
checkInfo :: forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Proxy rate -> Proxy chan -> Info -> Maybe String
checkInfo Proxy rate
rate_ Proxy chan
chan_ Info
info
    | Info -> Int
Sndfile.samplerate Info
info Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rate Bool -> Bool -> Bool
&& Info -> Int
Sndfile.channels Info
info Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
chan = Maybe String
forall a. Maybe a
Nothing
    | Bool
otherwise = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Info -> String
formatError Int
rate Int
chan Info
info
    where
    rate :: Int
rate = Proxy rate -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
Audio.natVal Proxy rate
rate_
    chan :: Int
chan = Proxy chan -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
Audio.natVal Proxy chan
chan_

formatError :: Audio.Rate -> Audio.Channels -> Sndfile.Info -> String
formatError :: Int -> Int -> Info -> String
formatError Int
rate Int
chan Info
info =
    String
"requested (rate, channels) " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Int, Int) -> String
forall a. Show a => a -> String
show (Int
rate, Int
chan)
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" but file had " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Int, Int) -> String
forall a. Show a => a -> String
show (Info -> Int
Sndfile.samplerate Info
info, Info -> Int
Sndfile.channels Info
info)

-- * write

write :: forall rate chan. (TypeLits.KnownNat rate, TypeLits.KnownNat chan)
    => Sndfile.Format -> FilePath -> Audio.AudioIO rate chan
    -> Resource.ResourceT IO ()
write :: forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Format -> String -> AudioIO rate chan -> ResourceT IO ()
write Format
format String
fname AudioIO rate chan
audio = do
    (ReleaseKey
key, Handle
hdl) <- IO Handle -> (Handle -> IO ()) -> ResourceT IO (ReleaseKey, Handle)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
Resource.allocate (Format -> String -> AudioIO rate chan -> IO Handle
forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Format -> String -> AudioIO rate chan -> IO Handle
openWrite Format
format String
tmp AudioIO rate chan
audio) Handle -> IO ()
Sndfile.hClose
    (Block -> ResourceT IO ())
-> Stream (Of Block) (ResourceT IO) () -> ResourceT IO ()
forall (m :: * -> *) a x r.
Monad m =>
(a -> m x) -> Stream (Of a) m r -> m r
S.mapM_ (Handle -> Block -> ResourceT IO ()
forall {m :: * -> *}. MonadIO m => Handle -> Block -> m ()
write Handle
hdl) (AudioIO rate chan -> Stream (Of Block) (ResourceT IO) ()
forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
Audio m rate chan -> Stream (Of Block) m ()
Audio._stream AudioIO rate chan
audio)
    ReleaseKey -> ResourceT IO ()
forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
Resource.release ReleaseKey
key
    IO () -> ResourceT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ResourceT IO ()) -> IO () -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
Directory.renameFile String
tmp String
fname
    where
    write :: Handle -> Block -> m ()
write Handle
hdl = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        (IO () -> m ()) -> (Block -> IO ()) -> Block -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Sample -> IO Int) -> [Vector Sample] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> Buffer Sample -> IO Int
forall e (a :: * -> *).
(Sample e, Buffer a e) =>
Handle -> a e -> IO Int
Sndfile.hPutBuffer Handle
hdl (Buffer Sample -> IO Int)
-> (Vector Sample -> Buffer Sample) -> Vector Sample -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Sample -> Buffer Sample
forall a. Vector a -> Buffer a
Sndfile.Buffer.Vector.toBuffer)
        ([Vector Sample] -> IO ())
-> (Block -> [Vector Sample]) -> Block -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> [Vector Sample]
Audio.blockSamples
    tmp :: String
tmp = String
fname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".write.tmp"

-- | Unlike 'readHandle', this writes to a plain IO.Handle instead of a
-- Sndfile.Handle.  Since the plain handle is untyped, the sink will get
-- interleaved Floats.
writeHandle :: MonadIO m => IO.Handle -> Audio.Audio m rate chan -> m ()
writeHandle :: forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
MonadIO m =>
Handle -> Audio m rate chan -> m ()
writeHandle Handle
hdl Audio m rate chan
audio = (Block -> m ()) -> Stream (Of Block) m () -> m ()
forall (m :: * -> *) a x r.
Monad m =>
(a -> m x) -> Stream (Of a) m r -> m r
S.mapM_ (Handle -> Block -> m ()
forall {m :: * -> *}. MonadIO m => Handle -> Block -> m ()
write Handle
hdl) (Audio m rate chan -> Stream (Of Block) m ()
forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
Audio m rate chan -> Stream (Of Block) m ()
Audio._stream Audio m rate chan
audio)
    where write :: Handle -> Block -> m ()
write Handle
hdl = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Block -> IO ()) -> Block -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Sample -> IO ()) -> [Vector Sample] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> Vector Sample -> IO ()
writeVector Handle
hdl) ([Vector Sample] -> IO ())
-> (Block -> [Vector Sample]) -> Block -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> [Vector Sample]
Audio.blockSamples

writeVector :: IO.Handle -> V.Vector Audio.Sample -> IO ()
writeVector :: Handle -> Vector Sample -> IO ()
writeVector Handle
hdl Vector Sample
vector = Vector Sample -> (Ptr Sample -> IO ()) -> IO ()
forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
V.unsafeWith Vector Sample
vector ((Ptr Sample -> IO ()) -> IO ()) -> (Ptr Sample -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Sample
ptr ->
    Handle -> Ptr Sample -> Int -> IO ()
forall a. Handle -> Ptr a -> Int -> IO ()
IO.hPutBuf Handle
hdl Ptr Sample
ptr (Vector Sample -> Int
forall a. Storable a => Vector a -> Int
V.length Vector Sample
vector Int -> Int -> Int
forall a. Num a => a -> a -> a
* Sample -> Int
forall a. Storable a => a -> Int
Storable.sizeOf (Sample
0 :: Audio.Sample))

-- | Write files in chunks to the given directory.  Run actions before
-- and after writing each chunk.
writeCheckpoints :: forall rate chan state.
    (TypeLits.KnownNat rate, TypeLits.KnownNat chan)
    => Audio.Frames
    -> (state -> IO FilePath) -- ^ get filename for this state
    -> (FilePath -> IO ()) -- ^ write state after the computation
    -> Sndfile.Format -> [state]
    -- ^ Some render-specific state for each checkpoint.  Shouldn't run out
    -- before the audio runs out.
    -> Audio.AudioIO rate chan -> Resource.ResourceT IO Int
    -- ^ number of checkpoints written
writeCheckpoints :: forall (rate :: Nat) (chan :: Nat) state.
(KnownNat rate, KnownNat chan) =>
Frames
-> (state -> IO String)
-> (String -> IO ())
-> Format
-> [state]
-> AudioIO rate chan
-> ResourceT IO Int
writeCheckpoints Frames
chunkSize state -> IO String
getFilename String -> IO ()
chunkComplete Format
format = Frames
-> [state] -> Audio (ResourceT IO) rate chan -> ResourceT IO Int
forall {chan :: Nat} {rate :: Nat} {b}.
(KnownNat chan, KnownNat rate, Num b) =>
Frames
-> [state] -> Audio (ResourceT IO) rate chan -> ResourceT IO b
go Frames
0
    where
    go :: Frames
-> [state] -> Audio (ResourceT IO) rate chan -> ResourceT IO b
go !Frames
written (state
state : [state]
states) Audio (ResourceT IO) rate chan
audio = do
        -- getFilename does a deepseq on fname due to unsafe pointer
        -- sketchiness, let's make sure the force actually happens.
        !String
fname <- IO String -> ResourceT IO String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> ResourceT IO String)
-> IO String -> ResourceT IO String
forall a b. (a -> b) -> a -> b
$ state -> IO String
getFilename state
state
        ([Block]
blocks, Audio (ResourceT IO) rate chan
audio) <- Frames
-> Audio (ResourceT IO) rate chan
-> ResourceT IO ([Block], Audio (ResourceT IO) rate chan)
forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
(Monad m, KnownNat chan) =>
Frames -> Audio m rate chan -> m ([Block], Audio m rate chan)
Audio.takeFramesGE Frames
chunkSize Audio (ResourceT IO) rate chan
audio
        if [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
blocks
            then b -> ResourceT IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
chunknum
            else do
                -- The blocks should sum to 'chunkSize', except the last one,
                -- which could be smaller.  But I can't pull from 'audio'
                -- without changing the state, so I have to wait until the next
                -- loop to see if this one was short.
                Bool -> Text -> ResourceT IO ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Bool -> Text -> m ()
Audio.assert (Frames
written Frames -> Frames -> Frames
forall a. Integral a => a -> a -> a
`mod` Frames
chunkSize Frames -> Frames -> Bool
forall a. Eq a => a -> a -> Bool
== Frames
0) (Text -> ResourceT IO ()) -> Text -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$
                    Text
"non-final chunk was too short, expected "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Frames -> Text
forall a. Pretty a => a -> Text
pretty Frames
chunkSize Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", but last chunk was "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Frames -> Text
forall a. Pretty a => a -> Text
pretty (Frames
written Frames -> Frames -> Frames
forall a. Integral a => a -> a -> a
`mod` Frames
chunkSize)
                let blockCount :: Int
blockCount = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Block -> Int) -> [Block] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Int
Audio.blockCount [Block]
blocks
                -- Show the error with count, not frames, in case I somehow get
                -- an odd count.
                Bool -> Text -> ResourceT IO ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Bool -> Text -> m ()
Audio.assert (Int
blockCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
sizeCount) (Text -> ResourceT IO ()) -> Text -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$
                    Text
"chunk too long, expected " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Pretty a => a -> Text
pretty Int
sizeCount
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", but got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Int] -> Text
forall a. Pretty a => a -> Text
pretty ((Block -> Int) -> [Block] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Int
Audio.blockCount [Block]
blocks)
                let tmp :: String
tmp = String
fname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".write.tmp"
                IO () -> ResourceT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ResourceT IO ()) -> IO () -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ do
                    IO Handle -> (Handle -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracket (Format -> String -> Audio (ResourceT IO) rate chan -> IO Handle
forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Format -> String -> AudioIO rate chan -> IO Handle
openWrite Format
format String
tmp Audio (ResourceT IO) rate chan
audio)
                        Handle -> IO ()
Sndfile.hClose (\Handle
hdl -> Handle -> [Block] -> IO ()
writeBlock Handle
hdl [Block]
blocks)
                    String -> String -> IO ()
Directory.renameFile String
tmp String
fname
                    String -> IO ()
chunkComplete String
fname
                Frames
-> [state] -> Audio (ResourceT IO) rate chan -> ResourceT IO b
go (Frames
written Frames -> Frames -> Frames
forall a. Num a => a -> a -> a
+ Frames
chunkSize) [state]
states Audio (ResourceT IO) rate chan
audio
        where
        chunknum :: b
chunknum = Frames -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Frames -> b) -> Frames -> b
forall a b. (a -> b) -> a -> b
$ Frames
written Frames -> Frames -> Frames
forall a. Integral a => a -> a -> a
`div` Frames
chunkSize
    go Frames
_ [] Audio (ResourceT IO) rate chan
_ = Text -> ResourceT IO b
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => Text -> m a
Audio.throwIO Text
"out of states"
    sizeCount :: Int
sizeCount = Proxy chan -> Frames -> Int
forall (chan :: Nat). KnownNat chan => Proxy chan -> Frames -> Int
Audio.framesCount Proxy chan
chan Frames
chunkSize
    chan :: Proxy chan
chan = forall {t :: Nat}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @chan

-- | Because writeCheckpoints writes equal sized chunks, except the last one,
-- I can abbreviate a constant 0 chunk as an empty file.  play_cache has
-- special logic to detect that, and other programs will just consider it
-- empty.
writeBlock :: Sndfile.Handle -> [Audio.Block] -> IO ()
writeBlock :: Handle -> [Block] -> IO ()
writeBlock Handle
hdl [Block]
blocks
    | (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
isZero [Block]
blocks = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise = (Vector Sample -> IO Int) -> [Vector Sample] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Vector Sample -> IO Int
write ([Vector Sample] -> IO ()) -> [Vector Sample] -> IO ()
forall a b. (a -> b) -> a -> b
$ (Block -> [Vector Sample]) -> [Block] -> [Vector Sample]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Block -> [Vector Sample]
Audio.blockSamples [Block]
blocks
    where
    isZero :: Block -> Bool
isZero (Audio.Constant Int
_ Sample
0) = Bool
True
    isZero Block
_ = Bool
False
    write :: Vector Sample -> IO Int
write = Handle -> Buffer Sample -> IO Int
forall e (a :: * -> *).
(Sample e, Buffer a e) =>
Handle -> a e -> IO Int
Sndfile.hPutBuffer Handle
hdl (Buffer Sample -> IO Int)
-> (Vector Sample -> Buffer Sample) -> Vector Sample -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Sample -> Buffer Sample
forall a. Vector a -> Buffer a
Sndfile.Buffer.Vector.toBuffer


-- * Handle

throwEnoent :: FilePath -> Maybe a -> IO a
throwEnoent :: forall a. String -> Maybe a -> IO a
throwEnoent String
fname =
    IO a -> (a -> IO a) -> Maybe a -> IO a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> IO a
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => Text -> m a
Audio.throwIO (Text -> IO a) -> Text -> IO a
forall a b. (a -> b) -> a -> b
$ Text
"file not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Show a => a -> Text
showt String
fname) a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return

openReadThrow :: FilePath -> IO Sndfile.Handle
openReadThrow :: String -> IO Handle
openReadThrow String
fname = String -> Maybe Handle -> IO Handle
forall a. String -> Maybe a -> IO a
throwEnoent String
fname (Maybe Handle -> IO Handle) -> IO (Maybe Handle) -> IO Handle
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO (Maybe Handle)
openRead String
fname

openRead :: FilePath -> IO (Maybe Sndfile.Handle)
openRead :: String -> IO (Maybe Handle)
openRead String
fname = IO Handle -> IO (Maybe Handle)
forall a. IO a -> IO (Maybe a)
Sndfile.ignoreEnoent (IO Handle -> IO (Maybe Handle)) -> IO Handle -> IO (Maybe Handle)
forall a b. (a -> b) -> a -> b
$
    String -> IOMode -> Info -> IO Handle
Sndfile.openFile String
fname IOMode
Sndfile.ReadMode Info
Sndfile.defaultInfo

openWrite :: forall rate chan.
    (TypeLits.KnownNat rate, TypeLits.KnownNat chan)
    => Sndfile.Format -> FilePath -> Audio.AudioIO rate chan
    -> IO Sndfile.Handle
openWrite :: forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Format -> String -> AudioIO rate chan -> IO Handle
openWrite Format
format String
fname AudioIO rate chan
_audio = String -> IOMode -> Info -> IO Handle
Sndfile.openFile String
fname IOMode
Sndfile.WriteMode Info
info
    where
    info :: Info
info = Info
Sndfile.defaultInfo
        { samplerate :: Int
Sndfile.samplerate = Proxy rate -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
Audio.natVal (Proxy rate
forall {k} (t :: k). Proxy t
Proxy :: Proxy rate)
        , channels :: Int
Sndfile.channels = Proxy chan -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
Audio.natVal (Proxy chan
forall {k} (t :: k). Proxy t
Proxy :: Proxy chan)
        , format :: Format
Sndfile.format = Format
format
        }

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