-- GENERATED by C->Haskell Compiler, version 0.15.1 Rainy Days, 31 Aug 2007 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Sound/PortAudio/Base.chs" #-}{-# LANGUAGE ForeignFunctionInterface #-}

module Sound.PortAudio.Base
(
    -- FFI Functions
    abortStream_ffi,
    closeStream_ffi,
    getDefaultHostApi_ffi,
    getDefaultInputDevice_ffi,
    getDefaultOutputDevice_ffi,
    getDeviceCount_ffi,
    getDeviceInfo_ffi,
    getHostApiCount_ffi,
    getHostApiInfo_ffi,
    getLastHostErrorInfo_ffi,
    getSampleSize_ffi,
    getStreamCpuLoad_ffi,
    getStreamInfo_ffi,
    getStreamReadAvailable_ffi,
    getStreamTime_ffi,
    getStreamWriteAvailable_ffi,
    hostApiDeviceIndexToDeviceIndex_ffi,
    hostApiTypeIdToHostApiIndex_ffi,
    initialize_ffi,
    isFormatSupported_ffi,
    isStreamActive_ffi,
    isStreamStopped_ffi,
    openDefaultStream_ffi,
    openStream_ffi,
    paSleep_ffi,
    readStream_ffi,
    startStream_ffi,
    stopStream_ffi,
    terminate_ffi,
    writeStream_ffi,

    -- Types
    DeviceIndex,
    HostApiIndex,
    PaTime,

    -- Datas
    PaStream,
    HostApiInfo(..),
    SampleFormat(..),
    StreamInfo(..),
    StreamParameters(..),
    DeviceInfo(..),
    HostErrorInfo(..),

    -- Enumerations
    HostApiTypeId(..),
    ErrorCode(..),

    -- Functions
    getErrorText,
    getVersion,
    getVersionText,

    -- Other
    paNullPtr,
)
where

import C2HS
import Control.Monad.Error
import Sound.PortAudio.Helpers



