-- 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 CPP #-}
-- | Resample audio signals via libsamplerate.
module Util.Audio.Resample (
    resample, resampleRate
    , Config(..), defaultConfig
    , resampleBy
    , Quality(..)
    , SavedState
#ifdef TESTING
    , module Util.Audio.Resample
#endif
) where
import qualified Control.Monad.Trans.Resource as Resource
import qualified Data.ByteString as ByteString
import qualified Data.Maybe as Maybe
import qualified Data.Text as Text
import qualified Data.Vector.Storable as V

import qualified Foreign
import qualified Foreign.C as C
import qualified GHC.TypeLits as TypeLits
import           GHC.TypeLits (KnownNat)
import qualified Streaming.Prelude as S

import qualified Util.Audio.Audio as Audio
import qualified Util.Audio.SampleRateC as SampleRateC
import           Util.Audio.SampleRateC (Quality(..), SavedState(..))
import qualified Util.Control as Control
import qualified Util.Num as Num
import qualified Util.Segment as Segment
import qualified Util.Serialize as Serialize

import qualified Perform.RealTime as RealTime
import qualified Perform.Signal as Signal

import           Global
import           Synth.Types


-- TODO resampling is theoretically pure, so I could maybe unsafePerformIO the
-- resampling

-- | Resample the audio by a constant ratio.  This doesn't actually change the
-- sampling rate, since I just use this to change the pitch.
resample :: forall rate chan. (KnownNat chan, KnownNat rate)
    => Quality -> Double
    -> Audio.AudioIO rate chan -> Audio.AudioIO rate chan
resample :: forall (rate :: Nat) (chan :: Nat).
(KnownNat chan, KnownNat rate) =>
Quality -> Y -> AudioIO rate chan -> AudioIO rate chan
resample Quality
quality Y
ratio =
    forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Config -> Control -> AudioIO rate chan -> AudioIO rate chan
resampleBy (Quality -> Config
defaultConfig Quality
quality) (forall {k} (kind :: k). Y -> Signal kind
Signal.constant Y
ratio)

instance Pretty SavedState where
    pretty :: SavedState -> Text
pretty (SavedState ByteString
bs1 ByteString
bs2) = [Text] -> Text
Text.unwords
        [ Text
"((SavedState"
        , forall a. Show a => a -> Text
showt (ByteString -> Int
ByteString.length ByteString
bs1)
        , forall a. Show a => a -> Text
showt (ByteString -> Int
ByteString.length ByteString
bs2) forall a. Semigroup a => a -> a -> a
<> Text
"))"
        ]

-- | Configure the resampler.
data Config = Config {
    Config -> Quality
_quality :: Quality
    , Config -> Maybe SavedState
_state :: Maybe SavedState
    -- | Called before yielding a block.  The final call is with Nothing,
    -- before yielding the final block.  At that point the state should be
    -- used up.
    , Config -> Maybe (Frames, SavedState) -> IO ()
_notifyState :: Maybe (Audio.Frames, SavedState) -> IO ()
    , Config -> Frames
_blockSize :: Audio.Frames
    -- | This affects the first block size.  This is so that block boundaries
    -- fall on multiples of blockSize.
    , Config -> Frames
_now :: Audio.Frames
    -- | This is unused, but useful for debugging.
    , Config -> String
_name :: String
    }

defaultConfig :: Quality -> Config
defaultConfig :: Quality -> Config
defaultConfig Quality
quality = Config
    { _quality :: Quality
_quality = Quality
quality
    , _state :: Maybe SavedState
_state = forall a. Maybe a
Nothing
    , _notifyState :: Maybe (Frames, SavedState) -> IO ()
_notifyState = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
    , _now :: Frames
_now = Frames
0
    , _blockSize :: Frames
_blockSize = Frames
Audio.blockSize
    , _name :: String
_name = String
"default"
    }

