{-# LANGUAGE RecordWildCards #-}
module Codec.Audio.FLAC.StreamDecoder
( DecoderSettings (..),
defaultDecoderSettings,
DecoderException (..),
DecoderInitStatus (..),
DecoderState (..),
decodeFlac,
)
where
import Codec.Audio.FLAC.Metadata
import Codec.Audio.FLAC.StreamDecoder.Internal
import Codec.Audio.FLAC.StreamDecoder.Internal.Helpers
import Codec.Audio.FLAC.StreamDecoder.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.Function
import Data.IORef
import Foreign
import System.Directory
import System.IO
data DecoderSettings = DecoderSettings
{
DecoderSettings -> Bool
decoderMd5Checking :: !Bool,
DecoderSettings -> WaveFormat
decoderWaveFormat :: !WaveFormat
}
deriving (Int -> DecoderSettings -> ShowS
[DecoderSettings] -> ShowS
DecoderSettings -> String
(Int -> DecoderSettings -> ShowS)
-> (DecoderSettings -> String)
-> ([DecoderSettings] -> ShowS)
-> Show DecoderSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecoderSettings] -> ShowS
$cshowList :: [DecoderSettings] -> ShowS
show :: DecoderSettings -> String
$cshow :: DecoderSettings -> String
showsPrec :: Int -> DecoderSettings -> ShowS
$cshowsPrec :: Int -> DecoderSettings -> ShowS
Show, ReadPrec [DecoderSettings]
ReadPrec DecoderSettings
Int -> ReadS DecoderSettings
ReadS [DecoderSettings]
(Int -> ReadS DecoderSettings)
-> ReadS [DecoderSettings]
-> ReadPrec DecoderSettings
-> ReadPrec [DecoderSettings]
-> Read DecoderSettings
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DecoderSettings]
$creadListPrec :: ReadPrec [DecoderSettings]
readPrec :: ReadPrec DecoderSettings
$creadPrec :: ReadPrec DecoderSettings
readList :: ReadS [DecoderSettings]
$creadList :: ReadS [DecoderSettings]
readsPrec :: Int -> ReadS DecoderSettings
$creadsPrec :: Int -> ReadS DecoderSettings
Read, DecoderSettings -> DecoderSettings -> Bool
(DecoderSettings -> DecoderSettings -> Bool)
-> (DecoderSettings -> DecoderSettings -> Bool)
-> Eq DecoderSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecoderSettings -> DecoderSettings -> Bool
$c/= :: DecoderSettings -> DecoderSettings -> Bool
== :: DecoderSettings -> DecoderSettings -> Bool
$c== :: DecoderSettings -> DecoderSettings -> Bool
Eq, Eq DecoderSettings
Eq DecoderSettings =>
(DecoderSettings -> DecoderSettings -> Ordering)
-> (DecoderSettings -> DecoderSettings -> Bool)
-> (DecoderSettings -> DecoderSettings -> Bool)
-> (DecoderSettings -> DecoderSettings -> Bool)
-> (DecoderSettings -> DecoderSettings -> Bool)
-> (DecoderSettings -> DecoderSettings -> DecoderSettings)
-> (DecoderSettings -> DecoderSettings -> DecoderSettings)
-> Ord DecoderSettings
DecoderSettings -> DecoderSettings -> Bool
DecoderSettings -> DecoderSettings -> Ordering
DecoderSettings -> DecoderSettings -> DecoderSettings
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 :: DecoderSettings -> DecoderSettings -> DecoderSettings
$cmin :: DecoderSettings -> DecoderSettings -> DecoderSettings
max :: DecoderSettings -> DecoderSettings -> DecoderSettings
$cmax :: DecoderSettings -> DecoderSettings -> DecoderSettings
>= :: DecoderSettings -> DecoderSettings -> Bool
$c>= :: DecoderSettings -> DecoderSettings -> Bool
> :: DecoderSettings -> DecoderSettings -> Bool
$c> :: DecoderSettings -> DecoderSettings -> Bool
<= :: DecoderSettings -> DecoderSettings -> Bool
$c<= :: DecoderSettings -> DecoderSettings -> Bool
< :: DecoderSettings -> DecoderSettings -> Bool
$c< :: DecoderSettings -> DecoderSettings -> Bool
compare :: DecoderSettings -> DecoderSettings -> Ordering
$ccompare :: DecoderSettings -> DecoderSettings -> Ordering
$cp1Ord :: Eq DecoderSettings
Ord)
defaultDecoderSettings :: DecoderSettings
defaultDecoderSettings :: DecoderSettings
defaultDecoderSettings =
$WDecoderSettings :: Bool -> WaveFormat -> DecoderSettings
DecoderSettings
{ decoderMd5Checking :: Bool
decoderMd5Checking = Bool
False,
decoderWaveFormat :: WaveFormat
decoderWaveFormat = WaveFormat
WaveVanilla
}
decodeFlac ::
MonadIO m =>
DecoderSettings ->
FilePath ->
FilePath ->
m ()
decodeFlac :: DecoderSettings -> String -> String -> m ()
decodeFlac DecoderSettings {..} ipath' :: String
ipath' opath' :: String
opath' = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((Decoder -> IO ()) -> IO ()) -> (Decoder -> IO ()) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Decoder -> IO ()) -> IO ()
forall a. (Decoder -> IO a) -> IO a
withDecoder ((Decoder -> IO ()) -> m ()) -> (Decoder -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \d :: Decoder
d -> do
String
ipath <- String -> IO String
makeAbsolute String
ipath'
String
opath <- String -> IO String
makeAbsolute String
opath'
IO Bool -> IO ()
liftInit (Decoder -> Bool -> IO Bool
decoderSetMd5Checking Decoder
d Bool
decoderMd5Checking)
(maxBlockSize :: Int
maxBlockSize, wave :: Wave
wave) <- MetaSettings -> String -> FlacMeta (Int, Wave) -> IO (Int, Wave)
forall (m :: * -> *) a.
MonadIO m =>
MetaSettings -> String -> FlacMeta a -> m a
runFlacMeta MetaSettings
defaultMetaSettings String
ipath (FlacMeta (Int, Wave) -> IO (Int, Wave))
-> FlacMeta (Int, Wave) -> IO (Int, Wave)
forall a b. (a -> b) -> a -> b
$ do
let waveFileFormat :: WaveFormat
waveFileFormat = WaveFormat
decoderWaveFormat
waveDataOffset :: Word32
waveDataOffset = 0
waveDataSize :: Word64
waveDataSize = 0
waveOtherChunks :: [a]
waveOtherChunks = []
Word32
waveSampleRate <- SampleRate -> FlacMeta (MetaType SampleRate)
forall a. MetaValue a => a -> FlacMeta (MetaType a)
retrieve SampleRate
SampleRate
SampleFormat
waveSampleFormat <-
Word16 -> SampleFormat
SampleFormatPcmInt (Word16 -> SampleFormat)
-> (Word32 -> Word16) -> Word32 -> SampleFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
(Word32 -> SampleFormat)
-> FlacMeta Word32 -> FlacMeta SampleFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitsPerSample -> FlacMeta (MetaType BitsPerSample)
forall a. MetaValue a => a -> FlacMeta (MetaType a)
retrieve BitsPerSample
BitsPerSample
Set SpeakerPosition
waveChannelMask <- ChannelMask -> FlacMeta (MetaType ChannelMask)
forall a. MetaValue a => a -> FlacMeta (MetaType a)
retrieve ChannelMask
ChannelMask
Word64
waveSamplesTotal <- TotalSamples -> FlacMeta (MetaType TotalSamples)
forall a. MetaValue a => a -> FlacMeta (MetaType a)
retrieve TotalSamples
TotalSamples
Int
maxBlockSize <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> FlacMeta Word32 -> FlacMeta Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaxBlockSize -> FlacMeta (MetaType MaxBlockSize)
forall a. MetaValue a => a -> FlacMeta (MetaType a)
retrieve MaxBlockSize
MaxBlockSize
(Int, Wave) -> FlacMeta (Int, Wave)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
maxBlockSize, $WWave :: WaveFormat
-> Word32
-> SampleFormat
-> Set SpeakerPosition
-> Word32
-> Word64
-> Word64
-> [(ByteString, ByteString)]
-> Wave
Wave {..})
let bufferSize :: Int
bufferSize = Int
maxBlockSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Wave -> Word16
waveBlockAlign Wave
wave) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
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 ->
IO (Ptr Void)
-> (Ptr Void -> IO ()) -> (Ptr Void -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr Void)
forall a. Int -> IO (Ptr a)
mallocBytes Int
bufferSize) Ptr Void -> IO ()
forall a. Ptr a -> IO ()
free ((Ptr Void -> IO ()) -> IO ()) -> (Ptr Void -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \buffer :: Ptr Void
buffer -> do
DecoderInitStatus
initStatus <- Decoder -> String -> Ptr Void -> IO DecoderInitStatus
decoderInitHelper Decoder
d String
ipath Ptr Void
buffer
case DecoderInitStatus
initStatus of
DecoderInitStatusOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
status :: DecoderInitStatus
status -> DecoderException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (DecoderInitStatus -> DecoderException
DecoderInitFailed DecoderInitStatus
status)
Decoder -> IO Bool -> IO ()
liftBool Decoder
d (Decoder -> IO Bool
decoderProcessUntilEndOfMetadata Decoder
d)
IORef Word64
processedRef <- Word64 -> IO (IORef Word64)
forall a. a -> IO (IORef a)
newIORef (0 :: Word64)
String -> Wave -> (Handle -> IO ()) -> IO ()
forall (m :: * -> *).
MonadIO m =>
String -> Wave -> (Handle -> IO ()) -> m ()
writeWaveFile String
otemp Wave
wave ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \h :: Handle
h -> (IO () -> IO ()) -> IO ()
forall a. (a -> a) -> a
fix ((IO () -> IO ()) -> IO ()) -> (IO () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \nextOne :: IO ()
nextOne -> do
Word64
processed <- IORef Word64 -> IO Word64
forall a. IORef a -> IO a
readIORef IORef Word64
processedRef
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word64
processed Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Wave -> Word64
waveSamplesTotal Wave
wave) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Decoder -> IO Bool -> IO ()
liftBool Decoder
d (Decoder -> IO Bool
decoderProcessSingle Decoder
d)
Int
frameSize <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> IO Word32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder -> IO Word32
decoderGetBlockSize Decoder
d
let toGrab :: Int
toGrab = Int
frameSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Wave -> Word16
waveBlockAlign Wave
wave)
Handle -> Ptr Void -> Int -> IO ()
forall a. Handle -> Ptr a -> Int -> IO ()
hPutBuf Handle
h Ptr Void
buffer Int
toGrab
IORef Word64 -> (Word64 -> Word64) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Word64
processedRef (Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
frameSize)
IO ()
nextOne
Decoder -> IO Bool -> IO ()
liftBool Decoder
d (Decoder -> IO Bool
decoderFinish Decoder
d)
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 = DecoderException -> IO a
forall e a. Exception e => e -> IO a
throwIO (DecoderInitStatus -> DecoderException
DecoderInitFailed DecoderInitStatus
DecoderInitStatusAlreadyInitialized)
liftBool :: Decoder -> IO Bool -> IO ()
liftBool :: Decoder -> IO Bool -> IO ()
liftBool encoder :: Decoder
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 (Decoder -> IO ()
forall a. Decoder -> IO a
throwState Decoder
encoder) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
throwState :: Decoder -> IO a
throwState :: Decoder -> IO a
throwState = Decoder -> IO DecoderState
decoderGetState (Decoder -> IO DecoderState)
-> (DecoderState -> IO a) -> Decoder -> IO a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> DecoderException -> IO a
forall e a. Exception e => e -> IO a
throwIO (DecoderException -> IO a)
-> (DecoderState -> DecoderException) -> DecoderState -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecoderState -> DecoderException
DecoderFailed