{-# LANGUAGE RecordWildCards #-}
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
data EncoderSettings = EncoderSettings
{
EncoderSettings -> Word32
encoderCompression :: !Word32,
EncoderSettings -> Word32
encoderBlockSize :: !Word32,
EncoderSettings -> Bool
encoderVerify :: !Bool,
EncoderSettings -> Maybe Bool
encoderDoMidSideStereo :: !(Maybe Bool),
EncoderSettings -> Maybe Bool
encoderLooseMidSideStereo :: !(Maybe Bool),
EncoderSettings -> Maybe (NonEmpty ApodizationFunction)
encoderApodization :: !(Maybe (NonEmpty ApodizationFunction)),
EncoderSettings -> Maybe Word32
encoderMaxLpcOrder :: !(Maybe Word32),
EncoderSettings -> Maybe Word32
encoderQlpCoeffPrecision :: !(Maybe Word32),
EncoderSettings -> Maybe Bool
encoderDoQlpCoeffPrecisionSearch :: !(Maybe Bool),
EncoderSettings -> Maybe Bool
encoderDoExhaustiveModelSearch :: !(Maybe Bool),
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)
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
}
encodeFlac ::
MonadIO m =>
EncoderSettings ->
FilePath ->
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)
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
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)
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 ())
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