-- | Resample the audio by the given curve.  This doesn't actually change the
-- sampling rate, since I just use this to change the pitch.
resampleBy :: forall rate chan. (KnownNat rate, KnownNat chan)
    => Config -> Signal.Control
    -> Audio.AudioIO rate chan -> Audio.AudioIO rate chan
resampleBy :: forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Config -> Control -> AudioIO rate chan -> AudioIO rate chan
resampleBy Config
config Control
ratios AudioIO rate chan
audio = 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
key, State
state) <- 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
        (Quality -> Int -> IO State
SampleRateC.new (Config -> Quality
_quality Config
config)
            (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
TypeLits.natVal Proxy chan
chan)))
        State -> IO ()
SampleRateC.delete
    -- Debug.tracepM "RESAMPLE: now, ratios" (_now config, ratios)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ case (Config -> Maybe SavedState
_state Config
config) of
        Maybe SavedState
Nothing -> State -> Y -> IO ()
SampleRateC.setRatio State
state forall a b. (a -> b) -> a -> b
$ forall {k} (kind :: k). Signal kind -> X -> Y
Signal.at Control
ratios X
0
        Just SavedState
saved -> do
            Bool
ok <- Quality -> State -> SavedState -> IO Bool
SampleRateC.putState (Config -> Quality
_quality Config
config) State
state SavedState
saved
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ok forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *) a. (HasCallStack, MonadIO m) => Text -> m a
Audio.throwIO forall a b. (a -> b) -> a -> b
$ Text
"state is the wrong size: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty SavedState
saved
    -- I have to collect blocks until I fill up the output block size.  The key
    -- thing is to not let the resample state get ahead of the block boundary.
    let align :: Frames
align = Config -> Frames
_blockSize Config
config forall a. Num a => a -> a -> a
- (Config -> Frames
_now Config
config forall a. Integral a => a -> a -> a
`mod` Config -> Frames
_blockSize Config
config)
    -- I keep track of the number of samples read from upstream.  This gets
    -- reported to '_notifyState' so I can restart the sample at the right
    -- place.
    -- I also keep track of the previous segment to detect discontinuities.
    -- Use frame -1 for the initial prevSegment.  If I happen to be starting on
    -- a discontinuity, I need to do a setRatio.
    let initialState :: (Frames, Segment)
initialState = (Frames
0, Int -> Control -> X -> Segment
segmentAt Int
rate Control
ratios (Frames -> X
toSeconds (-Frames
1)))
    forall s1 s2 a. s1 -> s2 -> ((s1 -> s2 -> a) -> s1 -> s2 -> a) -> a
Control.loop2 (Frames, Segment)
initialState (Frames
0, forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
Audio m rate chan -> Stream (Of Block) m ()
Audio._stream AudioIO rate chan
audio, [], Frames
align) forall a b. (a -> b) -> a -> b
$
        \(Frames, Segment)
-> (Frames, Stream (Of Block) (ResourceT IO) (), [Vector Sample],
    Frames)
-> Stream (Of Block) (ResourceT IO) ()
loop (Frames
framesRead, Segment
prevSegment) (Frames
now, Stream (Of Block) (ResourceT IO) ()
audio, [Vector Sample]
collect, Frames
blockLeft) -> do
            let segment :: Segment
segment = Int -> Control -> X -> Segment
segmentAt Int
rate Control
ratios (Frames -> X
toSeconds Frames
now)
            Maybe (Frames, Vector Sample, Stream (Of Block) (ResourceT IO) ())
result <- forall (chan :: Nat).
KnownNat chan =>
Proxy chan
-> Int
-> State
-> Frames
-> Frames
-> Segment
-> Segment
-> Stream (Of Block) (ResourceT IO) ()
-> Stream
     (Maybe
        (Frames, Vector Sample, Stream (Of Block) (ResourceT IO) ()))
resampleBlock Proxy chan
chan Int
rate State
state Frames
now Frames
blockLeft Segment
prevSegment
                Segment
