-- 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 =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String
"file not found: " forall a. Semigroup a => a -> a -> a
<> String
fname) (forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Proxy rate -> Proxy chan -> Info -> Maybe String
checkInfo Proxy rate
rate Proxy chan
chan) 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)
_ = forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Proxy rate -> Proxy chan -> String -> IO (Maybe String)
check (forall {k} (t :: k). Proxy t
Proxy :: Proxy rate) (forall {k} (t :: k). Proxy t
Proxy :: Proxy chan)

getInfo :: FilePath -> IO (Maybe Sndfile.Info)
getInfo :: String -> IO (Maybe Info)
getInfo String
fname =
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracket (String -> IO (Maybe Handle)
openRead String
fname) (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) Handle -> IO ()
Sndfile.hClose)
        (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Frames
Audio.Frames forall b c a. (b -> c) -> (a -> b) -> a -> c
. Info -> Int
Sndfile.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 = 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
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Handle -> IO ()
Sndfile.hClose Handle
handle,) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
Stream (Of Block) m () -> Audio m rate chan
Audio.Audio forall a b. (a -> b) -> a -> b
$ do
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
Resource.register (Handle -> IO ()
Sndfile.hClose Handle
handle)
        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 forall a b. (a -> b) -> a -> b
$ 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 = forall (n :: Nat). KnownNat n => Proxy n -> Int
Audio.natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy rate)
    chanP :: Proxy chan
chanP = forall {k} (t :: k). Proxy t
Proxy :: Proxy chan
    chan :: Int
chan = 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 =
    forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
AudioIO rate chan -> Frames -> String -> AudioIO rate chan
readFrom_ (forall (rate :: Nat) (chan :: Nat).
HasCallStack =>
Text -> AudioIO rate chan
Audio.throw forall a b. (a -> b) -> a -> b
$ Text
"file not found: " forall a. Semigroup a => a -> a -> a
<> 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 = forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
Stream (Of Block) m () -> Audio m rate chan
Audio.Audio forall a b. (a -> b) -> a -> b
$ do
    (ReleaseKey
_, Maybe Handle
mbHandle) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
Resource.allocate (String -> IO (Maybe Handle)
openRead String
fname)
        (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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 forall a. Ord a => a -> a -> Bool
<= Frames
frame Bool -> Bool -> Bool
&& Frames
frame forall a. Ord a => a -> a -> Bool
<= Int -> Frames
Audio.Frames (Handle -> Int
Sndfile.hFrames Handle
handle) ->
                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 forall a b. (a -> b) -> a -> b
$ 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
_ -> forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
Audio m rate chan -> Stream (Of Block) m ()
Audio._stream AudioIO rate chan
onEnoent
    where
    rate :: Int
rate = forall (n :: Nat). KnownNat n => Proxy n -> Int
Audio.natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy rate)
    chanP :: Proxy chan
chanP = forall {k} (t :: k). Proxy t
Proxy :: Proxy chan
    chan :: Int
chan = 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
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Info -> Int
Sndfile.samplerate Info
info forall a. Eq a => a -> a -> Bool
/= Int
rate Bool -> Bool -> Bool
|| Int
fileChan forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Int
1, Int
chan]) forall a b. (a -> b) -> a -> b
$
        forall {m :: * -> *} {a}. MonadIO m => String -> m a
throw forall a b. (a -> b) -> a -> b
$ Int -> Int -> Info -> String
formatError Int
rate Int
chan Info
info
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
frame forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Handle -> Int -> IO Int
Sndfile.hSeek Handle
hdl Int
frame
    let size :: Int
size = forall a b. (Integral a, Num b) => a -> b
fromIntegral Frames
Audio.blockSize
    forall a. (a -> a) -> a
Fix.fix forall a b. (a -> b) -> a -> b
$ \Stream (Of (Vector Sample)) m ()
loop -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall e (a :: * -> *).
(Sample e, Buffer a e) =>
Handle -> Int -> IO (Maybe (a e))
Sndfile.hGetBuffer Handle
hdl Int
size) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (Buffer Sample)
Nothing -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
Sndfile.hClose Handle
hdl
        Just Buffer Sample
buf -> do
            let block :: Vector Sample
block = forall a. Buffer a -> Vector a
Sndfile.Buffer.Vector.fromBuffer Buffer Sample
buf
            -- Sndfile should enforce this, but let's be sure.
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
fileChan forall a. Eq a => a -> a -> Bool
/= Int
1 Bool -> Bool -> Bool
&& forall a. Storable a => Vector a -> Int
V.length Vector Sample
block forall a. Integral a => a -> a -> a
`mod` Int
chan forall a. Eq a => a -> a -> Bool
/= Int
0) forall a b. (a -> b) -> a -> b
$
                forall {m :: * -> *} {a}. MonadIO m => String -> m a
throw forall a b. (a -> b) -> a -> b
$ String
"block length " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall a. Storable a => Vector a -> Int
V.length Vector Sample
block)
                    forall a. Semigroup a => a -> a -> a
<> String
" not a multiple of channels " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
chan
            forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
S.yield forall a b. (a -> b) -> a -> b
$ if Int
fileChan 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
        forall e a. Exception e => e -> IO a
Exception.throwIO forall a b. (a -> b) -> a -> b
$ IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
IO.Error.mkIOError IOErrorType
IO.Error.userErrorType
            (String
"reading file: " forall a. Semigroup a => a -> a -> a
<> String
msg) forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just String
fname)

read44k :: FilePath -> Audio.AudioIO 44100 2
read44k :: String -> AudioIO 44100 2
read44k = 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 <- forall a. String -> Maybe a -> IO a
throwEnoent String
fname 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)) ->
            forall (m :: * -> *) a. Monad m => a -> m a
return
                ( Info -> Format
Sndfile.format Info
info
                , forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Audio m rate chan -> UnknownAudio m
Audio.UnknownAudio 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 = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map 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 = forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Frames
-> (String -> IO ()) -> Frames -> [String] -> AudioIO rate chan
readCheckpointsFrom Frames
0 (\String
_ -> 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 =
    forall {rate :: Nat} {chan :: Nat}.
Audio (ResourceT IO) rate chan -> Audio (ResourceT IO) rate chan
untilEof forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {rate :: Nat}.
KnownNat rate =>
(Frames, String) -> Audio (ResourceT IO) rate chan
readFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip (Frames
chunkOffset forall a. a -> [a] -> [a]
: forall a. a -> [a]
repeat Frames
0)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop (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.
        forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
(Monad m, KnownNat chan) =>
Frames -> Audio m rate chan -> Audio m rate chan
Audio.take (Frames
chunkSize forall a. Num a => a -> a -> a
- Frames
chunkOffset) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<>forall (m :: * -> *) (chan :: Nat) (rate :: Nat).
(Monad m, KnownNat chan) =>
Audio m rate chan
Audio.silence)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
MonadIO m =>
IO () -> Audio m rate chan -> Audio m rate chan
Audio.effect (String -> IO ()
callback String
fname) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
AudioIO rate chan -> Frames -> String -> AudioIO rate chan
readFrom_ forall {rate :: Nat}. Audio (ResourceT IO) rate chan
emitEof Frames
chunkOffset
        forall a b. (a -> b) -> a -> b
$ String
fname
    (Frames
chunkNum, Frames
chunkOffset) = Frames
offset 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 = forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
(Stream (Of Block) m () -> Stream (Of Block) m ())
-> Audio m rate chan -> Audio m rate chan
Audio.apply forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a r.
Monad m =>
(a -> Bool) -> Stream (Of a) m r -> Stream (Of a) m ()
S.takeWhile (forall a. Eq a => a -> a -> Bool
/= Block
eof)
    emitEof :: Audio (ResourceT IO) rate chan
emitEof = 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 forall a. Eq a => a -> a -> Bool
== Int
rate Bool -> Bool -> Bool
&& Info -> Int
Sndfile.channels Info
info forall a. Eq a => a -> a -> Bool
== Int
chan = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> Int -> Info -> String
formatError Int
rate Int
chan Info
info
    where
    rate :: Int
rate = forall (n :: Nat). KnownNat n => Proxy n -> Int
Audio.natVal Proxy rate
rate_
    chan :: Int
chan = 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) " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Int
rate, Int
chan)
    forall a. Semigroup a => a -> a -> a
<> String
" but file had " forall a. Semigroup a => a -> a -> a
<> 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) <- forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
Resource.allocate (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
    forall (m :: * -> *) a x r.
Monad m =>
(a -> m x) -> Stream (Of a) m r -> m r
S.mapM_ (forall {m :: * -> *}. MonadIO m => Handle -> Block -> m ()
write Handle
hdl) (forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
Audio m rate chan -> Stream (Of Block) m ()
Audio._stream AudioIO rate chan
audio)
    forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
Resource.release ReleaseKey
key
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
Directory.renameFile String
tmp String
fname
    where
    write :: Handle -> Block -> m ()
write Handle
hdl = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall e (a :: * -> *).
(Sample e, Buffer a e) =>
Handle -> a e -> IO Int
Sndfile.hPutBuffer Handle
hdl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> Buffer a
Sndfile.Buffer.Vector.toBuffer)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> [Vector Sample]
Audio.blockSamples
    tmp :: String
