{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE LambdaCase #-}

-- |
-- Module      :  Codec.Audio.FLAC.StreamEncoder.Internal
-- Copyright   :  © 2016–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Low-level Haskell wrapper around FLAC stream encoder API, see:
--
-- <https://xiph.org/flac/api/group__flac__stream__encoder.html>
module Codec.Audio.FLAC.StreamEncoder.Internal
  ( withEncoder,
    encoderSetChannels,
    encoderSetBitsPerSample,
    encoderSetSampleRate,
    encoderSetCompression,
    encoderSetBlockSize,
    encoderSetDoMidSideStereo,
    encoderSetLooseMidSideStereo,
    encoderSetApodization,
    encoderSetMaxLpcOrder,
    encoderSetQlpCoeffPrecision,
    encoderSetDoQlpCoeffPrecisionSearch,
    encoderSetDoExhaustiveModelSearch,
    encoderSetMinResidualPartitionOrder,
    encoderSetMaxResidualPartitionOrder,
    encoderSetTotalSamplesEstimate,
    encoderSetVerify,
    encoderGetState,
    encoderInitFile,
    encoderFinish,
  )
where

import Codec.Audio.FLAC.StreamEncoder.Internal.Types
import Codec.Audio.FLAC.Util
import Control.Monad.Catch
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Void
import Foreign
import Foreign.C.String
import Foreign.C.Types

-- | Create and use an 'Encoder'. The encoder is guaranteed to be freed even
-- in the case of exception.
--
-- If memory for the encoder cannot be allocated, corresponding
-- 'EncoderException' is raised.
withEncoder :: (Encoder -> IO a) -> IO a
withEncoder :: (Encoder -> IO a) -> IO a
withEncoder f :: Encoder -> IO a
f = IO (Maybe Encoder)
-> (Maybe Encoder -> IO ()) -> (Maybe Encoder -> IO a) -> IO a
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket IO (Maybe Encoder)
encoderNew ((Encoder -> IO ()) -> Maybe Encoder -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Encoder -> IO ()
encoderDelete) ((Maybe Encoder -> IO a) -> IO a)
-> (Maybe Encoder -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \case
  Nothing ->
    EncoderException -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
      (EncoderState -> EncoderException
EncoderFailed EncoderState
EncoderStateMemoryAllocationError)
  Just x :: Encoder
x -> Encoder -> IO a
f Encoder
x

-- | Create a new stream encoder instance with the default settings. In the
-- case of memory allocation problem 'Nothing' is returned.
encoderNew :: IO (Maybe Encoder)
encoderNew :: IO (Maybe Encoder)
encoderNew = Encoder -> Maybe Encoder
forall a p. Coercible a (Ptr p) => a -> Maybe a
maybePtr (Encoder -> Maybe Encoder) -> IO Encoder -> IO (Maybe Encoder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Encoder
c_encoder_new

foreign import ccall unsafe "FLAC__stream_encoder_new"
  c_encoder_new :: IO Encoder

-- | Free an encoder instance.
encoderDelete :: Encoder -> IO ()
encoderDelete :: Encoder -> IO ()
encoderDelete = Encoder -> IO ()
c_encoder_delete

foreign import ccall unsafe "FLAC__stream_encoder_delete"
  c_encoder_delete :: Encoder -> IO ()

-- | Set the number of channels to be encoded. Return 'False' if encoder is
-- already initialized.
encoderSetChannels :: Encoder -> Word32 -> IO Bool
encoderSetChannels :: Encoder -> Word32 -> IO Bool
encoderSetChannels encoder :: Encoder
encoder channels :: Word32
channels =
  Encoder -> CUInt -> IO Bool
c_encoder_set_channels Encoder
encoder (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
channels)

foreign import ccall unsafe "FLAC__stream_encoder_set_channels"
  c_encoder_set_channels :: Encoder -> CUInt -> IO Bool

-- | Set the sample resolution of the input to be encoded. Return 'False' if
-- encoder is already initialized.
encoderSetBitsPerSample :: Encoder -> Word32 -> IO Bool
encoderSetBitsPerSample :: Encoder -> Word32 -> IO Bool
encoderSetBitsPerSample encoder :: Encoder
encoder bps :: Word32
bps =
  Encoder -> CUInt -> IO Bool
c_encoder_set_bits_per_sample Encoder
encoder (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
bps)

foreign import ccall unsafe "FLAC__stream_encoder_set_bits_per_sample"
  c_encoder_set_bits_per_sample :: Encoder -> CUInt -> IO Bool

-- | Set the sample rate in Hz of the input to be encoded. Return 'False' if
-- encoder is already initialized.
encoderSetSampleRate :: Encoder -> Word32 -> IO Bool
encoderSetSampleRate :: Encoder -> Word32 -> IO Bool
encoderSetSampleRate encoder :: Encoder
encoder sampleRate :: Word32
sampleRate =
  Encoder -> CUInt -> IO Bool
c_encoder_set_sample_rate Encoder
encoder (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
sampleRate)

foreign import ccall unsafe "FLAC__stream_encoder_set_sample_rate"
  c_encoder_set_sample_rate :: Encoder -> CUInt -> IO Bool

-- | Set the compression level. The argument can range from 0 (fastest,
-- least compression) to 8 (slowest, most compression). A value higher than
-- 8 will be treated as 8. Return 'False' if encoder is already initialized.
encoderSetCompression :: Encoder -> Word32 -> IO Bool
encoderSetCompression :: Encoder -> Word32 -> IO Bool
encoderSetCompression encoder :: Encoder
encoder level :: Word32
level =
  Encoder -> CUInt -> IO Bool
c_encoder_set_compression_level Encoder
encoder (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
level)

foreign import ccall unsafe "FLAC__stream_encoder_set_compression_level"
  c_encoder_set_compression_level :: Encoder -> CUInt -> IO Bool

-- | Set the blocksize to use while encoding.
encoderSetBlockSize :: Encoder -> Word32 -> IO Bool
encoderSetBlockSize :: Encoder -> Word32 -> IO Bool
encoderSetBlockSize encoder :: Encoder
encoder blockSize :: Word32
blockSize =
  Encoder -> CUInt -> IO Bool
c_encoder_set_blocksize Encoder
encoder (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
blockSize)

foreign import ccall unsafe "FLAC__stream_encoder_set_blocksize"
  c_encoder_set_blocksize :: Encoder -> CUInt -> IO Bool

-- | Set to 'True' to enable mid-side encoding on stereo input.
encoderSetDoMidSideStereo :: Encoder -> Bool -> IO Bool
encoderSetDoMidSideStereo :: Encoder -> Bool -> IO Bool
encoderSetDoMidSideStereo = Encoder -> Bool -> IO Bool
c_encoder_set_do_mid_side_stereo

foreign import ccall unsafe "FLAC__stream_encoder_set_do_mid_side_stereo"
  c_encoder_set_do_mid_side_stereo :: Encoder -> Bool -> IO Bool

-- | Set to 'True' to enable adaptive switching between mid-side and
-- left-right encoding on stereo input. Set to 'False' to use exhaustive
-- searching.
encoderSetLooseMidSideStereo :: Encoder -> Bool -> IO Bool
encoderSetLooseMidSideStereo :: Encoder -> Bool -> IO Bool
encoderSetLooseMidSideStereo = Encoder -> Bool -> IO Bool
c_encoder_set_loose_mid_side_stereo

foreign import ccall unsafe "FLAC__stream_encoder_set_loose_mid_side_stereo"
  c_encoder_set_loose_mid_side_stereo :: Encoder -> Bool -> IO Bool

-- | Set the apodization function(s) the encoder will use when windowing
-- audio data for LPC analysis.
encoderSetApodization :: Encoder -> ByteString -> IO Bool
encoderSetApodization :: Encoder -> ByteString -> IO Bool
encoderSetApodization encoder :: Encoder
encoder specification :: ByteString
specification =
  ByteString -> (CString -> IO Bool) -> IO Bool
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
specification (Encoder -> CString -> IO Bool
c_encoder_set_apodization Encoder
encoder)

foreign import ccall unsafe "FLAC__stream_encoder_set_apodization"
  c_encoder_set_apodization :: Encoder -> CString -> IO Bool

-- | Set the maximum LPC order, or 0 to use only the fixed predictors.
encoderSetMaxLpcOrder :: Encoder -> Word32 -> IO Bool
encoderSetMaxLpcOrder :: Encoder -> Word32 -> IO Bool
encoderSetMaxLpcOrder encoder :: Encoder
encoder value :: Word32
value =
  Encoder -> CUInt -> IO Bool
c_encoder_set_max_lpc_order Encoder
encoder (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
value)

foreign import ccall unsafe "FLAC__stream_encoder_set_max_lpc_order"
  c_encoder_set_max_lpc_order :: Encoder -> CUInt -> IO Bool

-- | Set the precision in bits, of the quantized linear predictor
-- coefficients, or 0 to let the encoder select it based on the blocksize.
encoderSetQlpCoeffPrecision :: Encoder -> Word32 -> IO Bool
encoderSetQlpCoeffPrecision :: Encoder -> Word32 -> IO Bool
encoderSetQlpCoeffPrecision encoder :: Encoder
encoder value :: Word32
value =
  Encoder -> CUInt -> IO Bool
c_encoder_set_qlp_coeff_precision Encoder
encoder (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
value)

foreign import ccall unsafe "FLAC__stream_encoder_set_qlp_coeff_precision"
  c_encoder_set_qlp_coeff_precision :: Encoder -> CUInt -> IO Bool

-- | Set to 'False' to use only the specified quantized linear predictor
-- coefficient precision, or 'True' to search neighboring precision values
-- and use the best one.
encoderSetDoQlpCoeffPrecisionSearch :: Encoder -> Bool -> IO Bool
encoderSetDoQlpCoeffPrecisionSearch :: Encoder -> Bool -> IO Bool
encoderSetDoQlpCoeffPrecisionSearch = Encoder -> Bool -> IO Bool
c_encoder_set_qlp_coeff_prec_search

foreign import ccall unsafe "FLAC__stream_encoder_set_do_qlp_coeff_prec_search"
  c_encoder_set_qlp_coeff_prec_search :: Encoder -> Bool -> IO Bool

-- | Set to 'False' to let the encoder estimate the best model order based
-- on the residual signal energy, or 'True' to force the encoder to evaluate
-- all order models and select the best.
encoderSetDoExhaustiveModelSearch :: Encoder -> Bool -> IO Bool
encoderSetDoExhaustiveModelSearch :: Encoder -> Bool -> IO Bool
encoderSetDoExhaustiveModelSearch = Encoder -> Bool -> IO Bool
c_encoder_set_do_exhaustive_model_search

foreign import ccall unsafe "FLAC__stream_encoder_set_do_exhaustive_model_search"
  c_encoder_set_do_exhaustive_model_search :: Encoder -> Bool -> IO Bool

-- | Set the minimum partition order to search when coding the residual.
encoderSetMinResidualPartitionOrder :: Encoder -> Word32 -> IO Bool
encoderSetMinResidualPartitionOrder :: Encoder -> Word32 -> IO Bool
encoderSetMinResidualPartitionOrder encoder :: Encoder
encoder value :: Word32
value =
  Encoder -> CUInt -> IO Bool
c_encoder_set_min_residual_partition_order Encoder
encoder (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
value)

foreign import ccall unsafe "FLAC__stream_encoder_set_min_residual_partition_order"
  c_encoder_set_min_residual_partition_order :: Encoder -> CUInt -> IO Bool

-- | Set the maximum partition order to search when coding the residual.
encoderSetMaxResidualPartitionOrder :: Encoder -> Word32 -> IO Bool
encoderSetMaxResidualPartitionOrder :: Encoder -> Word32 -> IO Bool
encoderSetMaxResidualPartitionOrder encoder :: Encoder
encoder value :: Word32
value =
  Encoder -> CUInt -> IO Bool
c_encoder_set_max_residual_partition_order Encoder
encoder (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
value)

foreign import ccall unsafe "FLAC__stream_encoder_set_max_residual_partition_order"
  c_encoder_set_max_residual_partition_order :: Encoder -> CUInt -> IO Bool

-- | Set an estimate of the total samples that will be encoded. This is
-- merely an estimate and may be set to 0 if unknown. This value will be
-- written to the STREAMINFO block before encoding, and can remove the need
-- for the caller to rewrite the value later if the value is known before
-- encoding.
encoderSetTotalSamplesEstimate :: Encoder -> Word64 -> IO Bool
encoderSetTotalSamplesEstimate :: Encoder -> Word64 -> IO Bool
encoderSetTotalSamplesEstimate = Encoder -> Word64 -> IO Bool
c_encoder_set_total_samples_estimate

foreign import ccall unsafe "FLAC__stream_encoder_set_total_samples_estimate"
  c_encoder_set_total_samples_estimate :: Encoder -> Word64 -> IO Bool

-- | Set the “verify” flag. If 'True', the encoder will verify it's own
-- encoded output by feeding it through an internal decoder and comparing
-- the original signal against the decoded signal. If a mismatch occurs, the
-- process call will return false. Note that this will slow the encoding
-- process by the extra time required for decoding and comparison.
encoderSetVerify :: Encoder -> Bool -> IO Bool
encoderSetVerify :: Encoder -> Bool -> IO Bool
encoderSetVerify = Encoder -> Bool -> IO Bool
c_encoder_set_verify

foreign import ccall unsafe "FLAC__stream_encoder_set_verify"
  c_encoder_set_verify :: Encoder -> Bool -> IO Bool

-- | Get the current encoder state.
encoderGetState :: Encoder -> IO EncoderState
encoderGetState :: Encoder -> IO EncoderState
encoderGetState = (CUInt -> EncoderState) -> IO CUInt -> IO EncoderState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUInt -> EncoderState
forall a b. (Integral a, Enum b) => a -> b
toEnum' (IO CUInt -> IO EncoderState)
-> (Encoder -> IO CUInt) -> Encoder -> IO EncoderState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoder -> IO CUInt
c_encoder_get_state

foreign import ccall unsafe "FLAC__stream_encoder_get_state"
  c_encoder_get_state :: Encoder -> IO CUInt

-- | Initialize the encoder instance to encode native FLAC files.
encoderInitFile ::
  -- | Uninitialized encoder instance
  Encoder ->
  -- | Name of file to encode to
  FilePath ->
  IO EncoderInitStatus
encoderInitFile :: Encoder -> FilePath -> IO EncoderInitStatus
encoderInitFile encoder :: Encoder
encoder path :: FilePath
path =
  FilePath
-> (CString -> IO EncoderInitStatus) -> IO EncoderInitStatus
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
path ((CString -> IO EncoderInitStatus) -> IO EncoderInitStatus)
-> (CString -> IO EncoderInitStatus) -> IO EncoderInitStatus
forall a b. (a -> b) -> a -> b
$ \cstr :: CString
cstr ->
    CUInt -> EncoderInitStatus
forall a b. (Integral a, Enum b) => a -> b
toEnum' (CUInt -> EncoderInitStatus) -> IO CUInt -> IO EncoderInitStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Encoder -> CString -> Ptr Void -> Ptr Void -> IO CUInt
c_encoder_init_file Encoder
encoder CString
cstr Ptr Void
forall a. Ptr a
nullPtr Ptr Void
forall a. Ptr a
nullPtr

foreign import ccall unsafe "FLAC__stream_encoder_init_file"
  c_encoder_init_file :: Encoder -> CString -> Ptr Void -> Ptr Void -> IO CUInt

-- | Finish the encoding process and release resources (also resets encoder
-- and its settings). Return 'False' in case of trouble.
encoderFinish :: Encoder -> IO Bool
encoderFinish :: Encoder -> IO Bool
encoderFinish = Encoder -> IO Bool
c_encoder_finish

foreign import ccall unsafe "FLAC__stream_encoder_finish"
  c_encoder_finish :: Encoder -> IO Bool