segment Stream (Of Block) (ResourceT IO) ()
audio
            case Maybe (Frames, Vector Sample, Stream (Of Block) (ResourceT IO) ())
result of
                Maybe (Frames, Vector Sample, Stream (Of Block) (ResourceT IO) ())
Nothing -> forall {m :: * -> *}.
MonadIO m =>
ReleaseKey -> [Vector Sample] -> Stream (Of Block) m ()
done ReleaseKey
key [Vector Sample]
collect
                Just (Frames
blockRead, Vector Sample
block, Stream (Of Block) (ResourceT IO) ()
audio) -> do
                    (Frames, Stream (Of Block) (ResourceT IO) (), [Vector Sample],
 Frames)
nextState <- forall {m :: * -> *} {b}.
MonadIO m =>
State
-> Frames
-> Frames
-> [Vector Sample]
-> Frames
-> Vector Sample
-> b
-> Stream (Of Block) m (Frames, b, [Vector Sample], Frames)
yield State
state Frames
now (Frames
framesRead forall a. Num a => a -> a -> a
+ Frames
blockRead)
                        [Vector Sample]
collect Frames
blockLeft Vector Sample
block Stream (Of Block) (ResourceT IO) ()
audio
                    (Frames, Segment)
-> (Frames, Stream (Of Block) (ResourceT IO) (), [Vector Sample],
    Frames)
-> Stream (Of Block) (ResourceT IO) ()
loop (Frames
framesRead forall a. Num a => a -> a -> a
+ Frames
blockRead, Segment
segment) (Frames, Stream (Of Block) (ResourceT IO) (), [Vector Sample],
 Frames)
nextState
    where
    done :: ReleaseKey -> [Vector Sample] -> Stream (Of Block) m ()
done ReleaseKey
key [Vector Sample]
collect = do
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Config -> Maybe (Frames, SavedState) -> IO ()
_notifyState Config
config forall a. Maybe a
Nothing
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Vector Sample]
collect) forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
S.yield forall a b. (a -> b) -> a -> b
$ Vector Sample -> Block
Audio.Block forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat (forall a. [a] -> [a]
reverse [Vector Sample]
collect)
        -- Resource.release will delete the state, at which point a pointer
        -- from unsafeGetState will be dangling.  I think Sampler.Render will
        -- omit it from the playing notes and not ask for the state anyway, but
        -- let's not leave a dangling pointer around anyway.
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Config -> Maybe (Frames, SavedState) -> IO ()
_notifyState Config
config forall a. Maybe a
Nothing
        forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
Resource.release ReleaseKey
key
    yield :: State
-> Frames
-> Frames
-> [Vector Sample]
-> Frames
-> Vector Sample
-> b
-> Stream (Of Block) m (Frames, b, [Vector Sample], Frames)
yield State
state Frames
now Frames
used [Vector Sample]
collect Frames
blockLeft Vector Sample
block b
audio
        | Frames
blockLeft forall a. Num a => a -> a -> a
- Frames
generated forall a. Ord a => a -> a -> Bool
> Frames
0 = forall (m :: * -> *) a. Monad m => a -> m a
return
            ( Frames
now forall a. Num a => a -> a -> a
+ Frames
generated
            , b
audio
            , Vector Sample
block forall a. a -> [a] -> [a]
: [Vector Sample]
collect
            , Frames
blockLeft forall a. Num a => a -> a -> a
- Frames
generated
            )
        | Frames
blockLeft forall a. Num a => a -> a -> a
- Frames
generated forall a. Eq a => a -> a -> Bool
== Frames
0 = do
            let sizes :: [Frames]
sizes = forall a b. (a -> b) -> [a] -> [b]
map (forall (chan :: Nat).
KnownNat chan =>
Proxy chan -> Vector Sample -> Frames
Audio.vectorFrames Proxy chan
chan) (Vector Sample
blockforall a. a -> [a] -> [a]
:[Vector Sample]
collect)
            forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Bool -> Text -> m ()
