-- GENERATED by C->Haskell Compiler, version 0.25.2 Snowboundest, 31 Oct 2014 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Sound/RubberBand/Raw.chs" #-}
module Sound.RubberBand.Raw

( Stretcher(..)
, SampleRate, NumChannels, TimeRatio, PitchScale

, new, delete, p_delete, reset

, setTimeRatio, setPitchScale
, getTimeRatio, getPitchScale
, getLatency

, setTransientsOption
, setDetectorOption
, setPhaseOption
, setFormantOption
, setPitchOption

, setExpectedInputDuration
, getSamplesRequired

, setMaxProcessSize
, setKeyFrameMap

, study, process
, available, retrieve

, getChannelCount

, calculateStretch

, setDebugLevel
, setDefaultDebugLevel

) where

import Foreign.Ptr (Ptr, FunPtr)
import Foreign.C.Types
import Foreign.Marshal.Utils (fromBool)

import Sound.RubberBand.Option



fromOptions' :: (Integral a) => Options -> a
fromOptions' = fromIntegral . fromOptions

optionEnum' :: (Option o, Integral a) => o -> a
optionEnum' = fromIntegral . optionEnum

newtype Stretcher = Stretcher (Ptr (Stretcher))
{-# LINE 50 "src/Sound/RubberBand/Raw.chs" #-}



{-# LINE 52 "src/Sound/RubberBand/Raw.chs" #-}


-- | Samples per second of the input and output audio.
type SampleRate = Int

-- | The number of channels processed by a stretcher.
type NumChannels = Int

-- | A ratio of stretched duration to unstretched (original) duration.
type TimeRatio = Double

{- |
A ratio of output frequencies to input frequencies. For example, a ratio of
2 will increase the audio by one octave, and 0.5 will decrease it by one
octave.
-}
type PitchScale = Double

new :: (SampleRate) -> (NumChannels) -> (Options) -> (TimeRatio) -> (PitchScale) -> IO ((Stretcher))
new a1 a2 a3 a4 a5 =
  let {a1' = fromIntegral a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromOptions' a3} in 
  let {a4' = realToFrac a4} in 
  let {a5' = realToFrac a5} in 
  new'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 76 "src/Sound/RubberBand/Raw.chs" #-}


delete :: (Stretcher) -> IO ()
delete a1 =
  let {a1' = id a1} in 
  delete'_ a1' >>
  return ()

{-# LINE 79 "src/Sound/RubberBand/Raw.chs" #-}


-- | Suitable for a 'Foreign.ForeignPtr' finalizer.
foreign import ccall "&rubberband_delete"
  p_delete :: FunPtr (Ptr Stretcher -> IO ())

reset :: (Stretcher) -> IO ()
reset a1 =
  let {a1' = id a1} in 
  reset'_ a1' >>
  return ()

{-# LINE 86 "src/Sound/RubberBand/Raw.chs" #-}


setTimeRatio :: (Stretcher) -> (TimeRatio) -> IO ()
setTimeRatio a1 a2 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  setTimeRatio'_ a1' a2' >>
  return ()

{-# LINE 89 "src/Sound/RubberBand/Raw.chs" #-}

setPitchScale :: (Stretcher) -> (PitchScale) -> IO ()
setPitchScale a1 a2 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  setPitchScale'_ a1' a2' >>
  return ()

{-# LINE 91 "src/Sound/RubberBand/Raw.chs" #-}


getTimeRatio :: (Stretcher) -> IO ((TimeRatio))
getTimeRatio a1 =
  let {a1' = id a1} in 
  getTimeRatio'_ a1' >>= \res ->
  let {res' = realToFrac res} in
  return (res')

{-# LINE 94 "src/Sound/RubberBand/Raw.chs" #-}

getPitchScale :: (Stretcher) -> IO ((PitchScale))
getPitchScale a1 =
  let {a1' = id a1} in 
  getPitchScale'_ a1' >>= \res ->
  let {res' = realToFrac res} in
  return (res')

{-# LINE 96 "src/Sound/RubberBand/Raw.chs" #-}


getLatency :: (Stretcher) -> IO ((Int))
getLatency a1 =
  let {a1' = id a1} in 
  getLatency'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 99 "src/Sound/RubberBand/Raw.chs" #-}


setTransientsOption :: (Stretcher) -> (Transients) -> IO ()
setTransientsOption a1 a2 =
  let {a1' = id a1} in 
  let {a2' = optionEnum' a2} in 
  setTransientsOption'_ a1' a2' >>
  return ()

{-# LINE 102 "src/Sound/RubberBand/Raw.chs" #-}

setDetectorOption :: (Stretcher) -> (Detector) -> IO ()
setDetectorOption a1 a2 =
  let {a1' = id a1} in 
  let {a2' = optionEnum' a2} in 
  setDetectorOption'_ a1' a2' >>
  return ()

{-# LINE 104 "src/Sound/RubberBand/Raw.chs" #-}

setPhaseOption :: (Stretcher) -> (Phase) -> IO ()
setPhaseOption a1 a2 =
  let {a1' = id a1} in 
  let {a2' = optionEnum' a2} in 
  setPhaseOption'_ a1' a2' >>
  return ()

{-# LINE 106 "src/Sound/RubberBand/Raw.chs" #-}

setFormantOption :: (Stretcher) -> (Formant) -> IO ()
setFormantOption a1 a2 =
  let {a1' = id a1} in 
  let {a2' = optionEnum' a2} in 
  setFormantOption'_ a1' a2' >>
  return ()

{-# LINE 108 "src/Sound/RubberBand/Raw.chs" #-}

setPitchOption :: (Stretcher) -> (Pitch) -> IO ()
setPitchOption a1 a2 =
  let {a1' = id a1} in 
  let {a2' = optionEnum' a2} in 
  setPitchOption'_ a1' a2' >>
  return ()

{-# LINE 110 "src/Sound/RubberBand/Raw.chs" #-}


setExpectedInputDuration :: (Stretcher) -> (Int) -> IO ()
setExpectedInputDuration a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  setExpectedInputDuration'_ a1' a2' >>
  return ()

{-# LINE 113 "src/Sound/RubberBand/Raw.chs" #-}


getSamplesRequired :: (Stretcher) -> IO ((Int))
getSamplesRequired a1 =
  let {a1' = id a1} in 
  getSamplesRequired'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 116 "src/Sound/RubberBand/Raw.chs" #-}


setMaxProcessSize :: (Stretcher) -> (Int) -> IO ()
setMaxProcessSize a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  setMaxProcessSize'_ a1' a2' >>
  return ()

{-# LINE 119 "src/Sound/RubberBand/Raw.chs" #-}

setKeyFrameMap :: (Stretcher) -> (Int) -> (Ptr CUInt) -> (Ptr CUInt) -> IO ()
setKeyFrameMap a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = id a3} in 
  let {a4' = id a4} in 
  setKeyFrameMap'_ a1' a2' a3' a4' >>
  return ()

{-# LINE 121 "src/Sound/RubberBand/Raw.chs" #-}


study :: (Stretcher) -> (Ptr (Ptr CFloat)) -> (Int) -> (Bool) -> IO ()
study a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromBool a4} in 
  study'_ a1' a2' a3' a4' >>
  return ()

{-# LINE 124 "src/Sound/RubberBand/Raw.chs" #-}

process :: (Stretcher) -> (Ptr (Ptr CFloat)) -> (Int) -> (Bool) -> IO ()
process a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromBool a4} in 
  process'_ a1' a2' a3' a4' >>
  return ()

{-# LINE 126 "src/Sound/RubberBand/Raw.chs" #-}


available :: (Stretcher) -> IO ((Int))
available a1 =
  let {a1' = id a1} in 
  available'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 129 "src/Sound/RubberBand/Raw.chs" #-}

retrieve :: (Stretcher) -> (Ptr (Ptr CFloat)) -> (Int) -> IO ((Int))
retrieve a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = fromIntegral a3} in 
  retrieve'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 131 "src/Sound/RubberBand/Raw.chs" #-}


getChannelCount :: (Stretcher) -> IO ((Int))
getChannelCount a1 =
  let {a1' = id a1} in 
  getChannelCount'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 134 "src/Sound/RubberBand/Raw.chs" #-}


calculateStretch :: (Stretcher) -> IO ()
calculateStretch a1 =
  let {a1' = id a1} in 
  calculateStretch'_ a1' >>
  return ()

{-# LINE 137 "src/Sound/RubberBand/Raw.chs" #-}


setDebugLevel :: (Stretcher) -> (Int) -> IO ()
setDebugLevel a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  setDebugLevel'_ a1' a2' >>
  return ()

{-# LINE 140 "src/Sound/RubberBand/Raw.chs" #-}

setDefaultDebugLevel :: (Int) -> IO ()
setDefaultDebugLevel a1 =
  let {a1' = fromIntegral a1} in 
  setDefaultDebugLevel'_ a1' >>
  return ()

{-# LINE 142 "src/Sound/RubberBand/Raw.chs" #-}


foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_new"
  new'_ :: (CUInt -> (CUInt -> (CInt -> (CDouble -> (CDouble -> (IO (Stretcher)))))))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_delete"
  delete'_ :: ((Stretcher) -> (IO ()))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_reset"
  reset'_ :: ((Stretcher) -> (IO ()))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_set_time_ratio"
  setTimeRatio'_ :: ((Stretcher) -> (CDouble -> (IO ())))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_set_pitch_scale"
  setPitchScale'_ :: ((Stretcher) -> (CDouble -> (IO ())))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_get_time_ratio"
  getTimeRatio'_ :: ((Stretcher) -> (IO CDouble))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_get_pitch_scale"
  getPitchScale'_ :: ((Stretcher) -> (IO CDouble))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_get_latency"
  getLatency'_ :: ((Stretcher) -> (IO CUInt))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_set_transients_option"
  setTransientsOption'_ :: ((Stretcher) -> (CInt -> (IO ())))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_set_detector_option"
  setDetectorOption'_ :: ((Stretcher) -> (CInt -> (IO ())))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_set_phase_option"
  setPhaseOption'_ :: ((Stretcher) -> (CInt -> (IO ())))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_set_formant_option"
  setFormantOption'_ :: ((Stretcher) -> (CInt -> (IO ())))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_set_pitch_option"
  setPitchOption'_ :: ((Stretcher) -> (CInt -> (IO ())))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_set_expected_input_duration"
  setExpectedInputDuration'_ :: ((Stretcher) -> (CUInt -> (IO ())))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_get_samples_required"
  getSamplesRequired'_ :: ((Stretcher) -> (IO CUInt))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_set_max_process_size"
  setMaxProcessSize'_ :: ((Stretcher) -> (CUInt -> (IO ())))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_set_key_frame_map"
  setKeyFrameMap'_ :: ((Stretcher) -> (CUInt -> ((Ptr CUInt) -> ((Ptr CUInt) -> (IO ())))))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_study"
  study'_ :: ((Stretcher) -> ((Ptr (Ptr CFloat)) -> (CUInt -> (CInt -> (IO ())))))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_process"
  process'_ :: ((Stretcher) -> ((Ptr (Ptr CFloat)) -> (CUInt -> (CInt -> (IO ())))))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_available"
  available'_ :: ((Stretcher) -> (IO CInt))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_retrieve"
  retrieve'_ :: ((Stretcher) -> ((Ptr (Ptr CFloat)) -> (CUInt -> (IO CUInt))))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_get_channel_count"
  getChannelCount'_ :: ((Stretcher) -> (IO CUInt))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_calculate_stretch"
  calculateStretch'_ :: ((Stretcher) -> (IO ()))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_set_debug_level"
  setDebugLevel'_ :: ((Stretcher) -> (CInt -> (IO ())))

foreign import ccall safe "Sound/RubberBand/Raw.chs.h rubberband_set_default_debug_level"
  setDefaultDebugLevel'_ :: (CInt -> (IO ()))