diff --git a/src/Codec/Audio/Opus/Decoder.hs b/src/Codec/Audio/Opus/Decoder.hs index 78e893d..dc7427e 100644 --- a/src/Codec/Audio/Opus/Decoder.hs +++ b/src/Codec/Audio/Opus/Decoder.hs @@ -1,5 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} - +-- | This module contains the high-level API for decoding Opus audio. module Codec.Audio.Opus.Decoder ( -- * Decoder Decoder, OpusException(..) @@ -22,11 +22,12 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL import Foreign --- | Decoder State +-- | Decoder. Internally, it holds a pointer to the libopus decoder state and +-- a pointer to the (potential) last Opus error code. newtype Decoder = Decoder (ForeignPtr DecoderT, ForeignPtr ErrorCode) deriving (Eq, Ord, Show) --- | allocates and initializes a decoder state. +-- | Allocates and initializes a decoder. opusDecoderCreate :: (HasDecoderConfig cfg, MonadIO m) => cfg -> m Decoder opusDecoderCreate cfg = liftIO $ do let cs = if isStereo then 2 else 1 @@ -38,14 +39,16 @@ opusDecoderCreate cfg = liftIO $ do let enc = Decoder (d', err) opusLastError enc >>= maybe (pure enc) throwM - - -- | Decode an Opus frame. opusDecode :: (HasDecoderStreamConfig cfg, MonadIO m) - => Decoder -- ^ 'Decoder' state - -> cfg -- ^ max data bytes - -> ByteString -- ^ input signal (interleaved if 2 channels) + => Decoder + -- ^ 'Decoder' state + -> cfg + -- ^ The stream configuration that specifies the frame size, whether FEC is + -- enabled, and the decoder configuration (sampling rate, channels). + -> ByteString + -- ^ Input signal (interleaved if 2 channels) -> m ByteString opusDecode d cfg i = let fs = cfg ^. deStreamFrameSize @@ -70,13 +73,21 @@ opusDecode d cfg i = -- but CStringLen expects a CChar which is Int8 BS.packCStringLen $ (castPtr os, (fromIntegral l) * 2 * chans) +-- | Decode an Opus frame, returning a lazy 'BL.ByteString'. opusDecodeLazy :: (HasDecoderStreamConfig cfg, MonadIO m) - => Decoder -- ^ 'Decoder' state + => Decoder + -- ^ 'Decoder' state -> cfg - -> ByteString -- ^ input signal (interleaved if 2 channels) + -- ^ The stream configuration that specifies the frame size, whether FEC is + -- enabled, and the decoder configuration (sampling rate, channels). + -> ByteString + -- ^ Input signal (interleaved if 2 channels) -> m BL.ByteString opusDecodeLazy d cfg = fmap BL.fromStrict . opusDecode d cfg +-- | For use with 'ResourceT' or any other monad that implements 'MonadResource'. +-- Safely allocate a 'Decoder' that will be freed upon exiting the monad, an +-- exception, or an explicit call to 'Control.Monad.Trans.Resource.release'. withOpusDecoder :: (HasDecoderConfig cfg) => MonadResource m => cfg -> (Decoder -> IO ()) @@ -84,22 +95,21 @@ withOpusDecoder :: (HasDecoderConfig cfg) => MonadResource m withOpusDecoder cfg a = snd <$> allocate (opusDecoderCreate cfg) a - --- | Frees an 'Decoder'. Is normaly called automaticly --- when 'Decoder' gets out of scope +-- | Frees an 'Decoder'. opusDecoderDestroy :: MonadIO m => Decoder -> m () opusDecoderDestroy (Decoder (d, err)) = liftIO $ finalizeForeignPtr d >> finalizeForeignPtr err - --- | get last error from decoder +-- | Get the last error from decoder. opusLastError :: MonadIO m => Decoder -> m (Maybe OpusException) opusLastError (Decoder (_, fp)) = liftIO $ (^? _ErrorCodeException) <$> withForeignPtr fp peek +-- | An 'DecoderAction' is an IO action that uses a 'DecoderT' for its operation. type DecoderAction a = Ptr DecoderT -> IO a --- | Run an 'DecoderAction'. +-- | Run a 'DecoderAction' using a 'Decoder', returning either 'OpusException' +-- for errors or the result of the action. withDecoder' :: MonadIO m => Decoder -> DecoderAction a -> m (Either OpusException a) withDecoder' e@(Decoder (fp_a, _)) m = liftIO $ @@ -108,7 +118,7 @@ withDecoder' e@(Decoder (fp_a, _)) m = liftIO $ le <- opusLastError e pure $ maybe (Right r) Left le --- | Run an 'DecoderAction'. Might throw an 'OpusException' +-- | Run a 'DecoderAction'. Might throw an 'OpusException' if the action fails. runDecoderAction :: (MonadIO m, MonadThrow m) => Decoder -> DecoderAction a -> m a runDecoderAction d m = withDecoder' d m >>= either throwM pure diff --git a/src/Codec/Audio/Opus/Decoder/Conduit.hs b/src/Codec/Audio/Opus/Decoder/Conduit.hs index 4d780cc..f8a74d6 100644 --- a/src/Codec/Audio/Opus/Decoder/Conduit.hs +++ b/src/Codec/Audio/Opus/Decoder/Conduit.hs @@ -1,3 +1,4 @@ +-- | Conduit interface for decoding audio data with Opus. module Codec.Audio.Opus.Decoder.Conduit ( decoderC, decoderLazyC , decoderSink @@ -11,21 +12,26 @@ import qualified Data.ByteString.Lazy as BL import Data.Conduit.Combinators import Prelude (($)) +-- | Decode audio data with Opus. decoderC :: (HasDecoderStreamConfig cfg, MonadResource m) => cfg -> ConduitT ByteString ByteString m () decoderC cfg = withDecoder (cfg ^. deStreamDecoderConfig) $ \d -> mapM (opusDecode d cfg) +-- | Decode lazy bytestring audio data with Opus. decoderLazyC :: (HasDecoderStreamConfig cfg, MonadResource m) => cfg -> ConduitT ByteString BL.ByteString m () decoderLazyC cfg = withDecoder (cfg ^. deStreamDecoderConfig) $ \d -> mapM (opusDecodeLazy d cfg) +-- | A sink to decode audio data with Opus and return a lazy bytestring of the +-- whole stream. decoderSink :: (HasDecoderStreamConfig cfg, MonadResource m) => cfg -> ConduitT ByteString o m BL.ByteString decoderSink cfg = withDecoder (cfg ^. deStreamDecoderConfig) $ \d -> foldMapM (opusDecodeLazy d cfg) +-- | Run a conduit that uses a decoder with the given configuration. withDecoder :: (HasDecoderConfig cfg, MonadResource m) => cfg -> (Decoder -> ConduitT i o m r) -> ConduitT i o m r withDecoder cfg = bracketP (opusDecoderCreate cfg) opusDecoderDestroy diff --git a/src/Codec/Audio/Opus/Encoder.hs b/src/Codec/Audio/Opus/Encoder.hs index 24f3027..b0dfb63 100644 --- a/src/Codec/Audio/Opus/Encoder.hs +++ b/src/Codec/Audio/Opus/Encoder.hs @@ -1,5 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} - +-- | This module contains the high-level API for encoding Opus audio. module Codec.Audio.Opus.Encoder ( -- * Encoder Encoder, OpusException(..) @@ -22,11 +22,12 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL import Foreign --- | Encoder State +-- | Encoder. Internally, it holds a pointer to the libopus encoder state and +-- a pointer to the (potential) last Opus error code. newtype Encoder = Encoder (ForeignPtr EncoderT, ForeignPtr ErrorCode) deriving (Eq, Ord, Show) --- | allocates and initializes an encoder state. +-- | Allocates and initializes an encoder. opusEncoderCreate :: (HasEncoderConfig cfg, MonadIO m) => cfg -> m Encoder opusEncoderCreate cfg = liftIO $ do let cs = if isStereo then 2 else 1 @@ -39,14 +40,16 @@ opusEncoderCreate cfg = liftIO $ do let enc = Encoder (e', err) opusLastError enc >>= maybe (pure enc) throwM - - -- | Encode an Opus frame. opusEncode :: (HasStreamConfig cfg, MonadIO m) - => Encoder -- ^ 'Encoder' state - -> cfg -- ^ max data bytes - -> ByteString -- ^ input signal (interleaved if 2 channels) + => Encoder + -- ^ 'Encoder' state + -> cfg + -- ^ The stream configuration that specifies the frame size, the output size, + -- and the encoder configuration (sampling rate, channels, coding mode). + -> ByteString + -- ^ Input signal (interleaved if 2 channels) -> m ByteString opusEncode e cfg i = let fs = cfg ^. streamFrameSize @@ -62,13 +65,22 @@ opusEncode e cfg i = if l < 0 then throwM OpusInvalidPacket else BS.packCStringLen ol +-- | Encode an Opus frame. Returns a lazy 'BL.ByteString'. opusEncodeLazy :: (HasStreamConfig cfg, MonadIO m) - => Encoder -- ^ 'Encoder' state + => Encoder + -- ^ 'Encoder' state -> cfg - -> ByteString -- ^ input signal (interleaved if 2 channels) + -- ^ The stream configuration that specifies the frame size, the output size, + -- and the encoder configuration (sampling rate, channels, coding mode). + -> ByteString + -- ^ Input signal (interleaved if 2 channels) -> m BL.ByteString opusEncodeLazy e cfg = fmap BL.fromStrict . opusEncode e cfg + +-- | For use with 'ResourceT' or any other monad that implements 'MonadResource'. +-- Safely allocate an 'Encoder' that will be freed upon exiting the monad, an +-- exception, or an explicit call to 'Control.Monad.Trans.Resource.release'. withOpusEncoder :: (HasEncoderConfig cfg) => MonadResource m => cfg -> (Encoder -> IO ()) @@ -77,21 +89,22 @@ withOpusEncoder cfg a = snd <$> allocate (opusEncoderCreate cfg) a --- | Frees an 'Encoder'. Is normaly called automaticly --- when 'Encoder' gets out of scope +-- | Frees an 'Encoder'. opusEncoderDestroy :: MonadIO m => Encoder -> m () opusEncoderDestroy (Encoder (e, err)) = liftIO $ finalizeForeignPtr e >> finalizeForeignPtr err --- | get last error from encoder +-- | Get the last error from the encoder. opusLastError :: MonadIO m => Encoder -> m (Maybe OpusException) opusLastError (Encoder (_, fp)) = liftIO $ (^? _ErrorCodeException) <$> withForeignPtr fp peek +-- | An 'EncoderAction' is an IO action that uses a 'EncoderT' for its operation. type EncoderAction a = Ptr EncoderT -> IO a --- | Run an 'EncoderAction'. +-- | Run an 'EncoderAction' using an 'Encoder', returning either 'OpusException' +-- for errors or the result of the action. withEncoder' :: MonadIO m => Encoder -> EncoderAction a -> m (Either OpusException a) withEncoder' e@(Encoder (fp_a, _)) m = liftIO $ @@ -100,7 +113,7 @@ withEncoder' e@(Encoder (fp_a, _)) m = liftIO $ le <- opusLastError e pure $ maybe (Right r) Left le --- | Run an 'EncoderAction'. Might throw an 'OpusException' +-- | Run an 'EncoderAction'. Might throw an 'OpusException' if the action fails. runEncoderAction :: (MonadIO m, MonadThrow m) => Encoder -> EncoderAction a -> m a runEncoderAction e m = withEncoder' e m >>= either throwM pure diff --git a/src/Codec/Audio/Opus/Encoder/Conduit.hs b/src/Codec/Audio/Opus/Encoder/Conduit.hs index 5199317..2ce757f 100644 --- a/src/Codec/Audio/Opus/Encoder/Conduit.hs +++ b/src/Codec/Audio/Opus/Encoder/Conduit.hs @@ -1,3 +1,4 @@ +-- | Conduit interface for encoding audio data with Opus. module Codec.Audio.Opus.Encoder.Conduit ( encoderC, encoderLazyC , encoderSink @@ -11,21 +12,26 @@ import qualified Data.ByteString.Lazy as BL import Data.Conduit.Combinators import Prelude (($)) +-- | Encode audio data with Opus. encoderC :: (HasStreamConfig cfg, MonadResource m) => cfg -> ConduitT ByteString ByteString m () encoderC cfg = withEncoder (cfg ^. streamConfig) $ \e -> mapM (opusEncode e cfg) +-- | Encode lazy bytestring audio data with Opus. encoderLazyC :: (HasStreamConfig cfg, MonadResource m) => cfg -> ConduitT ByteString BL.ByteString m () encoderLazyC cfg = withEncoder (cfg ^. streamConfig) $ \e -> mapM (opusEncodeLazy e cfg) +-- | A sink to encode audio data with Opus and return a lazy bytestring of the +-- whole stream. encoderSink :: (HasStreamConfig cfg, MonadResource m) => cfg -> ConduitT ByteString o m BL.ByteString encoderSink cfg = withEncoder (cfg ^. streamConfig) $ \e -> foldMapM (opusEncodeLazy e cfg) +-- | Run a conduit that uses an encoder with the given configuration. withEncoder :: (HasEncoderConfig cfg, MonadResource m) => cfg -> (Encoder -> ConduitT i o m r) -> ConduitT i o m r withEncoder cfg = bracketP (opusEncoderCreate cfg) opusEncoderDestroy diff --git a/src/Codec/Audio/Opus/Internal/Opus.hsc b/src/Codec/Audio/Opus/Internal/Opus.hsc index 29722ea..311951c 100644 --- a/src/Codec/Audio/Opus/Internal/Opus.hsc +++ b/src/Codec/Audio/Opus/Internal/Opus.hsc @@ -1,6 +1,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} - +-- | This module contains the raw FFI bindings to the Opus library. It is not +-- meant to be consumed directly by users of this library, but rather to be +-- used by the higher-level API in "Codec.Audio.Opus". module Codec.Audio.Opus.Internal.Opus where import Foreign @@ -9,37 +11,55 @@ import Foreign.C.String #include +-- | Raw error codes returned by the Opus library, represented as an int. newtype ErrorCode = ErrorCode { unErrorCode :: CInt } - deriving (Eq,Show) + deriving (Eq, Show) +-- | Storable instance for 'ErrorCode' which is necessary for using it an +-- argument in FFI calls. instance Storable ErrorCode where sizeOf (ErrorCode e) = sizeOf e alignment (ErrorCode e) = alignment e peek p = ErrorCode <$> peek (castPtr p) poke p = poke (castPtr p) . unErrorCode -#{enum ErrorCode, ErrorCode - , opus_ok = OPUS_OK - , opus_bad_arg = OPUS_BAD_ARG - , opus_buffer_too_small = OPUS_BUFFER_TOO_SMALL - , opus_internal_error = OPUS_INTERNAL_ERROR - , opus_invalid_packet = OPUS_INVALID_PACKET - , opus_unimplemented = OPUS_UNIMPLEMENTED - , opus_invalid_state = OPUS_INVALID_STATE - , opus_alloc_fail = OPUS_ALLOC_FAIL - } +-- | libopus error: No error. +opus_ok :: ErrorCode +opus_ok = ErrorCode (#const OPUS_OK) +-- | libopus error: One or more invalid/out of range arguments. +opus_bad_arg :: ErrorCode +opus_bad_arg = ErrorCode (#const OPUS_BAD_ARG) -newtype CodingMode = CodingMode { unCodingMode :: CInt } - deriving (Eq) +-- | libopus error: Not enough bytes allocated in the buffer. +opus_buffer_too_small :: ErrorCode +opus_buffer_too_small = ErrorCode (#const OPUS_BUFFER_TOO_SMALL) + +-- | libopus error: An internal error was detected. +opus_internal_error :: ErrorCode +opus_internal_error = ErrorCode (#const OPUS_INTERNAL_ERROR) + +-- | libopus error: The compressed data passed is corrupted. +opus_invalid_packet :: ErrorCode +opus_invalid_packet = ErrorCode (#const OPUS_INVALID_PACKET) +-- | libopus error: Invalid/unsupported request number. +opus_unimplemented :: ErrorCode +opus_unimplemented = ErrorCode (#const OPUS_UNIMPLEMENTED) -#{enum CodingMode, CodingMode - , app_voip = OPUS_APPLICATION_VOIP - , app_audio = OPUS_APPLICATION_AUDIO - , app_lowdelay = OPUS_APPLICATION_RESTRICTED_LOWDELAY - } +-- | libopus error: An encoder or decoder structure is invalid or already freed. +opus_invalid_state :: ErrorCode +opus_invalid_state = ErrorCode (#const OPUS_INVALID_STATE) +-- | libopus error: Memory allocation has failed. +opus_alloc_fail :: ErrorCode +opus_alloc_fail = ErrorCode (#const OPUS_ALLOC_FAIL) + +-- | Coding mode for the Opus encoder, represented as an int. +newtype CodingMode = CodingMode { unCodingMode :: CInt } + deriving (Eq) + +-- | Show instance for 'CodingMode'. instance Show CodingMode where show a | app_voip == a = "voip coding" @@ -47,83 +67,132 @@ instance Show CodingMode where | app_lowdelay == a = "lowdelay coding" | otherwise = "unknown coding" -type OpusInt = Int32 +-- | Best for most VoIP/videoconference applications where listening quality and +-- intelligibility matter most. +app_voip :: CodingMode +app_voip = CodingMode (#const OPUS_APPLICATION_VOIP) + +-- | Best for broadcast/high-fidelity application where the decoded audio should +-- be as close as possible to the input. +app_audio :: CodingMode +app_audio = CodingMode (#const OPUS_APPLICATION_AUDIO) +-- | Only use when lowest-achievable latency is what matters most. +app_lowdelay :: CodingMode +app_lowdelay = CodingMode (#const OPUS_APPLICATION_RESTRICTED_LOWDELAY) + +-- | Sampling rate for the Opus encoder, represented as an int. newtype SamplingRate = SamplingRate { unSamplingRate :: Int } deriving (Eq) --- | sampling rate 8kHz +-- | Show instance for 'SamplingRate' makes it human-readable. +instance Show SamplingRate where + show (SamplingRate r) = mconcat [show $ r `div` 1000, "kHz"] + +-- | Sampling rate 8kHz opusSR8k :: SamplingRate opusSR8k = SamplingRate 8000 --- | sampling rate 12kHz +-- | Sampling rate 12kHz opusSR12k :: SamplingRate opusSR12k = SamplingRate 12000 --- | sampling rate 16kHz +-- | Sampling rate 16kHz opusSR16k :: SamplingRate opusSR16k = SamplingRate 16000 --- | sampling rate 24kHz +-- | Sampling rate 24kHz opusSR24k :: SamplingRate opusSR24k = SamplingRate 24000 --- | sampling rate 48kHz +-- | Sampling rate 48kHz opusSR48k :: SamplingRate opusSR48k = SamplingRate 48000 +-- Declare empty (i.e. opaque) data types for the encoder and decoder states. +-- This is not meant to be consumed by Haskell code, but is rather meant to +-- encapsulate the C types that FFI calls return and expect to be passed +-- modified in a subsequent FFI call. +-- +-- For example, the encoder state can be created only by 'c_opus_encoder_create', +-- and destroyed by 'cp_opus_encoder_destroy'. -instance Show SamplingRate where - show (SamplingRate r) = mconcat [show $ r `div` 1000, "kHz"] - +-- | Encoder state. Can be created only by 'c_opus_encoder_create', +-- and destroyed by 'cp_opus_encoder_destroy'. data EncoderT + +-- | Decoder state. Can be created only by 'c_opus_decoder_create', +-- and destroyed by 'cp_opus_decoder_destroy'. data DecoderT --- | allocates and initializes an encoder state. +-- | Allocates and initializes an encoder state. foreign import ccall unsafe "opus.h opus_encoder_create" c_opus_encoder_create - :: SamplingRate -- ^ sampling rate of input signal (Hz) This must be one of 8000, 12000, 16000, 24000, or 48000. - -> Int32 -- ^ Number of channels (1 or 2) in input signal - -> CodingMode -- ^ Coding mode. (See 'app_voip', 'app_audio', 'app_lowdelay') - -> Ptr ErrorCode -- ^ 'ErrorCode' pointer + :: SamplingRate + -- ^ Sampling rate of input signal (Hz). + -> Int32 + -- ^ Number of channels (1 or 2) in input signal + -> CodingMode + -- ^ Coding mode. (See 'app_voip', 'app_audio', 'app_lowdelay') + -> Ptr ErrorCode + -- ^ 'ErrorCode' pointer -> IO (Ptr EncoderT) --- | Frees an 'EncoderT' +-- | Frees an 'EncoderT' that has been created using 'c_opus_encoder_create'. foreign import ccall unsafe "opus.h &opus_encoder_destroy" cp_opus_encoder_destroy :: FunPtr (Ptr EncoderT -> IO ()) - +-- | Encode an Opus frame. foreign import ccall unsafe "opus.h opus_encode" c_opus_encode - :: Ptr EncoderT -- ^ encoder state - -> Ptr CShort -- ^ input signal - -> Int32 -- ^ frame size - -> CString -- ^ output payload - -> Int32 -- ^ max data bytes - -> IO Int32 -- ^ number of bytes written or negative in case of error - --- | allocates and initializes a decoder state. + :: Ptr EncoderT + -- ^ Encoder state + -> Ptr CShort + -- ^ Input signal + -> Int32 + -- ^ Frame size + -> CString + -- ^ Output payload + -> Int32 + -- ^ Max data bytes + -> IO Int32 + -- ^ Number of bytes written or negative in case of error + +-- | Allocates and initializes a decoder state. foreign import ccall unsafe "opus.h opus_decoder_create" c_opus_decoder_create - :: SamplingRate -- ^ sampling rate, same as encoder_create - -> Int32 -- ^ Number of channels in input signal - -> Ptr ErrorCode -- ^ 'ErrorCode' pointer + :: SamplingRate + -- ^ Sampling rate, same as encoder_create + -> Int32 + -- ^ Number of channels in input signal + -> Ptr ErrorCode + -- ^ 'ErrorCode' pointer -> IO (Ptr DecoderT) --- | Frees a 'DecoderT' +-- | Frees a 'DecoderT' that has been created using 'c_opus_decoder_create'. foreign import ccall unsafe "opus.h &opus_decoder_destroy" cp_opus_decoder_destroy :: FunPtr (Ptr DecoderT -> IO ()) +-- | Decodes an Opus frame. foreign import ccall unsafe "opus.h opus_decode" c_opus_decode - :: Ptr DecoderT -- ^ Decoder state - -> Ptr CChar -- ^ Byte array of compressed data - -> Int32 -- ^ Exact number of bytes in the payload - -> Ptr CShort -- ^ decoded audio data - -> Int32 -- ^ max duration of the frame in samples that can fit - -> CInt -- ^ flag to request that any in-band forward error correction data be decoded. If no such data is available, the frame is decoded as if it were lost. - -> IO Int32 -- ^ Number of decoded samples, or negative in case of error + :: Ptr DecoderT + -- ^ Decoder state + -> Ptr CChar + -- ^ Byte array of compressed data + -> Int32 + -- ^ Exact number of bytes in the payload + -> Ptr CShort + -- ^ Decoded audio data + -> Int32 + -- ^ Max duration of the frame in samples that can fit + -> CInt + -- ^ Flag to request that any in-band forward error correction data be + -- decoded. If no such data is available, the frame is decoded as if it + -- were lost. + -> IO Int32 + -- ^ Number of decoded samples, or negative in case of error diff --git a/src/Codec/Audio/Opus/Types.hs b/src/Codec/Audio/Opus/Types.hs index 561b8f3..54cc55c 100644 --- a/src/Codec/Audio/Opus/Types.hs +++ b/src/Codec/Audio/Opus/Types.hs @@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} - +-- | This module contains the types used in the higher-level API of this library. module Codec.Audio.Opus.Types ( -- * Sampling Rate SamplingRate, HasSamplingRate(..) @@ -27,23 +27,36 @@ import Control.Monad.Catch import Data.Typeable (Typeable) +-- | A potential error that can happen during encoding or decoding, as reported +-- by the Opus library. The descriptions of each error have been taken from the +-- [Opus documentation](https://opus-codec.org/docs/opus_api-1.5/group__opus__errorcodes.html). data OpusException = OpusBadArg + -- ^ One or more invalid/out of range arguments. | OpusBufferToSmall + -- ^ Not enough bytes allocated in the buffer. | OpusInternalError + -- ^ An internal error was detected. | OpusInvalidPacket + -- ^ The compressed data passed is corrupted. | OpusUnimplemented + -- ^ Invalid/unsupported request number. | OpusInvalidState + -- ^ An encoder or decoder structure is invalid or already freed. | OpusAllocFail + -- ^ Memory allocation has failed. deriving (Eq, Show, Typeable) instance Exception OpusException +-- | A 'Traversal' that maps a function @f@ onto the contained 'OpusException' +-- if the input 'ErrorCode' can be converted into it. _ErrorCodeException :: Traversal' ErrorCode OpusException _ErrorCodeException f e | Just exc <- errorCodeException e = errorCodeException' <$> f exc | otherwise = pure e +-- | Convert an 'OpusException' into an 'ErrorCode'. errorCodeException' :: OpusException -> ErrorCode errorCodeException' OpusBadArg = opus_bad_arg errorCodeException' OpusBufferToSmall = opus_buffer_too_small @@ -53,7 +66,8 @@ errorCodeException' OpusUnimplemented = opus_unimplemented errorCodeException' OpusInvalidState = opus_invalid_state errorCodeException' OpusAllocFail = opus_alloc_fail - +-- | Convert an 'ErrorCode' into an 'OpusException'. Returns Nothing if it is +-- not a known error code. errorCodeException :: ErrorCode -> Maybe OpusException errorCodeException a | a == opus_bad_arg = Just OpusBadArg @@ -66,76 +80,129 @@ errorCodeException a | otherwise = Nothing +-- | A 'HasSamplingRate' typeclass, generated from the definition of +-- 'SamplingRate' using Template Haskell. This allows us to use 'samplingRate' +-- to access the 'SamplingRate' field of a data type such as 'EncoderConfig'. makeClassy ''SamplingRate + +-- | A 'HasCodingMode' typeclass, generated from the definition of 'CodingMode' +-- using Template Haskell. This allows us to use 'codingMode' to access the +-- 'CodingMode' field of a data type such as 'EncoderConfig'. makeClassy ''CodingMode +-- | The configuration of an Opus encoder. Use 'mkEncoderConfig' to create a new +-- 'EncoderConfig'. data EncoderConfig = EncoderConfig - { _encoderSamplingRate :: SamplingRate -- ^ sampling rate of input signal - , _encoderIsStereo :: Bool -- ^ stereo mode? ('True' => 2 channels, 'False' => 1 channel) - , _encoderCodingMode :: CodingMode -- ^ Coding mode. (See 'app_voip', 'app_audio', 'app_lowdelay') + { _encoderSamplingRate :: SamplingRate + -- ^ sampling rate of input signal + , _encoderIsStereo :: Bool + -- ^ stereo mode? ('True' => 2 channels, 'False' => 1 channel) + , _encoderCodingMode :: CodingMode + -- ^ Coding mode. (See 'app_voip', 'app_audio', 'app_lowdelay') } deriving (Eq, Show) +-- | A 'HasEncoderConfig' typeclass, generated from the definition of +-- 'EncoderConfig' using Template Haskell. This allows us to use 'encoderConfig' +-- to access the 'EncoderConfig' field of e.g. 'StreamConfig'. makeClassy 'EncoderConfig +-- | Create a new 'EncoderConfig' with the given sampling rate, stereo mode, and +-- coding mode. Set the second argument to True for stereo mode, and False for +-- mono mode. mkEncoderConfig :: SamplingRate -> Bool -> CodingMode -> EncoderConfig mkEncoderConfig = EncoderConfig +-- | An 'EncoderConfig' has a reference to the 'SamplingRate' it is meant to be +-- used with. instance HasSamplingRate EncoderConfig where samplingRate = encoderSamplingRate +-- | An 'EncoderConfig' has a reference to the 'CodingMode' it is meant to be +-- used with. instance HasCodingMode EncoderConfig where codingMode = encoderCodingMode +-- | The configuration of an Opus decoder. Use 'mkDecoderConfig' to create a new +-- 'DecoderConfig'. data DecoderConfig = DecoderConfig { _decoderSamplingRate :: SamplingRate , _decoderIsStereo :: Bool } deriving (Eq, Show) +-- | A 'HasDecoderConfig' typeclass, generated from the definition of +-- 'DecoderConfig' using Template Haskell. This allows us to use 'decoderConfig' +-- to access the 'DecoderConfig' field of e.g. 'DecoderStreamConfig'. makeClassy 'DecoderConfig +-- | Create a new 'DecoderConfig' with the given sampling rate and stereo mode. +-- Set the second argument to True for stereo mode, and False for mono mode. mkDecoderConfig :: SamplingRate -> Bool -> DecoderConfig mkDecoderConfig = DecoderConfig +-- | A 'DecoderConfig' has a reference to the 'SamplingRate' it is meant to be +-- used with. instance HasSamplingRate DecoderConfig where samplingRate = decoderSamplingRate +-- | A type alias for the size of an Opus frame in integers. type FrameSize = Int - +-- | The configuration of an Opus encoder stream. Use 'mkStreamConfig' to +-- create a new 'StreamConfig'. data StreamConfig = StreamConfig { _streamEncoderConfig :: EncoderConfig , _streamFrameSize :: FrameSize , _streamOutSize :: Int } deriving (Eq, Show) +-- | A 'HasStreamConfig' typeclass, generated from the definition of +-- 'StreamConfig' using Template Haskell. makeClassy ''StreamConfig +-- | Create a new 'StreamConfig' with the given 'EncoderConfig', frame size, and +-- output size. mkStreamConfig :: EncoderConfig -> FrameSize -> Int -> StreamConfig mkStreamConfig = StreamConfig +-- | An 'StreamConfig' has a reference to the 'EncoderConfig' it was created +-- with. instance HasEncoderConfig StreamConfig where encoderConfig = streamEncoderConfig +-- | An 'StreamConfig' has a reference to the 'SamplingRate' it is meant to be +-- used with. instance HasSamplingRate StreamConfig where samplingRate = encoderConfig . samplingRate +-- | An 'StreamConfig' has a reference to the 'CodingMode' it is meant to be +-- used with. instance HasCodingMode StreamConfig where codingMode = encoderConfig . codingMode +-- | The configuration of an Opus decoder stream. Use 'mkDecoderStreamConfig' to +-- create a new 'DecoderStreamConfig'. data DecoderStreamConfig = DecoderStreamConfig { _deStreamDecoderConfig :: DecoderConfig , _deStreamFrameSize :: FrameSize , _deStreamDecodeFec :: Int } deriving (Eq, Show) +-- | A 'HasDecoderStreamConfig' typeclass, generated from the definition of +-- 'DecoderStreamConfig' using Template Haskell. makeClassy ''DecoderStreamConfig +-- | Create a new 'DecoderStreamConfig' with the given 'DecoderConfig', frame +-- size, and FEC decode flag. mkDecoderStreamConfig :: DecoderConfig -> FrameSize -> Int -> DecoderStreamConfig mkDecoderStreamConfig = DecoderStreamConfig +-- | A 'DecoderStreamConfig' has a reference to the 'DecoderConfig' it was +-- created with. instance HasDecoderConfig DecoderStreamConfig where decoderConfig = deStreamDecoderConfig +-- | A 'DecoderStreamConfig' has a reference to the 'SamplingRate' it is meant +-- to be used with. instance HasSamplingRate DecoderStreamConfig where samplingRate = decoderConfig . samplingRate