Audio.assert (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum [Frames]
sizes forall a. Ord a => a -> a -> Bool
<= Config -> Frames
_blockSize Config
config) forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unwords
                [ Text
"sum", forall a. Pretty a => a -> Text
pretty (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum [Frames]
sizes), Text
"> blockSize"
                , forall a. Pretty a => a -> Text
pretty (Config -> Frames
_blockSize Config
config) forall a. Semigroup a => a -> a -> a
<> Text
":", forall a. Pretty a => a -> Text
pretty [Frames]
sizes
                ]
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
                SavedState
rState <- State -> IO SavedState
SampleRateC.unsafeGetState State
state
                Config -> Maybe (Frames, SavedState) -> IO ()
_notifyState Config
config forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Frames
used, SavedState
rState)
            forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
S.yield forall a b. (a -> b) -> a -> b
$ Vector Sample -> Block
Audio.Block forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat (forall a. [a] -> [a]
reverse (Vector Sample
block forall a. a -> [a] -> [a]
: [Vector Sample]
collect))
            forall (m :: * -> *) a. Monad m => a -> m a
return
                ( Frames
now forall a. Num a => a -> a -> a
+ Frames
generated
                , b
audio
                , []
                , Config -> Frames
_blockSize Config
config
                )
        | Bool
otherwise = forall (m :: * -> *) a. (HasCallStack, MonadIO m) => Text -> m a
Audio.throwIO forall a b. (a -> b) -> a -> b
$ Text
"resampleBlock generated too much: "
            forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty (Frames
blockLeft, Frames
generated)
        where generated :: Frames
generated = forall (chan :: Nat).
KnownNat chan =>
Proxy chan -> Vector Sample -> Frames
Audio.vectorFrames Proxy chan
chan Vector Sample
block

    chan :: Proxy chan
chan = forall {k} (t :: k). Proxy t
Proxy :: Proxy chan
    rate :: Audio.Rate
    rate :: Int
rate = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
TypeLits.natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy rate)
    toSeconds :: Frames -> X
toSeconds = Y -> X
RealTime.seconds forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Frames -> Y
Audio.framesToSeconds Int
rate

type Segment = Segment.Segment Signal.Y

segmentAt :: Audio.Rate -> Signal.Control -> RealTime -> Segment
segmentAt :: Int -> Control -> X -> Segment
segmentAt Int
rate Control
ratios X
x0 = case forall {k} (kind :: k). Signal kind -> X -> Maybe Segment
Signal.segment_at Control
ratios X
x0 of
    Just Segment
segment
        -- If the difference is less than a sample, I don't want it, because
        -- resampleBlock will then give 0 input samples, which will loop
        -- forever.
        | forall y. Segment y -> X
Segment._x2 Segment
segment forall a. Num a => a -> a -> a
- X
eta forall a. Ord a => a -> a -> Bool
< X
x0 -> Int -> Control -> X -> Segment
segmentAt Int
rate Control
ratios (X
x0forall a. Num a => a -> a -> a
+X
eta)
        | Bool
otherwise -> Segment
segment
    Maybe Segment
Nothing
        | Just (X
x, Y
y) <- forall {k} (kind :: k). Signal kind -> Maybe (X, Y)
Signal.last Control
ratios, X
x0 forall a. Ord a => a -> a -> Bool
>= X
x ->
            forall y. X -> y -> X -> y -> Segment y
Segment.Segment X
0 Y
y X
RealTime.large Y
y
        | Bool
otherwise -> forall y. X -> y -> X -> y -> Segment y
Segment.Segment X
0 Y
1 X
RealTime.large Y
1
    where
    eta :: X
eta = X
1 forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rate

type Stream a = S.Stream (S.Of Audio.Block) (Resource.ResourceT IO) a

