{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  Codec.Audio.FLAC.StreamEncoder.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 encoder.
module Codec.Audio.FLAC.StreamEncoder.Internal.Helpers
  ( encoderProcessHelper,
    renderApodizationSpec,
  )
where

import Codec.Audio.FLAC.StreamEncoder.Internal.Types
import Data.ByteString (ByteString)
import qualified Data.ByteString.Builder as BU
import qualified Data.ByteString.Lazy as BL
import Data.List (intersperse)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Word (Word64)
import Foreign.C.String
import Numeric.Natural

#if !MIN_VERSION_base(4,13,0)
import Data.Semigroup ((<>))
#endif

-- | Encode given input file, return 'False' in case of failure.
encoderProcessHelper ::
  -- | 'Encoder' to use
  Encoder ->
  -- | Offset of data chunk
  Word64 ->
  -- | Size of data chunk
  Word64 ->
  -- | Location of input file (normalized)
  FilePath ->
  -- | 'False' in case of trouble
  IO Bool
encoderProcessHelper :: Encoder -> Word64 -> Word64 -> FilePath -> IO Bool
encoderProcessHelper encoder :: Encoder
encoder dataOffset :: Word64
dataOffset dataSize :: Word64
dataSize ipath :: FilePath
ipath =
  FilePath -> (CString -> IO Bool) -> IO Bool
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
ipath ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ipathPtr :: CString
ipathPtr ->
    Encoder -> Word64 -> Word64 -> CString -> IO Bool
c_encoder_process_helper
      Encoder
encoder -- stream encoder
      Word64
dataOffset -- offset of data chunk
      Word64
dataSize -- size of data chunk
      CString
ipathPtr -- path to input file

foreign import ccall unsafe "FLAC__stream_encoder_process_helper"
  c_encoder_process_helper :: Encoder -> Word64 -> Word64 -> CString -> IO Bool

-- | Render apodization functions specification as per description here:
-- <https://xiph.org/flac/api/group__flac__stream__encoder.html#ga6598f09ac782a1f2a5743ddf247c81c8>.
renderApodizationSpec :: NonEmpty ApodizationFunction -> ByteString
renderApodizationSpec :: NonEmpty ApodizationFunction -> ByteString
renderApodizationSpec =
  ByteString -> ByteString
BL.toStrict
    (ByteString -> ByteString)
-> (NonEmpty ApodizationFunction -> ByteString)
-> NonEmpty ApodizationFunction
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BU.toLazyByteString
    (Builder -> ByteString)
-> (NonEmpty ApodizationFunction -> Builder)
-> NonEmpty ApodizationFunction
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
    ([Builder] -> Builder)
-> (NonEmpty ApodizationFunction -> [Builder])
-> NonEmpty ApodizationFunction
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse ";"
    ([Builder] -> [Builder])
-> (NonEmpty ApodizationFunction -> [Builder])
-> NonEmpty ApodizationFunction
-> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Builder -> [Builder]
forall a. NonEmpty a -> [a]
NE.toList
    (NonEmpty Builder -> [Builder])
-> (NonEmpty ApodizationFunction -> NonEmpty Builder)
-> NonEmpty ApodizationFunction
-> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ApodizationFunction -> Builder)
-> NonEmpty ApodizationFunction -> NonEmpty Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ApodizationFunction -> Builder
f
  where
    f :: ApodizationFunction -> BU.Builder
    f :: ApodizationFunction -> Builder
f Bartlett = "bartlett"
    f BartlettHann = "bartlett_hann"
    f Blackman = "blackman"
    f BlackmanHarris4Term92Db = "blackman_harris_4term_92db"
    f Connes = "connes"
    f Flattop = "flattop"
    f (Gauss stddev :: Double
stddev) = "gauss(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Double -> Builder
BU.doubleDec Double
stddev Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ")"
    f Hamming = "hamming"
    f Hann = "hann"
    f KaiserBessel = "kaiser_bessel"
    f Nuttall = "nuttall"
    f Rectangle = "rectangle"
    f Triangle = "triangle"
    f (Tukey p :: Double
p) = "tukey(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Double -> Builder
BU.doubleDec Double
p Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ")"
    f (PartialTukey n :: Natural
n Nothing) =
      "partial_tukey(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Natural -> Builder
natDec Natural
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ")"
    f (PartialTukey n :: Natural
n (Just (ov :: Double
ov, Nothing))) =
      "partial_tukey(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Natural -> Builder
natDec Natural
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> "/" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Double -> Builder
BU.doubleDec Double
ov Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ")"
    f (PartialTukey n :: Natural
n (Just (ov :: Double
ov, Just p :: Double
p))) =
      "partial_tukey(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Natural -> Builder
natDec Natural
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> "/" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Double -> Builder
BU.doubleDec Double
ov Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> "/" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Double -> Builder
BU.doubleDec Double
p Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ")"
    f (PunchoutTukey n :: Natural
n Nothing) =
      "punchout_tukey(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Natural -> Builder
natDec Natural
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ")"
    f (PunchoutTukey n :: Natural
n (Just (ov :: Double
ov, Nothing))) =
      "punchout_tukey(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Natural -> Builder
natDec Natural
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> "/" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Double -> Builder
BU.doubleDec Double
ov Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ")"
    f (PunchoutTukey n :: Natural
n (Just (ov :: Double
ov, Just p :: Double
p))) =
      "punchout_tukey(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Natural -> Builder
natDec Natural
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> "/" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Double -> Builder
BU.doubleDec Double
ov Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> "/" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Double -> Builder
BU.doubleDec Double
p Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ")"
    f Welch = "welch"
    natDec :: Natural -> BU.Builder
    natDec :: Natural -> Builder
natDec = Integer -> Builder
BU.integerDec (Integer -> Builder) -> (Natural -> Integer) -> Natural -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral