-- GENERATED by C->Haskell Compiler, version 0.28.2 Switcheroo, 1 April 2016 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "Util/Audio/SampleRateC.chs" #-}
-- Copyright 2018 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | Binding to libsamplerate.
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
module Util.Audio.SampleRateC (
    State, Quality(..), new, delete, setRatio
    , Input(..), Output(..)
    , process
    , Exception(..)
    -- * SavedState
    , SavedState(..)
    , unsafeGetState, putState
    , getRatio
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp


import qualified Control.Exception as Exception
import Control.Monad (when)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Unsafe as Unsafe

import qualified Foreign
import Foreign (alloca, peek)
import qualified Foreign.C as C
import qualified GHC.Stack as Stack
import qualified Data.Text as Text

import qualified Util.CallStack as CallStack


type Channels = Int

new :: Quality -> Channels -> IO State
new quality chan = Foreign.alloca $ \errp -> do
    State state <- src_new quality chan errp
    when (state == Foreign.nullPtr) $
        throw "new" =<< Foreign.peek errp
    return $ State state

delete :: State -> IO ()
delete state = src_delete state >> return ()

setRatio :: State -> Double -> IO ()
setRatio state ratio = check "setRatio" =<< src_set_ratio state ratio

-- | This corresponds to the input part of SRC_DATA.
data Input = Input {
    data_in :: Foreign.Ptr C.CFloat
    , data_out :: Foreign.Ptr C.CFloat
    , input_frames :: Integer
    , output_frames :: Integer
    , src_ratio :: Double
    , end_of_input :: Bool
    } deriving (Eq, Show)

-- | This corresponds to the output part of SRC_DATA.
data Output = Output {
    input_frames_used :: !Integer
    , output_frames_generated :: !Integer
    } deriving (Eq, Show)

process :: State -> Input -> IO Output
process state (Input {..}) =
    Foreign.allocaBytes 64 $ \datap -> do
        (\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: (C2HSImp.Ptr C2HSImp.CFloat))}) datap data_in
        (\ptr val -> do {C2HSImp.pokeByteOff ptr 8 (val :: (C2HSImp.Ptr C2HSImp.CFloat))}) datap data_out
        (\ptr val -> do {C2HSImp.pokeByteOff ptr 16 (val :: C2HSImp.CLong)}) datap $ fromIntegral input_frames
        (\ptr val -> do {C2HSImp.pokeByteOff ptr 24 (val :: C2HSImp.CLong)}) datap $ fromIntegral output_frames
        (\ptr val -> do {C2HSImp.pokeByteOff ptr 56 (val :: C2HSImp.CDouble)}) datap $ realToFrac src_ratio
        (\ptr val -> do {C2HSImp.pokeByteOff ptr 48 (val :: C2HSImp.CInt)}) datap $ Foreign.fromBool end_of_input
        check "process" =<< src_process state (Data datap)
        Output
            <$> (fromIntegral <$> (\ptr -> do {C2HSImp.peekByteOff ptr 32 :: IO C2HSImp.CLong}) datap)
            <*> (fromIntegral <$> (\ptr -> do {C2HSImp.peekByteOff ptr 40 :: IO C2HSImp.CLong}) datap)

-- * errors

newtype Exception = Exception Text.Text deriving (Eq, Show)
instance Exception.Exception Exception

throw :: Stack.HasCallStack => Text.Text -> C.CInt -> IO ()
throw caller code = do
    errp <- src_strerror code
    err <- if errp == Foreign.nullPtr
        then return "src_strerror returned null"
        else C.peekCString errp
    CallStack.throw Exception $ caller <> ": " <> Text.pack err

check :: Stack.HasCallStack => Text.Text -> Int -> IO ()
check caller code
    | code == 0 = return ()
    | otherwise = throw caller (fromIntegral code)

-- * bindings



newtype State = State (C2HSImp.Ptr (State))
{-# LINE 99 "Util/Audio/SampleRateC.chs" #-}

newtype Data = Data (C2HSImp.Ptr (Data))
{-# LINE 100 "Util/Audio/SampleRateC.chs" #-}


data Quality = SincBestQuality
             | SincMediumQuality
             | SincFastest
             | ZeroOrderHold
             | Linear
  deriving (Eq,Show,Bounded)
instance Enum Quality where
  succ SincBestQuality = SincMediumQuality
  succ SincMediumQuality = SincFastest
  succ SincFastest = ZeroOrderHold
  succ ZeroOrderHold = Linear
  succ Linear = error "Quality.succ: Linear has no successor"

  pred SincMediumQuality = SincBestQuality
  pred SincFastest = SincMediumQuality
  pred ZeroOrderHold = SincFastest
  pred Linear = ZeroOrderHold
  pred SincBestQuality = error "Quality.pred: SincBestQuality has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from Linear

  fromEnum SincBestQuality = 0
  fromEnum SincMediumQuality = 1
  fromEnum SincFastest = 2
  fromEnum ZeroOrderHold = 3
  fromEnum Linear = 4

  toEnum 0 = SincBestQuality
  toEnum 1 = SincMediumQuality
  toEnum 2 = SincFastest
  toEnum 3 = ZeroOrderHold
  toEnum 4 = Linear
  toEnum unmatched = error ("Quality.toEnum: Cannot match " ++ show unmatched)

{-# LINE 109 "Util/Audio/SampleRateC.chs" #-}


src_new :: (Quality) -> (Int) -> (Foreign.Ptr C.CInt) -> IO ((State))
src_new a1 a2 a3 =
  let {a1' = (fromIntegral . fromEnum) a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = id a3} in 
  src_new'_ a1' a2' a3' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 111 "Util/Audio/SampleRateC.chs" #-}

src_delete :: (State) -> IO ((State))
src_delete a1 =
  let {a1' = id a1} in 
  src_delete'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 112 "Util/Audio/SampleRateC.chs" #-}

src_set_ratio :: (State) -> (Double) -> IO ((Int))
src_set_ratio a1 a2 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  src_set_ratio'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 113 "Util/Audio/SampleRateC.chs" #-}

src_strerror :: (C.CInt) -> IO ((C.CString))
src_strerror a1 =
  let {a1' = id a1} in 
  src_strerror'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 114 "Util/Audio/SampleRateC.chs" #-}

src_process :: (State) -> (Data) -> IO ((Int))
src_process a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  src_process'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 115 "Util/Audio/SampleRateC.chs" #-}


type CSize = (C2HSImp.CULong)
{-# LINE 117 "Util/Audio/SampleRateC.chs" #-}

newtype StateFlat = StateFlat (C2HSImp.Ptr (StateFlat))
{-# LINE 118 "Util/Audio/SampleRateC.chs" #-}


data SavedState = SavedState !ByteString.ByteString !ByteString.ByteString
    deriving (Eq, Show)

-- | The second ByteString in SavedState is done without copying, so use it
-- before doing anything with State!
--
-- This is only in my fork of libsamplerate, referenced in default.nix.
unsafeGetState :: State -> IO SavedState
unsafeGetState state = do
    let size1 = 32
{-# LINE 129 "Util/Audio/SampleRateC.chs" #-}

    ptr <- Foreign.mallocBytes size1
    (size2, state2p) <- src_get_state state (StateFlat ptr)

    -- This is safe because I allocated the memory.
    state1 <- Unsafe.unsafePackMallocCStringLen (Foreign.castPtr ptr, size1)
    -- This is unsafe, because I'm reusing libsamplerate's memory, and
    -- libsamplerate will definitely mutate it on the next 'process' call.
    -- See TODO non-copying state:.
    state2 <- Unsafe.unsafePackCStringLen
        (Foreign.castPtr state2p, fromIntegral size2)
    -- Safe version:
    -- state2 <- ByteString.packCStringLen
    --     (Foreign.castPtr state2p, fromIntegral size2)

    return $ SavedState state1 state2

-- void src_get_state(SRC_STATE *state, SRC_STATE_FLAT *saved1,
--   size_t *size, void **private)
src_get_state :: (State) -> (StateFlat) -> IO ((CSize), (Foreign.Ptr ()))
src_get_state a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  alloca $ \a3' -> 
  alloca $ \a4' -> 
  src_get_state'_ a1' a2' a3' a4' >>
  peek  a3'>>= \a3'' -> 
  peek  a4'>>= \a4'' -> 
  return (a3'', a4'')

{-# LINE 154 "Util/Audio/SampleRateC.chs" #-}


putState :: Quality -> State -> SavedState -> IO Bool
putState quality state (SavedState state1 state2) =
    Unsafe.unsafeUseAsCString state1 $ \state1p ->
    Unsafe.unsafeUseAsCStringLen state2 $ \(state2p, size2) ->
        src_put_state quality state (StateFlat (Foreign.castPtr state1p))
            (fromIntegral size2) (Foreign.castPtr state2p)

-- int src_put_state(
--     int converter_type,
--     SRC_STATE *state, SRC_STATE_FLAT *saved1, size_t size, void *private) ;
src_put_state :: (Quality) -> (State) -> (StateFlat) -> (CSize) -> (Foreign.Ptr ()) -> IO ((Bool))
src_put_state a1 a2 a3 a4 a5 =
  let {a1' = (fromIntegral . fromEnum) a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  let {a4' = id a4} in 
  let {a5' = id a5} in 
  src_put_state'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 169 "Util/Audio/SampleRateC.chs" #-}


getRatio :: State -> IO Double
getRatio (State state) = realToFrac <$> (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CDouble}) state

foreign import ccall safe "Util/Audio/SampleRateC.chs.h src_new"
  src_new'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO (State)))))

foreign import ccall safe "Util/Audio/SampleRateC.chs.h src_delete"
  src_delete'_ :: ((State) -> (IO (State)))

foreign import ccall safe "Util/Audio/SampleRateC.chs.h src_set_ratio"
  src_set_ratio'_ :: ((State) -> (C2HSImp.CDouble -> (IO C2HSImp.CInt)))

foreign import ccall safe "Util/Audio/SampleRateC.chs.h src_strerror"
  src_strerror'_ :: (C2HSImp.CInt -> (IO (C2HSImp.Ptr C2HSImp.CChar)))

foreign import ccall safe "Util/Audio/SampleRateC.chs.h src_process"
  src_process'_ :: ((State) -> ((Data) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Util/Audio/SampleRateC.chs.h src_get_state"
  src_get_state'_ :: ((State) -> ((StateFlat) -> ((C2HSImp.Ptr C2HSImp.CULong) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO ())))))

foreign import ccall safe "Util/Audio/SampleRateC.chs.h src_put_state"
  src_put_state'_ :: (C2HSImp.CInt -> ((State) -> ((StateFlat) -> (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))))