-- | Generate no more than the given number of frames.
resampleBlock :: KnownNat chan => Proxy chan -> Audio.Rate
    -> SampleRateC.State -> Audio.Frames -> Audio.Frames
    -> Segment -> Segment -> Stream ()
    -> Stream (Maybe (Audio.Frames, V.Vector Audio.Sample, Stream ()))
resampleBlock :: forall (chan :: Nat).
KnownNat chan =>
Proxy chan
-> Int
-> State
-> Frames
-> Frames
-> Segment
-> Segment
-> Stream (Of Block) (ResourceT IO) ()
-> Stream
     (Maybe
        (Frames, Vector Sample, Stream (Of Block) (ResourceT IO) ()))
resampleBlock Proxy chan
chan Int
rate State
state Frames
start Frames
maxFrames Segment
prevSegment Segment
segment Stream (Of Block) (ResourceT IO) ()
audio = do
    -- 'start' is the *output* frame.  It indexes ratios, because that's
    -- RealTime.
    (Maybe (Vector Sample)
inputBlock, Stream (Of Block) (ResourceT IO) ()
audio) <- forall {t :: (* -> *) -> * -> *} {m :: * -> *} {a}.
(MonadTrans t, Monad m, Functor (t m)) =>
Stream (Of Block) m a
-> t m (Maybe (Vector Sample), Stream (Of Block) m a)
next Stream (Of Block) (ResourceT IO) ()
audio
    (Bool
atEnd, Stream (Of Block) (ResourceT IO) ()
audio) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> m (Bool, Stream (Of a) m r)
checkEnd Stream (Of Block) (ResourceT IO) ()
audio
    let inputFrames :: Frames
inputFrames = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Frames
0 (forall (chan :: Nat).
KnownNat chan =>
Proxy chan -> Vector Sample -> Frames
Audio.vectorFrames Proxy chan
chan) Maybe (Vector Sample)
inputBlock
    -- Never go past the next breakpoint.
    let outputFrames :: Frames
outputFrames = forall a. Ord a => a -> a -> a
min Frames
maxFrames (X -> Frames
toFrames (forall y. Segment y -> X
Segment._x2 Segment
segment) forall a. Num a => a -> a -> a
- Frames
start)

    -- Debug.tracepM "(start, end), (prev, segment)"
    --     ((start, start+outputFrames), (showSeg prevSegment, showSeg segment))

    let destRatio :: Y
destRatio = Segment -> X -> Y
Segment.num_interpolate_s Segment
segment forall a b. (a -> b) -> a -> b
$
            Frames -> X
toSeconds forall a b. (a -> b) -> a -> b
$ Frames
start forall a. Num a => a -> a -> a
+ Frames
outputFrames
        -- Progress through the ratios signal proceeds in real time, which is
        -- to say, outputFrames.
    let with :: (Ptr Sample -> IO b) -> IO b
with = forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
V.unsafeWith (forall a. a -> Maybe a -> a
fromMaybe forall a. Storable a => Vector a
V.empty Maybe (Vector Sample)
inputBlock)
    (Frames
used, Frames
generated, ForeignPtr Sample
outFP) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall {b}. (Ptr Sample -> IO b) -> IO b
with forall a b. (a -> b) -> a -> b
$ \Ptr Sample
blockp -> do
        -- Discontinuity in the ratios signal.
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Segment
segment forall a. Eq a => a -> a -> Bool
/= Segment
prevSegment
                Bool -> Bool -> Bool
&& forall y. Segment y -> y
Segment._y2 Segment
prevSegment forall a. Eq a => a -> a -> Bool
/= forall y. Segment y -> y
Segment._y1 Segment
segment) forall a b. (a -> b) -> a -> b
$ do
            -- Debug.tracepM "setRatio" (Segment._y1 segment)
            State -> Y -> IO ()
SampleRateC.setRatio State
state (forall y. Segment y -> y
Segment._y1 Segment
segment)
        Ptr Sample
