module Codec.Audio.FLAC.StreamDecoder
( DecoderSettings (..)
, 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.Default.Class
import Data.Function
import Data.IORef
import Foreign
import System.Directory
import System.IO
data DecoderSettings = DecoderSettings
{ decoderMd5Checking :: !Bool
, decoderWaveFormat :: !WaveFormat
} deriving (Show, Read, Eq, Ord)
instance Default DecoderSettings where
def = DecoderSettings
{ decoderMd5Checking = False
, decoderWaveFormat = WaveVanilla }
decodeFlac :: MonadIO m
=> DecoderSettings
-> FilePath
-> FilePath
-> m ()
decodeFlac DecoderSettings {..} ipath' opath' = liftIO . withDecoder $ \d -> do
ipath <- makeAbsolute ipath'
opath <- makeAbsolute opath'
liftInit (decoderSetMd5Checking d decoderMd5Checking)
(maxBlockSize, wave) <- runFlacMeta def ipath $ do
let waveFileFormat = decoderWaveFormat
waveDataOffset = 0
waveDataSize = 0
waveOtherChunks = []
waveSampleRate <- retrieve SampleRate
waveSampleFormat <- SampleFormatPcmInt . fromIntegral
<$> retrieve BitsPerSample
waveChannelMask <- retrieve ChannelMask
waveSamplesTotal <- retrieve TotalSamples
maxBlockSize <- fromIntegral <$> retrieve MaxBlockSize
return (maxBlockSize, Wave {..})
let bufferSize = maxBlockSize * fromIntegral (waveBlockAlign wave) + 1
withTempFile' opath $ \otemp ->
bracket (mallocBytes bufferSize) free $ \buffer -> do
initStatus <- decoderInitHelper d ipath buffer
case initStatus of
DecoderInitStatusOK -> return ()
status -> throwIO (DecoderInitFailed status)
liftBool d (decoderProcessUntilEndOfMetadata d)
processedRef <- newIORef (0 :: Word64)
writeWaveFile otemp wave $ \h -> fix $ \nextOne -> do
processed <- readIORef processedRef
unless (processed == waveSamplesTotal wave) $ do
liftBool d (decoderProcessSingle d)
frameSize <- fromIntegral <$> decoderGetBlockSize d
let toGrab = frameSize * fromIntegral (waveBlockAlign wave)
hPutBuf h buffer toGrab
modifyIORef' processedRef (+ fromIntegral frameSize)
nextOne
liftBool d (decoderFinish d)
renameFile otemp opath
liftInit :: IO Bool -> IO ()
liftInit m = liftIO m >>= bool t (return ())
where
t = throwIO (DecoderInitFailed DecoderInitStatusAlreadyInitialized)
liftBool :: Decoder -> IO Bool -> IO ()
liftBool encoder m = liftIO m >>= bool (throwState encoder) (return ())
throwState :: Decoder -> IO a
throwState = decoderGetState >=> throwIO . DecoderFailed