{-# LANGUAGE ForeignFunctionInterface #-}

-- |
-- Module      :  Codec.Audio.FLAC.StreamDecoder.Internal.Helpers
-- Copyright   :  © 2016–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Wrappers around helpers written to help work with the stream decoder.
module Codec.Audio.FLAC.StreamDecoder.Internal.Helpers
  ( decoderInitHelper,
  )
where

import Codec.Audio.FLAC.StreamDecoder.Internal.Types
import Codec.Audio.FLAC.Util
import Data.Void
import Foreign
import Foreign.C.String
import Foreign.C.Types

-- | Initialize decoder to decode FLAC file and register buffer where
-- decoded audio data will go (which must be big enough). Return
-- 'DecoderInitStatus'.
decoderInitHelper ::
  -- | 'Decoder' to use
  Decoder ->
  -- | FLAC file to decode
  FilePath ->
  -- | Buffer where to write decoded audio data
  Ptr Void ->
  -- | Sample rate, bits per sample, channels
  IO DecoderInitStatus
decoderInitHelper :: Decoder -> FilePath -> Ptr Void -> IO DecoderInitStatus
decoderInitHelper decoder :: Decoder
decoder ipath :: FilePath
ipath buffer :: Ptr Void
buffer =
  FilePath
-> (CString -> IO DecoderInitStatus) -> IO DecoderInitStatus
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
ipath ((CString -> IO DecoderInitStatus) -> IO DecoderInitStatus)
-> (CString -> IO DecoderInitStatus) -> IO DecoderInitStatus
forall a b. (a -> b) -> a -> b
$ \ipathPtr :: CString
ipathPtr ->
    CUInt -> DecoderInitStatus
forall a b. (Integral a, Enum b) => a -> b
toEnum'
      (CUInt -> DecoderInitStatus) -> IO CUInt -> IO DecoderInitStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder -> CString -> Ptr Void -> IO CUInt
c_decoder_init_helper
        Decoder
decoder -- stream decoder
        CString
ipathPtr -- name of FLAC file to decode
        Ptr Void
buffer -- output buffer

foreign import ccall unsafe "FLAC__stream_decoder_init_helper"
  c_decoder_init_helper ::
    Decoder ->
    CString ->
    Ptr Void ->
    IO CUInt