outp <- forall a. Storable a => Int -> IO (Ptr a)
Foreign.mallocArray forall a b. (a -> b) -> a -> b
$ forall (chan :: Nat). KnownNat chan => Proxy chan -> Frames -> Int
Audio.framesCount Proxy chan
chan Frames
outputFrames
        Output
result <- State -> Input -> IO Output
SampleRateC.process State
state forall a b. (a -> b) -> a -> b
$ SampleRateC.Input
            { data_in :: Ptr CFloat
data_in =
                (forall a b. Ptr a -> Ptr b
Foreign.castPtr :: Foreign.Ptr Float -> Foreign.Ptr C.CFloat)
                Ptr Sample
blockp
            , data_out :: Ptr CFloat
data_out = forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr Sample
outp
            , input_frames :: Integer
input_frames = forall a b. (Integral a, Num b) => a -> b
fromIntegral Frames
inputFrames
            , output_frames :: Integer
output_frames = forall a b. (Integral a, Num b) => a -> b
fromIntegral Frames
outputFrames
            , src_ratio :: Y
src_ratio = Y
destRatio
            , end_of_input :: Bool
end_of_input = Bool
atEnd
            }
        ForeignPtr Sample
outFP <- forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
Foreign.newForeignPtr forall a. FinalizerPtr a
Foreign.finalizerFree Ptr Sample
outp
        forall (m :: * -> *) a. Monad m => a -> m a
return
            ( Int -> Frames
Audio.Frames forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$
                Output -> Integer
SampleRateC.input_frames_used Output
result
            , Int -> Frames
Audio.Frames forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$
                Output -> Integer
SampleRateC.output_frames_generated Output
result
            , ForeignPtr Sample
outFP
            )

    -- Stick unconsumed input back on the stream.
    let left :: Vector Sample
left = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Storable a => Vector a
V.empty (forall a. Storable a => Int -> Vector a -> Vector a
V.drop (forall (chan :: Nat). KnownNat chan => Proxy chan -> Frames -> Int
Audio.framesCount Proxy chan
chan Frames
used)) Maybe (Vector Sample)
inputBlock
        recons :: Stream (Of Block) (ResourceT IO) r
-> Stream (Of Block) (ResourceT IO) r
recons = if forall a. Storable a => Vector a -> Bool
V.null Vector Sample
left then forall a. a -> a
id else forall (m :: * -> *) a r.
Monad m =>
a -> Stream (Of a) m r -> Stream (Of a) m r
S.cons (Vector Sample -> Block
Audio.Block Vector Sample
left)
    let outputBlock :: Vector Sample
outputBlock = forall a. ForeignPtr a -> Int -> Vector a
V.unsafeFromForeignPtr0 ForeignPtr Sample
outFP forall a b. (a -> b) -> a -> b
$
            forall (chan :: Nat). KnownNat chan => Proxy chan -> Frames -> Int
Audio.framesCount Proxy chan
chan Frames
generated

    -- srcRatio <- liftIO $ SampleRateC.getRatio state
    -- Debug.tracepM "OUTPUT"
    --     ((srcRatio, destRatio), (used, generated),
    --         (oneChan <$> inputBlock, oneChan outputBlock))

    let framesRead :: Frames
framesRead = forall (chan :: Nat). KnownNat chan => Proxy chan -> Int -> Frames
Audio.countFrames Proxy chan
chan forall a b. (a -> b) -> a -> b
$
            forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall a. Storable a => Vector a -> Int
V.length Maybe (Vector Sample)
inputBlock forall a. Num a => a -> a -> a
- forall a. Storable a => Vector a -> Int
V.length Vector Sample
left
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall a. Maybe a -> Bool
Maybe.isNothing Maybe (Vector Sample)
inputBlock Bool -> Bool -> Bool
&& Frames
generated forall a. Eq a => a -> a -> Bool
== Frames
0
        then forall a. Maybe a
Nothing
        else forall a. a -> Maybe a