{-# LINE 71 "./Sound/PortAudio/Base.chs" #-}

paNullPtr = nullPtr

-- I don't want to expose this, rather, convert it to an ErrorCode before returning.
type PaError = Int

-- |The index of a PortAudio device.
type DeviceIndex = Int

-- |Used to enumerate host APIs at runtime. The values of
-- this range from @0@ to @(getHostApiCount - 1)@
type HostApiIndex = Int

-- |Type to represent the monotonic time in seconds which can be
-- used for synchronisation.
type PaTime = Double

-- Internal representation of a Stream Buffer. This is not to be used outside of the _ffi functions.
type PaStreamBuffer = Ptr ()

-- |A PaStream can provide multiple channels of real-time
-- streaming audio input and output to a client application.
-- type PaStream = IntPtr
data PaStream a = PaStream (IntPtr)
    deriving (Show)

-- |A structure containing information about a particular host API.
data HostApiInfo = HostApiInfo {
    hostApiInfoStructVersion :: Int,
    hostApiInfoApiType :: HostApiTypeId,
    hostApiInfoName :: String,
    hostApiInfoDeviceCount :: Int,
    hostApiInfoDefaultInputDevice :: DeviceIndex,
    hostApiInfoDefaultOutputDevice :: DeviceIndex
} deriving (Show)                                     

{- Created this enum myself to represent the
 - different sample formats which are #defined
 - in the header. I don't like #define's -}

-- |A type used to specify one or more sample formats.
--   
--   * The floating point representation (@PaFloat32@) uses +1.0 and -1.0 as the maximum and minimum.
--
--   * (@PaUInt8@) considers 128 "ground".
--
--   * The (@PaNonInterleaved@) flag indicates that a multichannel buffer is passed as a set of non-interleaved pointers. (WHAT?)
--   I don't think i want to support this.
--
data SampleFormat = PaFloat32
                  | PaInt32
                  | PaInt24
                  | PaInt16
                  | PaInt8
                  | PaUInt8
                  | PaCustomFormat
                  | PaNonInterleaved
    deriving (Read,Show)

instance Enum SampleFormat where
    fromEnum PaFloat32        = 0x00000001
    fromEnum PaInt32          = 0x00000002
    fromEnum PaInt24          = 0x00000004
    fromEnum PaInt16          = 0x00000008
    fromEnum PaInt8           = 0x00000010
    fromEnum PaUInt8          = 0x00000020
    fromEnum PaCustomFormat   = 0x00010000
    fromEnum PaNonInterleaved = 0x80000000
    toEnum 0x00000001 = PaFloat32
    toEnum 0x00000002 = PaInt32
    toEnum 0x00000004 = PaInt24
    toEnum 0x00000008 = PaInt16
    toEnum 0x00000010 = PaInt8
    toEnum 0x00000020 = PaUInt8
    toEnum 0x00010000 = PaCustomFormat
    toEnum 0x80000000 = PaNonInterleaved
    toEnum unmatched  = error ("SampleFormat.toEnum: Cannot match " ++ show  unmatched)

-- | A structure containing unchanging information about an open stream.
data StreamInfo = StreamInfo {
    streamInfoStructVersion :: Int,
    streamInfoInputLatency :: PaTime,
    streamInfoOutputLatency :: PaTime,
    streamInfoSampleRate :: Double
}
    deriving (Show)

-- |Parameters for one direction (input or output) of a stream.
data StreamParameters = StreamParameters {
    streamParametersDevice :: DeviceIndex,
    streamParametersChannelCount :: Int,
    streamParametersSampleFormat :: SampleFormat,
    streamParametersSuggestedLatency :: PaTime,
    streamParametersHostApiSpecificStreamInfo :: Ptr ()  -- This isn't to be used.
}
    deriving (Show)

instance Storable StreamParameters where
    sizeOf _    = 24
{-# LINE 170 "./Sound/PortAudio/Base.chs" #-}
    alignment _ = alignment (undefined :: CLong)
    peek ptr    = do
        de <- liftM cIntConv   $ (\ptr -> do {peekByteOff ptr 0 ::IO CInt}) ptr
        cc <- liftM cIntConv   $ (\ptr -> do {peekByteOff ptr 4 ::IO CInt}) ptr
        sf <- liftM cToEnum    $ (\ptr -> do {peekByteOff ptr 8 ::IO CULong}) ptr
        sl <- liftM cFloatConv $ (\ptr -> do {peekByteOff ptr 12 ::IO CDouble}) ptr
        ha <-                    (\ptr -> do {peekByteOff ptr 20 ::IO (Ptr ())}) ptr

        return $ StreamParameters {
            streamParametersDevice = de,
            streamParametersChannelCount = cc,
            streamParametersSampleFormat = sf,
            streamParametersSuggestedLatency = sl,
            streamParametersHostApiSpecificStreamInfo = ha
        }
    poke ptr (StreamParameters de cc sf sl ha) = do
        (\ptr val -> do {pokeByteOff ptr 0 (val::CInt)}) ptr (cIntConv de)
        (\ptr val -> do {pokeByteOff ptr 4 (val::CInt)}) ptr (cIntConv cc)
        (\ptr val -> do {pokeByteOff ptr 8 (val::CULong)}) ptr (cFromEnum sf)
        (\ptr val -> do {pokeByteOff ptr 12 (val::CDouble)}) ptr (cFloatConv sl)
        (\ptr val -> do {pokeByteOff ptr 20 (val::(Ptr ()))}) ptr ha

-- |Structure used to return information about a host error condition.
data HostErrorInfo = HostErrorInfo {
    hostErrorInfoHostApiType :: HostApiTypeId,
    hostErrorInfoErrorCode :: Int,
    hostErrorInfoErrorText :: String
}
    deriving (Show)

-- |A structure providing information and capabilities of PortAudio devices. Devices may support
-- input, output or both.
data DeviceInfo = DeviceInfo {
    deviceInfoStructVersion :: Int,
    deviceInfoName :: String,
    deviceInfoHostApi :: HostApiIndex,
    deviceInfoMaxInputChannels :: Int,
    deviceInfoMaxOutputChannels :: Int,
    deviceInfoDefaultLowInputLatency :: PaTime,
    deviceInfoDefaultLowOutputLatency :: PaTime,
    deviceInfoDefaultHighInputLatency :: PaTime,
    deviceInfoDefaultHighOutputLatency :: PaTime,
    deviceInfoDefaultSampleRate :: Double
}
    deriving (Show)

-- |Unchanging uniqe identifiers for each supported host API. The values
-- are guaranteed to be unique and will never change. This allows code to
-- be written which conditionally uses host API specific extensions.
data HostApiTypeId = InDevelopment
                   | DirectSound
                   | MME
                   | ASIO
                   | SoundManager
                   | CoreAudio
                   | OSS
                   | ALSA
                   | AL
                   | BeOS
                   | WDMKS
                   | JACK
                   | WASAPI
                   | AudioScienceHPI
                   deriving (Show)
instance Enum HostApiTypeId where
  fromEnum InDevelopment = 0
  fromEnum DirectSound = 1
  fromEnum MME = 2
  fromEnum ASIO = 3
  fromEnum SoundManager = 4
  fromEnum CoreAudio = 5
  fromEnum OSS = 7
  fromEnum ALSA = 8
  fromEnum AL = 9
  fromEnum BeOS = 10
  fromEnum WDMKS = 11
  fromEnum JACK = 12
  fromEnum WASAPI = 13
  fromEnum AudioScienceHPI = 14

  toEnum 0 = InDevelopment
  toEnum 1 = DirectSound
  toEnum 2 = MME
  toEnum 3 = ASIO
  toEnum 4 = SoundManager
  toEnum 5 = CoreAudio
  toEnum 7 = OSS
  toEnum 8 = ALSA
  toEnum 9 = AL
  toEnum 10 = BeOS
  toEnum 11 = WDMKS
  toEnum 12 = JACK
  toEnum 13 = WASAPI
  toEnum 14 = AudioScienceHPI
  toEnum unmatched = error ("HostApiTypeId.toEnum: Cannot match " ++ show unmatched)

{-# LINE 221 "./Sound/PortAudio/Base.chs" #-}

data ErrorCode = NoError
               | NotInitialized
               | UnanticipatedHostError
               | InvalidChannelCount
               | InvalidSampleRate
               | InvalidDevice
               | InvalidFlag
               | SampleFormatNotSupported
               | BadIODeviceCombination
               | InsufficientMemory
               | BufferTooBig
               | BufferTooSmall
               | NullCallback
               | BadStreamPtr
               | TimedOut
               | InternalError
               | DeviceUnavailable
               | IncompatibleHostApiSpecificStreamInfo
               | StreamIsStopped
               | StreamIsNotStopped
               | InputOverflowed
               | OutputUnderflowed
               | HostApiNotFound
               | InvalidHostApi
               | CanNotReadFromACallbackStream
               | CanNotWriteToACallbackStream
               | CanNotReadFromAnOutputOnlyStream
               | CanNotWriteToAnInputOnlyStream
               | IncompatibleStreamHostApi
               | BadBufferPtr
               deriving (Show)
instance Enum ErrorCode where
  fromEnum NoError = 0
  fromEnum NotInitialized = (-10000)
  fromEnum UnanticipatedHostError = (-9999)
  fromEnum InvalidChannelCount = (-9998)
  fromEnum InvalidSampleRate = (-9997)
  fromEnum InvalidDevice = (-9996)
  fromEnum InvalidFlag = (-9995)
  fromEnum SampleFormatNotSupported = (-9994)
  fromEnum BadIODeviceCombination = (-9993)
  fromEnum InsufficientMemory = (-9992)
  fromEnum BufferTooBig = (-9991)
  fromEnum BufferTooSmall = (-9990)
  fromEnum NullCallback = (-9989)
  fromEnum BadStreamPtr = (-9988)
  fromEnum TimedOut = (-9987)
  fromEnum InternalError = (-9986)
  fromEnum DeviceUnavailable = (-9985)
  fromEnum IncompatibleHostApiSpecificStreamInfo = (-9984)
  fromEnum StreamIsStopped = (-9983)
  fromEnum StreamIsNotStopped = (-9982)
  fromEnum InputOverflowed = (-9981)
  fromEnum OutputUnderflowed = (-9980)
  fromEnum HostApiNotFound = (-9979)
  fromEnum InvalidHostApi = (-9978)
  fromEnum CanNotReadFromACallbackStream = (-9977)
  fromEnum CanNotWriteToACallbackStream = (-9976)
  fromEnum CanNotReadFromAnOutputOnlyStream = (-9975)
  fromEnum CanNotWriteToAnInputOnlyStream = (-9974)
  fromEnum IncompatibleStreamHostApi = (-9973)
  fromEnum BadBufferPtr = (-9972)

  toEnum 0 = NoError
  toEnum (-10000) = NotInitialized
  toEnum (-9999) = UnanticipatedHostError
  toEnum (-9998) = InvalidChannelCount
  toEnum (-9997) = InvalidSampleRate
  toEnum (-9996) = InvalidDevice
  toEnum (-9995) = InvalidFlag
  toEnum (-9994) = SampleFormatNotSupported
  toEnum (-9993) = BadIODeviceCombination
  toEnum (-9992) = InsufficientMemory
  toEnum (-9991) = BufferTooBig
  toEnum (-9990) = BufferTooSmall
  toEnum (-9989) = NullCallback
  toEnum (-9988) = BadStreamPtr
  toEnum (-9987) = TimedOut
  toEnum (-9986) = InternalError
  toEnum (-9985) = DeviceUnavailable
  toEnum (-9984) = IncompatibleHostApiSpecificStreamInfo
  toEnum (-9983) = StreamIsStopped
  toEnum (-9982) = StreamIsNotStopped
  toEnum (-9981) = InputOverflowed
  toEnum (-9980) = OutputUnderflowed
  toEnum (-9979) = HostApiNotFound
  toEnum (-9978) = InvalidHostApi
  toEnum (-9977) = CanNotReadFromACallbackStream
  toEnum (-9976) = CanNotWriteToACallbackStream
  toEnum (-9975) = CanNotReadFromAnOutputOnlyStream
  toEnum (-9974) = CanNotWriteToAnInputOnlyStream
  toEnum (-9973) = IncompatibleStreamHostApi
  toEnum (-9972) = BadBufferPtr
  toEnum unmatched = error ("ErrorCode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 224 "./Sound/PortAudio/Base.chs" #-}

-- Don't expose this for now, we're not using callbacks.
data StreamCallbackResult = Continue
                          | Complete
                          | Abort
                          
instance Enum StreamCallbackResult where
  fromEnum Continue = 0
  fromEnum Complete = 1
  fromEnum Abort = 2

  toEnum 0 = Continue
  toEnum 1 = Complete
  toEnum 2 = Abort
  toEnum unmatched = error ("StreamCallbackResult.toEnum: Cannot match " ++ show unmatched)

{-# LINE 228 "./Sound/PortAudio/Base.chs" #-}

newtype HostApiInfoPtr = HostApiInfoPtr (Ptr (HostApiInfoPtr))
{-# LINE 230 "./Sound/PortAudio/Base.chs" #-}
newtype StreamInfoPtr = StreamInfoPtr (Ptr (StreamInfoPtr))
{-# LINE 231 "./Sound/PortAudio/Base.chs" #-}
type StreamParametersPtr = Ptr (StreamParameters)
{-# LINE 232 "./Sound/PortAudio/Base.chs" #-}
nullStreamParameters =  nullPtr :: StreamParametersPtr
newtype DeviceInfoPtr = DeviceInfoPtr (Ptr (DeviceInfoPtr))
{-# LINE 234 "./Sound/PortAudio/Base.chs" #-}
newtype HostErrorInfoPtr = HostErrorInfoPtr (Ptr (HostErrorInfoPtr))
{-# LINE 235 "./Sound/PortAudio/Base.chs" #-}




maybe_get_const_DeviceInfo p@(DeviceInfoPtr ptr) = do
    r <- if (nullPtr == ptr)
           then (return Nothing)
           else do {m <- get_const_DeviceInfo p; return (Just m);}
    return r

maybe_get_const_HostApiInfo p@(HostApiInfoPtr ptr) = do
    r <- if (nullPtr == ptr)
           then (return Nothing)
           else do {m <- get_const_HostApiInfo p; return (Just m);}
    return r

maybe_get_const_HostErrorInfo p@(HostErrorInfoPtr ptr) = do
    r <- if (nullPtr == ptr)
           then (return Nothing)
           else do {m <- get_const_HostErrorInfo p; return (Just m);}
    return r

maybe_get_const_StreamInfo p@(StreamInfoPtr ptr) = do
    r <- if (nullPtr == ptr)
           then (return Nothing)
           else do {m <- get_const_StreamInfo p; return (Just m);}
    return r


get_const_HostErrorInfo (HostErrorInfoPtr ptr) = do
    ht <- liftM cToEnum     $ (\ptr -> do {peekByteOff ptr 0 ::IO CInt}) ptr
    ec <- liftM cIntConv    $ (\ptr -> do {peekByteOff ptr 4 ::IO CLong}) ptr
    et <- liftM peekCString $ (\ptr -> do {peekByteOff ptr 8 ::IO (Ptr CChar)}) ptr

    et' <- et

    return $ HostErrorInfo {
        hostErrorInfoHostApiType = ht,
        hostErrorInfoErrorCode = ec,
        hostErrorInfoErrorText = et'
    }

get_const_HostApiInfo (HostApiInfoPtr ptr) = do
    vers <- liftM cIntConv                $ (\ptr -> do {peekByteOff ptr 0 ::IO CInt})     ptr

    --
    -- Note: Since type is a reserved word... I had to do the peek my self.
    -- apiType <- liftM cToEnum           $ {# get HostApiInfo . type #}              ptr
    --
    apiType <- liftM cToEnum              $ (\ptr -> do {peekByteOff ptr 4 :: IO CInt}) ptr

    name' <- liftM peekCString            $ (\ptr -> do {peekByteOff ptr 8 ::IO (Ptr CChar)})                ptr
    deviceCount <- liftM cIntConv         $ (\ptr -> do {peekByteOff ptr 12 ::IO CInt})         ptr
    defaultInputDevice <- liftM cIntConv  $ (\ptr -> do {peekByteOff ptr 16 ::IO CInt})  ptr
    defaultOutputDevice <- liftM cIntConv $ (\ptr -> do {peekByteOff ptr 20 ::IO CInt}) ptr
    name <- name'

    return $ HostApiInfo {
        hostApiInfoStructVersion = vers,
        hostApiInfoApiType = apiType,
        hostApiInfoName = name,
        hostApiInfoDeviceCount = deviceCount,
        hostApiInfoDefaultInputDevice = defaultInputDevice,
        hostApiInfoDefaultOutputDevice = defaultOutputDevice
    }

get_const_DeviceInfo (DeviceInfoPtr ptr) = do
    sv  <- liftM cToEnum $ (\ptr -> do {peekByteOff ptr 0 ::IO CInt}) ptr
    nm  <- liftM peekCString $ (\ptr -> do {peekByteOff ptr 4 ::IO (Ptr CChar)}) ptr
    ha  <- liftM cIntConv $ (\ptr -> do {peekByteOff ptr 8 ::IO CInt}) ptr
    ic  <- liftM cIntConv $ (\ptr -> do {peekByteOff ptr 12 ::IO CInt}) ptr
    oc  <- liftM cIntConv $ (\ptr -> do {peekByteOff ptr 16 ::IO CInt}) ptr
    dli <- liftM cFloatConv $ (\ptr -> do {peekByteOff ptr 20 ::IO CDouble}) ptr
    dlo <- liftM cFloatConv $ (\ptr -> do {peekByteOff ptr 28 ::IO CDouble}) ptr
    dhi <- liftM cFloatConv $ (\ptr -> do {peekByteOff ptr 36 ::IO CDouble}) ptr
    dho <- liftM cFloatConv $ (\ptr -> do {peekByteOff ptr 44 ::IO CDouble}) ptr
    dsr <- liftM cFloatConv $ (\ptr -> do {peekByteOff ptr 52 ::IO CDouble}) ptr 

    nm' <- nm

    return $ DeviceInfo {
        deviceInfoStructVersion = sv,
        deviceInfoName = nm',
        deviceInfoHostApi = ha,
        deviceInfoMaxInputChannels = ic,
        deviceInfoMaxOutputChannels = oc,
        deviceInfoDefaultLowInputLatency = dli,
        deviceInfoDefaultLowOutputLatency = dlo,
        deviceInfoDefaultHighInputLatency = dhi,
        deviceInfoDefaultHighOutputLatency = dho,
        deviceInfoDefaultSampleRate = dsr
    }

get_const_StreamInfo (StreamInfoPtr ptr) = do
    sv <- liftM cIntConv $ (\ptr -> do {peekByteOff ptr 0 ::IO CInt}) ptr
    il <- liftM cFloatConv $ (\ptr -> do {peekByteOff ptr 4 ::IO CDouble}) ptr
    ol <- liftM cFloatConv $ (\ptr -> do {peekByteOff ptr 12 ::IO CDouble}) ptr
    sr <- liftM cFloatConv $ (\ptr -> do {peekByteOff ptr 20 ::IO CDouble}) ptr

    return $ StreamInfo {
        streamInfoStructVersion = sv,
        streamInfoInputLatency = il,
        streamInfoOutputLatency = ol,
        streamInfoSampleRate = sr
    }

{-
 - maybeWith :: (a -> (GHC.Ptr.Ptr b -> IO c) -> IO c)
 -     -> Maybe a
 -     -> (GHC.Ptr.Ptr b -> IO c)
 -     -> IO c
 -}
withPA = maybeWith with

peekStream p = do
    ip <- peek p
    return $ PaStream $ ptrToIntPtr ip

-- Only used here. Must not leave.
unPaStream :: PaStream a -> Ptr ()
unPaStream (PaStream ptr) = intPtrToPtr ptr


-- |Translate the supplied PortAudio error code
-- to a textual message.
getErrorText :: ErrorCode -> IO (String)
getErrorText a1 =
  let {a1' = enumToC a1} in 
  getErrorText'_ a1' >>= \res ->
  peekCString res >>= \res' ->
  return (res')
{-# LINE 362 "./Sound/PortAudio/Base.chs" #-}

-- |Retrieve the release number of the current PortAudio build.
getVersion :: Int
getVersion =
  let {res = getVersion'_} in
  let {res' = cIntConv res} in
  (res')
{-# LINE 366 "./Sound/PortAudio/Base.chs" #-}

-- |Retrieve the textual version of the current PortAudio build.
getVersionText :: IO (String)
getVersionText =
  getVersionText'_ >>= \res ->
  peekCString res >>= \res' ->
  return (res')
{-# LINE 370 "./Sound/PortAudio/Base.chs" #-}



{-
 - Foreign Functions
 -}
initialize_ffi :: IO (PaError)
initialize_ffi =
  initialize_ffi'_ >>= \res ->
  let {res' = cIntConv res} in
  return (res')
{-# LINE 378 "./Sound/PortAudio/Base.chs" #-}

terminate_ffi :: IO (PaError)
terminate_ffi =
  terminate_ffi'_ >>= \res ->
  let {res' = cIntConv res} in
  return (res')
{-# LINE 381 "./Sound/PortAudio/Base.chs" #-}

getHostApiCount_ffi :: IO (HostApiIndex)
getHostApiCount_ffi =
  getHostApiCount_ffi'_ >>= \res ->
  let {res' = cIntConv res} in
  return (res')
{-# LINE 384 "./Sound/PortAudio/Base.chs" #-}

getDefaultHostApi_ffi :: IO (HostApiIndex)
getDefaultHostApi_ffi =
  getDefaultHostApi_ffi'_ >>= \res ->
  let {res' = cIntConv res} in
  return (res')
{-# LINE 387 "./Sound/PortAudio/Base.chs" #-}

getHostApiInfo_ffi :: HostApiIndex -> IO (Maybe HostApiInfo)
getHostApiInfo_ffi a1 =
  let {a1' = cIntConv a1} in 
  getHostApiInfo_ffi'_ a1' >>= \res ->
  maybe_get_const_HostApiInfo res >>= \res' ->
  return (res')
{-# LINE 390 "./Sound/PortAudio/Base.chs" #-}

hostApiTypeIdToHostApiIndex_ffi :: HostApiTypeId -> IO (HostApiIndex)
hostApiTypeIdToHostApiIndex_ffi a1 =
  let {a1' = enumToC a1} in 
  hostApiTypeIdToHostApiIndex_ffi'_ a1' >>= \res ->
  let {res' = cIntConv res} in
  return (res')
{-# LINE 393 "./Sound/PortAudio/Base.chs" #-}

hostApiDeviceIndexToDeviceIndex_ffi :: HostApiIndex -> Int -> IO (DeviceIndex)
hostApiDeviceIndexToDeviceIndex_ffi a1 a2 =
  let {a1' = cIntConv a1} in 
  let {a2' = cIntConv a2} in 
  hostApiDeviceIndexToDeviceIndex_ffi'_ a1' a2' >>= \res ->
  let {res' = cIntConv res} in
  return (res')
{-# LINE 396 "./Sound/PortAudio/Base.chs" #-}

-- Since this is a last resort function, we're not going to export it (yet).
getLastHostErrorInfo_ffi :: IO (Maybe HostErrorInfo)
getLastHostErrorInfo_ffi =
  getLastHostErrorInfo_ffi'_ >>= \res ->
  maybe_get_const_HostErrorInfo res >>= \res' ->
  return (res')
{-# LINE 400 "./Sound/PortAudio/Base.chs" #-}

getDeviceCount_ffi :: IO (DeviceIndex)
getDeviceCount_ffi =
  getDeviceCount_ffi'_ >>= \res ->
  let {res' = cIntConv res} in
  return (res')
{-# LINE 403 "./Sound/PortAudio/Base.chs" #-}

getDefaultInputDevice_ffi :: IO (DeviceIndex)
getDefaultInputDevice_ffi =
  getDefaultInputDevice_ffi'_ >>= \res ->
  let {res' = cIntConv res} in
  return (res')
{-# LINE 406 "./Sound/PortAudio/Base.chs" #-}

getDefaultOutputDevice_ffi :: IO (DeviceIndex)
getDefaultOutputDevice_ffi =
  getDefaultOutputDevice_ffi'_ >>= \res ->
  let {res' = cIntConv res} in
  return (res')
{-# LINE 409 "./Sound/PortAudio/Base.chs" #-}

getDeviceInfo_ffi :: DeviceIndex -> IO (Maybe DeviceInfo)
getDeviceInfo_ffi a1 =
  let {a1' = cIntConv a1} in 
  getDeviceInfo_ffi'_ a1' >>= \res ->
  maybe_get_const_DeviceInfo res >>= \res' ->
  return (res')
{-# LINE 412 "./Sound/PortAudio/Base.chs" #-}

isFormatSupported_ffi :: Maybe StreamParameters -> Maybe StreamParameters -> Double -> IO (PaError)
isFormatSupported_ffi a1 a2 a3 =
  withPA a1 $ \a1' -> 
  withPA a2 $ \a2' -> 
  let {a3' = cFloatConv a3} in 
  isFormatSupported_ffi'_ a1' a2' a3' >>= \res ->
  let {res' = cToEnum res} in
  return (res')
{-# LINE 417 "./Sound/PortAudio/Base.chs" #-}

{- TODO: See what i did with castPtrToFunPtr? That's so wrong it hurts.
 - I applogize for how badly it must hurt you to read the next few lines. -}
openStream_ffi :: Maybe StreamParameters -> Maybe StreamParameters -> Double -> Int -> Int -> Ptr () -> Ptr () -> IO (PaError, PaStream a)
openStream_ffi a2 a3 a4 a5 a6 a7 a8 =
  alloca $ \a1' -> 
  withPA a2 $ \a2' -> 
  withPA a3 $ \a3' -> 
  let {a4' = cFloatConv a4} in 
  let {a5' = cIntConv a5} in 
  let {a6' = cIntConv a6} in 
  let {a7' = castPtrToFunPtr a7} in 
  let {a8' = id a8} in 
  openStream_ffi'_ a1' a2' a3' a4' a5' a6' a7' a8' >>= \res ->
  peekStream a1'>>= \a1'' -> 
  let {res' = cToEnum res} in
  return (res', a1'')
{-# LINE 430 "./Sound/PortAudio/Base.chs" #-}

openDefaultStream_ffi :: Int -> Int -> SampleFormat -> Double -> Int -> Ptr () -> Ptr () -> IO (PaError, PaStream a)
openDefaultStream_ffi a2 a3 a4 a5 a6 a7 a8 =
  alloca $ \a1' -> 
  let {a2' = cIntConv a2} in 
  let {a3' = cIntConv a3} in 
  let {a4' = enumToC a4} in 
  let {a5' = cFloatConv a5} in 
  let {a6' = cIntConv a6} in 
  let {a7' = castPtrToFunPtr a7} in 
  let {a8' = id a8} in 
  openDefaultStream_ffi'_ a1' a2' a3' a4' a5' a6' a7' a8' >>= \res ->
  peekStream a1'>>= \a1'' -> 
  let {res' = cToEnum res} in
  return (res', a1'')
{-# LINE 441 "./Sound/PortAudio/Base.chs" #-}
 
closeStream_ffi :: PaStream a -> IO (PaError)
closeStream_ffi a1 =
  let {a1' = unPaStream a1} in 
  closeStream_ffi'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')
{-# LINE 444 "./Sound/PortAudio/Base.chs" #-}

startStream_ffi :: PaStream a -> IO (PaError)
startStream_ffi a1 =
  let {a1' = unPaStream a1} in 
  startStream_ffi'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')
{-# LINE 447 "./Sound/PortAudio/Base.chs" #-}

stopStream_ffi :: PaStream a -> IO (PaError)
stopStream_ffi a1 =
  let {a1' = unPaStream a1} in 
  stopStream_ffi'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')
{-# LINE 450 "./Sound/PortAudio/Base.chs" #-}

abortStream_ffi :: PaStream a -> IO (PaError)
abortStream_ffi a1 =
  let {a1' = unPaStream a1} in 
  abortStream_ffi'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')
{-# LINE 453 "./Sound/PortAudio/Base.chs" #-}

isStreamStopped_ffi :: PaStream a -> IO (PaError)
isStreamStopped_ffi a1 =
  let {a1' = unPaStream a1} in 
  isStreamStopped_ffi'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')
{-# LINE 456 "./Sound/PortAudio/Base.chs" #-}

isStreamActive_ffi :: PaStream a -> IO (PaError)
isStreamActive_ffi a1 =
  let {a1' = unPaStream a1} in 
  isStreamActive_ffi'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')
{-# LINE 459 "./Sound/PortAudio/Base.chs" #-}

getStreamInfo_ffi :: PaStream a -> IO (Maybe StreamInfo)
getStreamInfo_ffi a1 =
  let {a1' = unPaStream a1} in 
  getStreamInfo_ffi'_ a1' >>= \res ->
  maybe_get_const_StreamInfo res >>= \res' ->
  return (res')
{-# LINE 462 "./Sound/PortAudio/Base.chs" #-}

getStreamTime_ffi :: PaStream a -> IO (PaTime)
getStreamTime_ffi a1 =
  let {a1' = unPaStream a1} in 
  getStreamTime_ffi'_ a1' >>= \res ->
  let {res' = cFloatConv res} in
  return (res')
{-# LINE 465 "./Sound/PortAudio/Base.chs" #-}

getStreamCpuLoad_ffi :: PaStream a -> IO (Double)
getStreamCpuLoad_ffi a1 =
  let {a1' = unPaStream a1} in 
  getStreamCpuLoad_ffi'_ a1' >>= \res ->
  let {res' = cFloatConv res} in
  return (res')
{-# LINE 468 "./Sound/PortAudio/Base.chs" #-}

readStream_ffi :: PaStream a -> PaStreamBuffer -> Int -> IO (PaError)
readStream_ffi a1 a2 a3 =
  let {a1' = unPaStream a1} in 
  let {a2' = id a2} in 
  let {a3' = cIntConv a3} in 
  readStream_ffi'_ a1' a2' a3' >>= \res ->
  let {res' = cToEnum res} in
  return (res')
{-# LINE 473 "./Sound/PortAudio/Base.chs" #-}

writeStream_ffi :: PaStream a -> PaStreamBuffer -> Int -> IO (PaError)
writeStream_ffi a1 a2 a3 =
  let {a1' = unPaStream a1} in 
  let {a2' = id a2} in 
  let {a3' = cIntConv a3} in 
  writeStream_ffi'_ a1' a2' a3' >>= \res ->
  let {res' = cToEnum res} in
  return (res')
{-# LINE 478 "./Sound/PortAudio/Base.chs" #-}

getStreamReadAvailable_ffi :: PaStream a -> IO (Int)
getStreamReadAvailable_ffi a1 =
  let {a1' = unPaStream a1} in 
  getStreamReadAvailable_ffi'_ a1' >>= \res ->
  let {res' = cIntConv res} in
  return (res')
{-# LINE 481 "./Sound/PortAudio/Base.chs" #-}

getStreamWriteAvailable_ffi :: PaStream a -> IO (Int)
getStreamWriteAvailable_ffi a1 =
  let {a1' = unPaStream a1} in 
  getStreamWriteAvailable_ffi'_ a1' >>= \res ->
  let {res' = cIntConv res} in
  return (res')
{-# LINE 484 "./Sound/PortAudio/Base.chs" #-}

getSampleSize_ffi :: SampleFormat -> IO (Int)
getSampleSize_ffi a1 =
  let {a1' = enumToC a1} in 
  getSampleSize_ffi'_ a1' >>= \res ->
  let {res' = cIntConv res} in
  return (res') 

paSleep_ffi :: Int -> IO ()
paSleep_ffi a1 =
  let {a1' = cIntConv a1} in 
  paSleep_ffi'_ a1' >>= \res ->
  return ()
{-# LINE 490 "./Sound/PortAudio/Base.chs" #-}


foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_GetErrorText"
  getErrorText'_ :: (CInt -> (IO (Ptr CChar)))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_GetVersion"
  getVersion'_ :: CInt

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_GetVersionText"
  getVersionText'_ :: (IO (Ptr CChar))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_Initialize"
  initialize_ffi'_ :: (IO CInt)

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_Terminate"
  terminate_ffi'_ :: (IO CInt)

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_GetHostApiCount"
  getHostApiCount_ffi'_ :: (IO CInt)

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_GetDefaultHostApi"
  getDefaultHostApi_ffi'_ :: (IO CInt)

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_GetHostApiInfo"
  getHostApiInfo_ffi'_ :: (CInt -> (IO (HostApiInfoPtr)))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_HostApiTypeIdToHostApiIndex"
  hostApiTypeIdToHostApiIndex_ffi'_ :: (CInt -> (IO CInt))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_HostApiDeviceIndexToDeviceIndex"
  hostApiDeviceIndexToDeviceIndex_ffi'_ :: (CInt -> (CInt -> (IO CInt)))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_GetLastHostErrorInfo"
  getLastHostErrorInfo_ffi'_ :: (IO (HostErrorInfoPtr))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_GetDeviceCount"
  getDeviceCount_ffi'_ :: (IO CInt)

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_GetDefaultInputDevice"
  getDefaultInputDevice_ffi'_ :: (IO CInt)

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_GetDefaultOutputDevice"
  getDefaultOutputDevice_ffi'_ :: (IO CInt)

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_GetDeviceInfo"
  getDeviceInfo_ffi'_ :: (CInt -> (IO (DeviceInfoPtr)))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_IsFormatSupported"
  isFormatSupported_ffi'_ :: ((StreamParametersPtr) -> ((StreamParametersPtr) -> (CDouble -> (IO CInt))))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_OpenStream"
  openStream_ffi'_ :: ((Ptr (Ptr ())) -> ((StreamParametersPtr) -> ((StreamParametersPtr) -> (CDouble -> (CULong -> (CULong -> ((FunPtr ((Ptr ()) -> ((Ptr ()) -> (CULong -> ((Ptr ()) -> (CULong -> ((Ptr ()) -> (IO CInt)))))))) -> ((Ptr ()) -> (IO CInt)))))))))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_OpenDefaultStream"
  openDefaultStream_ffi'_ :: ((Ptr (Ptr ())) -> (CInt -> (CInt -> (CULong -> (CDouble -> (CULong -> ((FunPtr ((Ptr ()) -> ((Ptr ()) -> (CULong -> ((Ptr ()) -> (CULong -> ((Ptr ()) -> (IO CInt)))))))) -> ((Ptr ()) -> (IO CInt)))))))))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_CloseStream"
  closeStream_ffi'_ :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_StartStream"
  startStream_ffi'_ :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_StopStream"
  stopStream_ffi'_ :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_AbortStream"
  abortStream_ffi'_ :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_IsStreamStopped"
  isStreamStopped_ffi'_ :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_IsStreamActive"
  isStreamActive_ffi'_ :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_GetStreamInfo"
  getStreamInfo_ffi'_ :: ((Ptr ()) -> (IO (StreamInfoPtr)))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_GetStreamTime"
  getStreamTime_ffi'_ :: ((Ptr ()) -> (IO CDouble))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_GetStreamCpuLoad"
  getStreamCpuLoad_ffi'_ :: ((Ptr ()) -> (IO CDouble))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_ReadStream"
  readStream_ffi'_ :: ((Ptr ()) -> ((Ptr ()) -> (CULong -> (IO CInt))))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_WriteStream"
  writeStream_ffi'_ :: ((Ptr ()) -> ((Ptr ()) -> (CULong -> (IO CInt))))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_GetStreamReadAvailable"
  getStreamReadAvailable_ffi'_ :: ((Ptr ()) -> (IO CLong))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_GetStreamWriteAvailable"
  getStreamWriteAvailable_ffi'_ :: ((Ptr ()) -> (IO CLong))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_GetSampleSize"
  getSampleSize_ffi'_ :: (CULong -> (IO CInt))

foreign import ccall safe "Sound/PortAudio/Base.chs.h Pa_Sleep"
  paSleep_ffi'_ :: (CLong -> (IO ()))