{-# LANGUAGE RecordWildCards #-}

-- |
-- Module      :  Codec.Audio.FLAC.StreamEncoder
-- Copyright   :  © 2016–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- The module contains a Haskell interface to FLAC stream encoder.
--
-- === How to use this module
--
-- Just call the 'encodeFlac' function with 'EncoderSettings', input and
-- output file names. The 'encodeFlac' function only encodes vanilla WAVE
-- and RF64.
--
-- === Low-level details
--
-- The implementation uses the reference implementation of FLAC—libFLAC (C
-- library) under the hood. This means you'll need at least version 1.3.0 of
-- libFLAC (released 26 May 2013) installed for the binding to work.
--
-- The binding works with minimal overhead compared to the C implementation.
-- Encoding speed is equal to that of @flac@ command line tool. Memory
-- consumption is minimal and remains constant regardless of size of file to
-- decode.
module Codec.Audio.FLAC.StreamEncoder
  ( EncoderSettings (..),
    defaultEncoderSettings,
    EncoderException (..),
    EncoderInitStatus (..),
    EncoderState (..),
    encodeFlac,
  )
where

import Codec.Audio.FLAC.StreamEncoder.Internal
import Codec.Audio.FLAC.StreamEncoder.Internal.Helpers
import Codec.Audio.FLAC.StreamEncoder.Internal.Types
import Codec.Audio.FLAC.Util
import Codec.Audio.Wave
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class (MonadIO (..))
import Data.Bool (bool)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Word
import System.Directory

-- | Parameters of the stream encoder. Note that the 'encoderCompression'
-- parameter influences a number of other parameters on its own as specified
-- here
-- <https://xiph.org/flac/api/group__flac__stream__encoder.html#gae49cf32f5256cb47eecd33779493ac85>.
-- The parameters that it sets automatically are wrapped in 'Maybe's, so you
-- can choose whether to use the value that is set by 'encoderCompression'
-- specifying 'Nothing' (default), or use something specific by passing a
-- value inside 'Just'. Thorough understanding of the FLAC format is
-- necessary to achieve good results, though.
data EncoderSettings = EncoderSettings
  { -- | Compression level [0..8], default is 5.
    EncoderSettings -> Word32
encoderCompression :: !Word32,
    -- | Block size, default is 0.
    EncoderSettings -> Word32
encoderBlockSize :: !Word32,
    -- | Verify result (slower), default is 'False'.
    EncoderSettings -> Bool
encoderVerify :: !Bool,
    -- | Enable mid-side encoding on stereo input. The number of channels
    -- must be 2 for this to have any effect. Default value: 'Nothing'.
    EncoderSettings -> Maybe Bool
encoderDoMidSideStereo :: !(Maybe 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. Setting this to 'True' requires 'encoderDoMidSideStereo'
    -- to also be set to 'True' in order to have any effect. Default value:
    -- 'Nothing'.
    EncoderSettings -> Maybe Bool
encoderLooseMidSideStereo :: !(Maybe Bool),
    -- | Sets the apodization function(s) the encoder will use when
    -- windowing audio data for LPC analysis. Up to 32 functions are kept,
    -- the rest are dropped. Import
    -- "Codec.Audio.FLAC.StreamEncoder.Apodization" to bring apodization
    -- functions in scope. Default value: 'Nothing'.
    EncoderSettings -> Maybe (NonEmpty ApodizationFunction)
encoderApodization :: !(Maybe (NonEmpty ApodizationFunction)),
    -- | Set maximum LPC order, or 0 to use the fixed predictors. Default
    -- value: 'Nothing'.
    EncoderSettings -> Maybe Word32
encoderMaxLpcOrder :: !(Maybe Word32),
    -- | Set the precision in bits of the quantized linear predictor
    -- coefficients, or 0 to let the encoder select it based on the
    -- blocksize. Default value: 'Nothing'.
    EncoderSettings -> Maybe Word32
encoderQlpCoeffPrecision :: !(Maybe Word32),
    -- | 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. Default value: 'Nothing'.
    EncoderSettings -> Maybe Bool
encoderDoQlpCoeffPrecisionSearch :: !(Maybe 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. Default value:
    -- 'Nothing'.
    EncoderSettings -> Maybe Bool
encoderDoExhaustiveModelSearch :: !(Maybe Bool),
    -- | Set the minimum and maximum partition order to search when coding
    -- the residual. The partition order determines the context size in the
    -- residual. The context size will be approximately @blocksize / (2 ^
    -- order)@. Set both min and max values to 0 to force a single context,
    -- whose Rice parameter is based on the residual signal variance.
    -- Otherwise, set a min and max order, and the encoder will search all
    -- orders, using the mean of each context for its Rice parameter, and
    -- use the best. Default: 'Nothing'.
    EncoderSettings -> Maybe (Word32, Word32)
encoderResidualPartitionOrders :: !(Maybe (Word32, Word32))
  }
  deriving (Int -> EncoderSettings -> ShowS
[EncoderSettings] -> ShowS
EncoderSettings -> String
(Int -> EncoderSettings -> ShowS)
-> (EncoderSettings -> String)
-> ([EncoderSettings] -> ShowS)
-> Show EncoderSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncoderSettings] -> ShowS
$cshowList :: [EncoderSettings] -> ShowS
show :: EncoderSettings -> String
$cshow :: EncoderSettings -> String
showsPrec :: Int -> EncoderSettings -> ShowS
$cshowsPrec :: Int -> EncoderSettings -> ShowS
Show, ReadPrec [EncoderSettings]
ReadPrec EncoderSettings
Int -> ReadS EncoderSettings
ReadS [EncoderSettings]
(Int -> ReadS EncoderSettings)
-> ReadS [EncoderSettings]
-> ReadPrec EncoderSettings
-> ReadPrec [EncoderSettings]
-> Read EncoderSettings
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EncoderSettings]
$creadListPrec :: ReadPrec [EncoderSettings]
readPrec :: ReadPrec EncoderSettings
$creadPrec :: ReadPrec EncoderSettings
readList :: ReadS [EncoderSettings]
$creadList :: ReadS [EncoderSettings]
readsPrec :: Int -> ReadS EncoderSettings
$creadsPrec :: Int -> ReadS EncoderSettings
Read, EncoderSettings -> EncoderSettings -> Bool
(EncoderSettings -> EncoderSettings -> Bool)
-> (EncoderSettings -> EncoderSettings -> Bool)
-> Eq EncoderSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EncoderSettings -> EncoderSettings -> Bool
$c/= :: EncoderSettings -> EncoderSettings -> Bool
== :: EncoderSettings -> EncoderSettings -> Bool
$c== :: EncoderSettings -> EncoderSettings -> Bool
Eq, Eq EncoderSettings
Eq EncoderSettings =>
(EncoderSettings -> EncoderSettings -> Ordering)
-> (EncoderSettings -> EncoderSettings -> Bool)
-> (EncoderSettings -> EncoderSettings -> Bool)
-> (EncoderSettings -> EncoderSettings -> Bool)
-> (EncoderSettings -> EncoderSettings -> Bool)
-> (EncoderSettings -> EncoderSettings -> EncoderSettings)
-> (EncoderSettings -> EncoderSettings -> EncoderSettings)
-> Ord EncoderSettings
EncoderSettings -> EncoderSettings -> Bool
EncoderSettings -> EncoderSettings -> Ordering
EncoderSettings -> EncoderSettings -> EncoderSettings
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EncoderSettings -> EncoderSettings -> EncoderSettings
$cmin :: EncoderSettings -> EncoderSettings -> EncoderSettings
max :: EncoderSettings -> EncoderSettings -> EncoderSettings
$cmax :: EncoderSettings -> EncoderSettings -> EncoderSettings
>= :: EncoderSettings -> EncoderSettings -> Bool
$c>= :: EncoderSettings -> EncoderSettings -> Bool
> :: EncoderSettings -> EncoderSettings -> Bool
$c> :: EncoderSettings -> EncoderSettings -> Bool
<= :: EncoderSettings -> EncoderSettings -> Bool
$c<= :: EncoderSettings -> EncoderSettings -> Bool
< :: EncoderSettings -> EncoderSettings -> Bool
$c< :: EncoderSettings -> EncoderSettings -> Bool
compare :: EncoderSettings -> EncoderSettings -> Ordering
$ccompare :: EncoderSettings -> EncoderSettings -> Ordering
$cp1Ord :: Eq EncoderSettings
Ord)

-- | Default 'EncoderSettings'.
--
-- @since 0.2.0
defaultEncoderSettings :: EncoderSettings
defaultEncoderSettings :: EncoderSettings
defaultEncoderSettings =
  $WEncoderSettings :: Word32
-> Word32
-> Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe (NonEmpty ApodizationFunction)
-> Maybe Word32
-> Maybe Word32
-> Maybe Bool
-> Maybe Bool
-> Maybe (Word32, Word32)
-> EncoderSettings
EncoderSettings
    { encoderCompression :: Word32
encoderCompression = 5,
      encoderBlockSize :: Word32
encoderBlockSize = 0,
      encoderVerify :: Bool
encoderVerify = Bool
False,
      encoderDoMidSideStereo :: Maybe Bool
encoderDoMidSideStereo = Maybe Bool
forall a. Maybe a
Nothing,
      encoderLooseMidSideStereo :: Maybe Bool
encoderLooseMidSideStereo = Maybe Bool
forall a. Maybe a
Nothing,
      encoderApodization :: Maybe (NonEmpty ApodizationFunction)
encoderApodization = Maybe (NonEmpty ApodizationFunction)
forall a. Maybe a
Nothing,
      encoderMaxLpcOrder :: Maybe Word32
encoderMaxLpcOrder = Maybe Word32
forall a. Maybe a
Nothing,
      encoderQlpCoeffPrecision :: Maybe Word32
encoderQlpCoeffPrecision = Maybe Word32
forall a. Maybe a
Nothing,
      encoderDoQlpCoeffPrecisionSearch :: Maybe Bool
encoderDoQlpCoeffPrecisionSearch = Maybe Bool
forall a. Maybe a
Nothing,
      encoderDoExhaustiveModelSearch :: Maybe Bool
encoderDoExhaustiveModelSearch = Maybe Bool
forall a. Maybe a
Nothing,
      encoderResidualPartitionOrders :: Maybe (Word32, Word32)
encoderResidualPartitionOrders = Maybe (Word32, Word32)
forall a. Maybe a
Nothing
    }

-- | Encode a WAVE file or RF64 file to native FLAC.
--
-- If the input file is not a valid WAVE file, 'WaveException' will be
-- thrown. 'EncoderException' is thrown when underlying FLAC encoder reports
-- a problem.
--
-- Please note that there are a number of limitations on parameters of input
-- audio stream (imposed by current reference FLAC implementation):
--
--     * Number of channels may be only 1–8 inclusive.
--     * Supported values for bits per sample are 4–24 inclusive.
--     * Acceptable sample rate lies in the range 1–655350 inclusive.
encodeFlac ::
  MonadIO m =>
  -- | Encoder settings
  EncoderSettings ->
  -- | File to encode
  FilePath ->
  -- | Where to save the resulting FLAC file
  FilePath ->
  m ()
encodeFlac :: EncoderSettings -> String -> String -> m ()
encodeFlac EncoderSettings {..} ipath' :: String
ipath' opath' :: String
opath' = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((Encoder -> IO ()) -> IO ()) -> (Encoder -> IO ()) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Encoder -> IO ()) -> IO ()
forall a. (Encoder -> IO a) -> IO a
withEncoder ((Encoder -> IO ()) -> m ()) -> (Encoder -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \e :: Encoder
e -> do
  String
ipath <- String -> IO String
makeAbsolute String
ipath'
  String
opath <- String -> IO String
makeAbsolute String
opath'
  Wave
wave <- String -> IO Wave
forall (m :: * -> *). MonadIO m => String -> m Wave
readWaveFile String
ipath
  case Wave -> SampleFormat
waveSampleFormat Wave
wave of
    SampleFormatPcmInt _ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    fmt :: SampleFormat
fmt -> EncoderException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (SampleFormat -> EncoderException
EncoderInvalidSampleFormat SampleFormat
fmt)
  let channels :: Word32
channels = Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Wave -> Word16
waveChannels Wave
wave)
      bitsPerSample :: Word32
bitsPerSample = Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Wave -> Word16
waveBitsPerSample Wave
wave)
      sampleRate :: Word32