Just (Frames
framesRead, Vector Sample
outputBlock, forall {r}.
Stream (Of Block) (ResourceT IO) r
-> Stream (Of Block) (ResourceT IO) r
recons Stream (Of Block) (ResourceT IO) ()
audio)
    where
    -- TODO I convert Audio.Constant to vectors.  I could possibly resample
    -- Constant efficiently by just changing the length, but the resampler has
    -- lots of state inside so it would only work if preceding audio was all
    -- 0, and in that case I probably will be prepend the silence before
    -- resampling.
    next :: Stream (Of Block) m a
-> t m (Maybe (Vector Sample), Stream (Of Block) m a)
next Stream (Of Block) m a
audio =
        forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const (forall a. Maybe a
Nothing, Stream (Of Block) m a
audio)) (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Vector Sample
Audio.blockVector)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> m (Either r (a, Stream (Of a) m r))
S.next Stream (Of Block) m a
audio)
    toFrames :: X -> Frames
toFrames = Int -> Y -> Frames
Audio.secondsToFrames Int
rate forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> Y
RealTime.to_seconds
    toSeconds :: Frames -> X
toSeconds = Y -> X
RealTime.seconds forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Frames -> Y
Audio.framesToSeconds Int
rate

    -- showSeg (Segment.Segment x1 y1 x2 y2) =
    --     pretty (toFrames x1, y1) <> "--" <> pretty (toFrames x2, y2)
    -- oneChan :: V.Vector Audio.Sample -> V.Vector Audio.Sample
    -- oneChan = head . Audio.deinterleaveV 2

-- | True if this stream is empty.  It also returns the stream since it has to
-- peek an element to check, and if it's not empty, it conses the element back
-- on to avoid repeating the effect.
checkEnd :: Monad m => S.Stream (S.Of a) m r -> m (Bool, S.Stream (S.Of a) m r)
checkEnd :: forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> m (Bool, Stream (Of a) m r)
checkEnd Stream (Of a) m r
stream = (forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> m (Either r (a, Stream (Of a) m r))
S.next Stream (Of a) m r
stream) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left r
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
True, forall (f :: * -> *) a. Applicative f => a -> f a
pure r
a)
    Right (a
x, Stream (Of a) m r
xs) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
False, forall (m :: * -> *) a r.
Monad m =>
a -> Stream (Of a) m r -> Stream (Of a) m r
S.cons a
x Stream (Of a) m r
xs)

resampleRate :: forall rateIn rateOut chan.
    (KnownNat rateIn, KnownNat rateOut, KnownNat chan)
    => Quality
    -> Audio.AudioIO rateIn chan -> Audio.AudioIO rateOut chan
resampleRate :: forall (rateIn :: Nat) (rateOut :: Nat) (chan :: Nat).
(KnownNat rateIn, KnownNat rateOut, KnownNat chan) =>
Quality -> AudioIO rateIn chan -> AudioIO rateOut chan
resampleRate Quality
ctype =
    forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
Stream (Of Block) m () -> Audio m rate chan
Audio.Audio forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
Audio m rate chan -> Stream (Of Block) m ()
Audio._stream forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rate :: Nat) (chan :: Nat).
(KnownNat chan, KnownNat rate) =>
Quality -> Y -> AudioIO rate chan -> AudioIO rate chan
resample Quality
ctype (Y
rateOut forall a. Fractional a => a -> a -> a
/ Y
rateIn)
    where
    rateIn :: Y
rateIn = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
TypeLits.natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy rateIn)
    rateOut :: Y
rateOut = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
TypeLits.natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy rateOut)

instance Serialize.Serialize SavedState where
    put :: Putter SavedState
put (SavedState ByteString
a ByteString
b) = forall a. Serialize a => Putter a
Serialize.put ByteString
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
Serialize.put ByteString
b
    get :: Get SavedState
get = ByteString -> ByteString -> SavedState
SavedState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
Serialize.get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
Serialize.get