tmp = String
fname 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 = forall (m :: * -> *) a x r.
Monad m =>
(a -> m x) -> Stream (Of a) m r -> m r
S.mapM_ (forall {m :: * -> *}. MonadIO m => Handle -> Block -> m ()
write Handle
hdl) (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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> Vector Sample -> IO ()
writeVector Handle
hdl) 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 = forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
V.unsafeWith Vector Sample
vector forall a b. (a -> b) -> a -> b
$ \Ptr Sample
ptr ->
    forall a. Handle -> Ptr a -> Int -> IO ()
IO.hPutBuf Handle
hdl Ptr Sample
ptr (forall a. Storable a => Vector a -> Int
V.length Vector Sample
vector forall a. Num a => a -> a -> a
* 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 = 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ state -> IO String
getFilename state
state
        ([Block]
blocks, Audio (ResourceT IO) rate chan
audio) <- 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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
blocks
            then 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.
                forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Bool -> Text -> m ()
Audio.assert (Frames
written forall a. Integral a => a -> a -> a
`mod` Frames
chunkSize forall a. Eq a => a -> a -> Bool
== Frames
0) forall a b. (a -> b) -> a -> b
$
                    Text
"non-final chunk was too short, expected "
                    forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty Frames
chunkSize forall a. Semigroup a => a -> a -> a
<> Text
", but last chunk was "
                    forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty (Frames
written forall a. Integral a => a -> a -> a
`mod` Frames
chunkSize)
                let blockCount :: Int
blockCount = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum forall a b. (a -> b) -> a -> b
$ 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.
                forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Bool -> Text -> m ()
Audio.assert (Int
blockCount forall a. Ord a => a -> a -> Bool
<= Int
sizeCount) forall a b. (a -> b) -> a -> b
$
                    Text
"chunk too long, expected " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty Int
sizeCount
                    forall a. Semigroup a => a -> a -> a
<> Text
", but got " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty (forall a b. (a -> b) -> [a] -> [b]
map Block -> Int
Audio.blockCount [Block]
blocks)
                let tmp :: String
tmp = String
fname forall a. [a] -> [a] -> [a]
++ String
".write.tmp"
                forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
                    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracket (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 forall a. Num a => a -> a -> a
+ Frames
chunkSize) [state]
states Audio (ResourceT IO) rate chan
audio
        where
        chunknum :: b
chunknum = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Frames
written forall a. Integral a => a -> a -> a
`div` Frames
chunkSize
    go Frames
_ [] Audio (ResourceT IO) rate chan
_ = forall (m :: * -> *) a. (HasCallStack, MonadIO m) => Text -> m a
Audio.throwIO Text
"out of states"
    sizeCount :: Int
sizeCount = forall (chan :: Nat). KnownNat chan => Proxy chan -> Frames -> Int
Audio.framesCount Proxy chan
chan Frames
chunkSize
    chan :: Proxy chan
chan = 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
    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
isZero [Block]
blocks = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Vector Sample -> IO Int
write forall a b. (a -> b) -> a -> b
$ 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 = forall e (a :: * -> *).
(Sample e, Buffer a e) =>
Handle -> a e -> IO Int
Sndfile.hPutBuffer Handle
hdl forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. (HasCallStack, MonadIO m) => Text -> m a
Audio.throwIO forall a b. (a -> b) -> a -> b
$ Text
"file not found: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt String
fname) forall (m :: * -> *) a. Monad m => a -> m a
return

openReadThrow :: FilePath -> IO Sndfile.Handle
openReadThrow :: String -> IO Handle
openReadThrow String
fname = forall a. String -> Maybe a -> IO a
throwEnoent String
fname 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 = forall a. IO a -> IO (Maybe a)
Sndfile.ignoreEnoent 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 = forall (n :: Nat). KnownNat n => Proxy n -> Int
Audio.natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy rate)
        , channels :: Int
Sndfile.channels = forall (n :: Nat). KnownNat n => Proxy n -> Int
Audio.natVal (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
    }