sampleRate = Wave -> Word32
waveSampleRate Wave
wave
      totalSamples :: Word64
totalSamples = Wave -> Word64
waveSamplesTotal Wave
wave
  IO Bool -> IO ()
liftInit (Encoder -> Word32 -> IO Bool
encoderSetChannels Encoder
e Word32
channels)
  IO Bool -> IO ()
liftInit (Encoder -> Word32 -> IO Bool
encoderSetBitsPerSample Encoder
e Word32
bitsPerSample)
  IO Bool -> IO ()
liftInit (Encoder -> Word32 -> IO Bool
encoderSetSampleRate Encoder
e Word32
sampleRate)
  IO Bool -> IO ()
liftInit (Encoder -> Word32 -> IO Bool
encoderSetCompression Encoder
e Word32
encoderCompression)
  IO Bool -> IO ()
liftInit (Encoder -> Word32 -> IO Bool
encoderSetBlockSize Encoder
e Word32
encoderBlockSize)
  IO Bool -> IO ()
liftInit (Encoder -> Bool -> IO Bool
encoderSetVerify Encoder
e Bool
encoderVerify)
  Maybe Bool -> (Bool -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
    Maybe Bool
encoderDoMidSideStereo
    (IO Bool -> IO ()
liftInit (IO Bool -> IO ()) -> (Bool -> IO Bool) -> Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoder -> Bool -> IO Bool
encoderSetDoMidSideStereo Encoder
e)
  Maybe Bool -> (Bool -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
    Maybe Bool
encoderLooseMidSideStereo
    (IO Bool -> IO ()
liftInit (IO Bool -> IO ()) -> (Bool -> IO Bool) -> Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoder -> Bool -> IO Bool
encoderSetLooseMidSideStereo Encoder
e)
  Maybe (NonEmpty ApodizationFunction)
-> (NonEmpty ApodizationFunction -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
    Maybe (NonEmpty ApodizationFunction)
encoderApodization
    (IO Bool -> IO ()
liftInit (IO Bool -> IO ())
-> (NonEmpty ApodizationFunction -> IO Bool)
-> NonEmpty ApodizationFunction
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoder -> ByteString -> IO Bool
encoderSetApodization Encoder
e (ByteString -> IO Bool)
-> (NonEmpty ApodizationFunction -> ByteString)
-> NonEmpty ApodizationFunction
-> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty ApodizationFunction -> ByteString
renderApodizationSpec)
  Maybe Word32 -> (Word32 -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
    Maybe Word32
encoderMaxLpcOrder
    (IO Bool -> IO ()
liftInit (IO Bool -> IO ()) -> (Word32 -> IO Bool) -> Word32 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoder -> Word32 -> IO Bool
encoderSetMaxLpcOrder Encoder
e)
  Maybe Word32 -> (Word32 -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
    Maybe Word32
encoderQlpCoeffPrecision
    (IO Bool -> IO ()
liftInit (IO Bool -> IO ()) -> (Word32 -> IO Bool) -> Word32 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoder -> Word32 -> IO Bool
encoderSetQlpCoeffPrecision Encoder
e)
  Maybe Bool -> (Bool -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
    Maybe Bool
encoderDoQlpCoeffPrecisionSearch
    (IO Bool -> IO ()
liftInit (IO Bool -> IO ()) -> (Bool -> IO Bool) -> Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoder -> Bool -> IO Bool
encoderSetDoQlpCoeffPrecisionSearch Encoder
e)
  Maybe Bool -> (Bool -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
    Maybe Bool
encoderDoExhaustiveModelSearch
    (IO Bool -> IO ()
liftInit (IO Bool -> IO ()) -> (Bool -> IO Bool) -> Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoder -> Bool -> IO Bool
encoderSetDoExhaustiveModelSearch Encoder
e)
  Maybe (Word32, Word32) -> ((Word32, Word32) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
    Maybe (Word32, Word32)
encoderResidualPartitionOrders
    (IO Bool -> IO ()
liftInit (IO Bool -> IO ())
-> ((Word32, Word32) -> IO Bool) -> (Word32, Word32) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoder -> Word32 -> IO Bool
encoderSetMinResidualPartitionOrder Encoder
e (Word32 -> IO Bool)
-> ((Word32, Word32) -> Word32) -> (Word32, Word32) -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32, Word32) -> Word32
forall a b. (a, b) -> a
fst)
  Maybe (Word32, Word32) -> ((Word32, Word32) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
    Maybe (Word32, Word32)
encoderResidualPartitionOrders
    (IO Bool -> IO ()
liftInit (IO Bool -> IO ())
-> ((Word32, Word32) -> IO Bool) -> (Word32, Word32) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoder -> Word32 -> IO Bool
encoderSetMaxResidualPartitionOrder Encoder
e (Word32 -> IO Bool)
-> ((Word32, Word32) -> Word32) -> (Word32, Word32) -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32, Word32) -> Word32
forall a b. (a, b) -> b
snd)
  -- Set the estimate (which is likely correct), to avoid rewrite of
  -- STREAMINFO metadata block after encoding.
  IO Bool -> IO ()
liftInit (Encoder -> Word64 -> IO Bool
encoderSetTotalSamplesEstimate Encoder
e Word64
totalSamples)
  String -> (String -> IO ()) -> IO ()
forall a. String -> (String -> IO a) -> IO a
withTempFile' String
opath ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \otemp :: String
otemp -> do
    EncoderInitStatus
initStatus <- Encoder -> String -> IO EncoderInitStatus
encoderInitFile Encoder
e String
otemp
    case EncoderInitStatus
initStatus of
      EncoderInitStatusOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      status :: EncoderInitStatus
status -> EncoderException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (EncoderInitStatus -> EncoderException
EncoderInitFailed EncoderInitStatus
status)
    Encoder -> IO Bool -> IO ()
liftBool Encoder
e (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$
      Encoder -> Word64 -> Word64 -> String -> IO Bool
encoderProcessHelper
        Encoder
e
        (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> Word32 -> Word64
forall a b. (a -> b) -> a -> b
$ Wave -> Word32
waveDataOffset Wave
wave)
        (Wave -> Word64
waveDataSize Wave
wave)
        String
ipath
    Encoder -> IO Bool -> IO ()
liftBool Encoder
e (Encoder -> IO Bool
encoderFinish Encoder
e)
    String -> String -> IO ()
renameFile String
otemp String
opath

----------------------------------------------------------------------------
-- Helpers

-- | Execute an initializing action that returns 'False' on failure and take
-- care of error reporting. In case of trouble, @'EncoderInitFailed'
-- 'EncoderInitStatusAlreadyInitialized'@ is thrown.
liftInit :: IO Bool -> IO ()
liftInit :: IO Bool -> IO ()
liftInit m :: IO Bool
m = IO Bool -> IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
m IO Bool -> (Bool -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> IO () -> Bool -> IO ()
forall a. a -> a -> Bool -> a
bool IO ()
forall a. IO a
t (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  where
    t :: IO a
t = EncoderException -> IO a
forall e a. Exception e => e -> IO a
throwIO (EncoderInitStatus -> EncoderException
EncoderInitFailed EncoderInitStatus
EncoderInitStatusAlreadyInitialized)

-- | Execute an action that returns 'False' on failure into taking care of
-- error reporting. In case of trouble @'EncoderFailed'@ with encoder status
-- attached is thrown.
liftBool :: Encoder -> IO Bool -> IO ()
liftBool :: Encoder -> IO Bool -> IO ()
liftBool encoder :: Encoder
encoder m :: IO Bool
m = IO Bool -> IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
m IO Bool -> (Bool -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> IO () -> Bool -> IO ()
forall a. a -> a -> Bool -> a
bool (Encoder -> IO ()
forall a. Encoder -> IO a
throwState Encoder
encoder) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Get 'EncoderState' from given 'Encoder' and throw it immediately.
throwState :: Encoder -> IO a
throwState :: Encoder -> IO a
throwState = Encoder -> IO EncoderState
encoderGetState (Encoder -> IO EncoderState)
-> (EncoderState -> IO a) -> Encoder -> IO a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> EncoderException -> IO a
forall e a. Exception e => e -> IO a
throwIO (EncoderException -> IO a)
-> (EncoderState -> EncoderException) -> EncoderState -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncoderState -> EncoderException
EncoderFailed