{-# LINE 1 "src/Sound/Pulse/Def.hsc" #-}
{-# OPTIONS -fno-warn-overlapping-patterns #-}
{-# LINE 2 "src/Sound/Pulse/Def.hsc" #-}
{-# OPTIONS_HADDOCK hide #-}
module Sound.Pulse.Def
where


{-# LINE 7 "src/Sound/Pulse/Def.hsc" #-}

{-# LINE 8 "src/Sound/Pulse/Def.hsc" #-}

{-# LINE 9 "src/Sound/Pulse/Def.hsc" #-}
import Data.Bits (Bits(..))
import Foreign.C.Types (CInt)

foldFlag :: (a -> CInt) -> [a] -> CInt
foldFlag fun = foldr ((.|.) . fun) 0

data SubscriptionEventFacility
    = SubscriptionEventSink
    | SubscriptionEventSource
    | SubscriptionEventSinkInput
    | SubscriptionEventSourceOutput
    | SubscriptionEventModule
    | SubscriptionEventClient
    | SubscriptionEventSampleCache
    | SubscriptionEventServer
    | SubscriptionEventAutoload
    | SubscriptionEventCard
    | SubscriptionEventFacilityMask
    deriving (Eq, Show)

subscriptionEventFacilityToInt :: SubscriptionEventFacility -> CInt
subscriptionEventFacilityToInt SubscriptionEventSink = 0
{-# LINE 31 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventFacilityToInt SubscriptionEventSource = 1
{-# LINE 32 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventFacilityToInt SubscriptionEventSinkInput = 2
{-# LINE 33 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventFacilityToInt SubscriptionEventSourceOutput = 3
{-# LINE 34 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventFacilityToInt SubscriptionEventModule = 4
{-# LINE 35 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventFacilityToInt SubscriptionEventClient = 5
{-# LINE 36 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventFacilityToInt SubscriptionEventSampleCache = 6
{-# LINE 37 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventFacilityToInt SubscriptionEventServer = 7
{-# LINE 38 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventFacilityToInt SubscriptionEventAutoload = 8
{-# LINE 39 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventFacilityToInt SubscriptionEventCard = 9
{-# LINE 40 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventFacilityToInt SubscriptionEventFacilityMask = 15
{-# LINE 41 "src/Sound/Pulse/Def.hsc" #-}

subscriptionEventFacilityFromInt :: CInt -> SubscriptionEventFacility
subscriptionEventFacilityFromInt (0) = SubscriptionEventSink
{-# LINE 44 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventFacilityFromInt (1) = SubscriptionEventSource
{-# LINE 45 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventFacilityFromInt (2) = SubscriptionEventSinkInput
{-# LINE 46 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventFacilityFromInt (3) = SubscriptionEventSourceOutput
{-# LINE 47 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventFacilityFromInt (4) = SubscriptionEventModule
{-# LINE 48 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventFacilityFromInt (5) = SubscriptionEventClient
{-# LINE 49 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventFacilityFromInt (6) = SubscriptionEventSampleCache
{-# LINE 50 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventFacilityFromInt (7) = SubscriptionEventServer
{-# LINE 51 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventFacilityFromInt (8) = SubscriptionEventAutoload
{-# LINE 52 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventFacilityFromInt (9) = SubscriptionEventCard
{-# LINE 53 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventFacilityFromInt (15) = SubscriptionEventFacilityMask
{-# LINE 54 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventFacilityFromInt x = error ("PA unexped value @subscriptionEventFacilityFromInt:" ++ show x)
data SubscriptionEventType
    = SubscriptionEventNew
    | SubscriptionEventChange
    | SubscriptionEventRemove
    | SubscriptionEventTypeMask
    deriving (Eq, Show)

subscriptionEventTypeToInt :: SubscriptionEventType -> CInt
subscriptionEventTypeToInt SubscriptionEventNew = 0
{-# LINE 64 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventTypeToInt SubscriptionEventChange = 16
{-# LINE 65 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventTypeToInt SubscriptionEventRemove = 32
{-# LINE 66 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventTypeToInt SubscriptionEventTypeMask = 48
{-# LINE 67 "src/Sound/Pulse/Def.hsc" #-}

subscriptionEventTypeFromInt :: CInt -> SubscriptionEventType
subscriptionEventTypeFromInt (0) = SubscriptionEventNew
{-# LINE 70 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventTypeFromInt (16) = SubscriptionEventChange
{-# LINE 71 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventTypeFromInt (32) = SubscriptionEventRemove
{-# LINE 72 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventTypeFromInt (48) = SubscriptionEventTypeMask
{-# LINE 73 "src/Sound/Pulse/Def.hsc" #-}
subscriptionEventTypeFromInt x = error ("PA unexped value @subscriptionEventTypeFromInt:" ++ show x)
data ContextState
    = ContextUnconnected
    | ContextConnecting
    | ContextAuthorizing
    | ContextSettingName
    | ContextReady
    | ContextFailed
    | ContextTerminated
    deriving (Eq, Show)

contextStateToInt :: ContextState -> CInt
contextStateToInt ContextUnconnected = 0
{-# LINE 86 "src/Sound/Pulse/Def.hsc" #-}
contextStateToInt ContextConnecting = 1
{-# LINE 87 "src/Sound/Pulse/Def.hsc" #-}
contextStateToInt ContextAuthorizing = 2
{-# LINE 88 "src/Sound/Pulse/Def.hsc" #-}
contextStateToInt ContextSettingName = 3
{-# LINE 89 "src/Sound/Pulse/Def.hsc" #-}
contextStateToInt ContextReady = 4
{-# LINE 90 "src/Sound/Pulse/Def.hsc" #-}
contextStateToInt ContextFailed = 5
{-# LINE 91 "src/Sound/Pulse/Def.hsc" #-}
contextStateToInt ContextTerminated = 6
{-# LINE 92 "src/Sound/Pulse/Def.hsc" #-}

contextStateFromInt :: CInt -> ContextState
contextStateFromInt (0) = ContextUnconnected
{-# LINE 95 "src/Sound/Pulse/Def.hsc" #-}
contextStateFromInt (1) = ContextConnecting
{-# LINE 96 "src/Sound/Pulse/Def.hsc" #-}
contextStateFromInt (2) = ContextAuthorizing
{-# LINE 97 "src/Sound/Pulse/Def.hsc" #-}
contextStateFromInt (3) = ContextSettingName
{-# LINE 98 "src/Sound/Pulse/Def.hsc" #-}
contextStateFromInt (4) = ContextReady
{-# LINE 99 "src/Sound/Pulse/Def.hsc" #-}
contextStateFromInt (5) = ContextFailed
{-# LINE 100 "src/Sound/Pulse/Def.hsc" #-}
contextStateFromInt (6) = ContextTerminated
{-# LINE 101 "src/Sound/Pulse/Def.hsc" #-}
contextStateFromInt x = error ("PA unexped value @contextStateFromInt:" ++ show x)
data StreamState
    = StreamUnconnected
    | StreamCreating
    | StreamReady
    | StreamFailed
    | StreamTerminated
    deriving (Eq, Show)

streamStateToInt :: StreamState -> CInt
streamStateToInt StreamUnconnected = 0
{-# LINE 112 "src/Sound/Pulse/Def.hsc" #-}
streamStateToInt StreamCreating = 1
{-# LINE 113 "src/Sound/Pulse/Def.hsc" #-}
streamStateToInt StreamReady = 2
{-# LINE 114 "src/Sound/Pulse/Def.hsc" #-}
streamStateToInt StreamFailed = 3
{-# LINE 115 "src/Sound/Pulse/Def.hsc" #-}
streamStateToInt StreamTerminated = 4
{-# LINE 116 "src/Sound/Pulse/Def.hsc" #-}

streamStateFromInt :: CInt -> StreamState
streamStateFromInt (0) = StreamUnconnected
{-# LINE 119 "src/Sound/Pulse/Def.hsc" #-}
streamStateFromInt (1) = StreamCreating
{-# LINE 120 "src/Sound/Pulse/Def.hsc" #-}
streamStateFromInt (2) = StreamReady
{-# LINE 121 "src/Sound/Pulse/Def.hsc" #-}
streamStateFromInt (3) = StreamFailed
{-# LINE 122 "src/Sound/Pulse/Def.hsc" #-}
streamStateFromInt (4) = StreamTerminated
{-# LINE 123 "src/Sound/Pulse/Def.hsc" #-}
streamStateFromInt x = error ("PA unexped value @streamStateFromInt:" ++ show x)
data OperationState
    = OperationRunning
    | OperationDone
    | OperationCancelled
    deriving (Eq, Show)

operationStateToInt :: OperationState -> CInt
operationStateToInt OperationRunning = 0
{-# LINE 132 "src/Sound/Pulse/Def.hsc" #-}
operationStateToInt OperationDone = 1
{-# LINE 133 "src/Sound/Pulse/Def.hsc" #-}
operationStateToInt OperationCancelled = 2
{-# LINE 134 "src/Sound/Pulse/Def.hsc" #-}

operationStateFromInt :: CInt -> OperationState
operationStateFromInt (0) = OperationRunning
{-# LINE 137 "src/Sound/Pulse/Def.hsc" #-}
operationStateFromInt (1) = OperationDone
{-# LINE 138 "src/Sound/Pulse/Def.hsc" #-}
operationStateFromInt (2) = OperationCancelled
{-# LINE 139 "src/Sound/Pulse/Def.hsc" #-}
operationStateFromInt x = error ("PA unexped value @operationStateFromInt:" ++ show x)
data Direction
    = DirectionOutput
    | DirectionInput
    deriving (Eq, Show)

directionToInt :: Direction -> CInt
directionToInt DirectionOutput = 1
{-# LINE 147 "src/Sound/Pulse/Def.hsc" #-}
directionToInt DirectionInput = 2
{-# LINE 148 "src/Sound/Pulse/Def.hsc" #-}

directionFromInt :: CInt -> Direction
directionFromInt (1) = DirectionOutput
{-# LINE 151 "src/Sound/Pulse/Def.hsc" #-}
directionFromInt (2) = DirectionInput
{-# LINE 152 "src/Sound/Pulse/Def.hsc" #-}
directionFromInt x = error ("PA unexped value @directionFromInt:" ++ show x)
data ErrorCode
    = Ok
    | ErrAccess
    | ErrCommand
    | ErrInvalid
    | ErrExist
    | ErrNoentity
    | ErrConnectionrefused
    | ErrProtocol
    | ErrTimeout
    | ErrAuthkey
    | ErrInternal
    | ErrConnectionterminated
    | ErrKilled
    | ErrInvalidserver
    | ErrModinitfailed
    | ErrBadstate
    | ErrNodata
    | ErrVersion
    | ErrToolarge
    | ErrNotsupported
    | ErrUnknown
    | ErrNoextension
    | ErrObsolete
    | ErrNotimplemented
    | ErrForked
    | ErrIo
    | ErrBusy
    | ErrMax
    deriving (Eq, Show)

errorCodeToInt :: ErrorCode -> CInt
errorCodeToInt Ok = 0
{-# LINE 186 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrAccess = 1
{-# LINE 187 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrCommand = 2
{-# LINE 188 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrInvalid = 3
{-# LINE 189 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrExist = 4
{-# LINE 190 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrNoentity = 5
{-# LINE 191 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrConnectionrefused = 6
{-# LINE 192 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrProtocol = 7
{-# LINE 193 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrTimeout = 8
{-# LINE 194 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrAuthkey = 9
{-# LINE 195 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrInternal = 10
{-# LINE 196 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrConnectionterminated = 11
{-# LINE 197 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrKilled = 12
{-# LINE 198 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrInvalidserver = 13
{-# LINE 199 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrModinitfailed = 14
{-# LINE 200 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrBadstate = 15
{-# LINE 201 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrNodata = 16
{-# LINE 202 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrVersion = 17
{-# LINE 203 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrToolarge = 18
{-# LINE 204 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrNotsupported = 19
{-# LINE 205 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrUnknown = 20
{-# LINE 206 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrNoextension = 21
{-# LINE 207 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrObsolete = 22
{-# LINE 208 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrNotimplemented = 23
{-# LINE 209 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrForked = 24
{-# LINE 210 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrIo = 25
{-# LINE 211 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrBusy = 26
{-# LINE 212 "src/Sound/Pulse/Def.hsc" #-}
errorCodeToInt ErrMax = 27
{-# LINE 213 "src/Sound/Pulse/Def.hsc" #-}

errorCodeFromInt :: CInt -> ErrorCode
errorCodeFromInt (0) = Ok
{-# LINE 216 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (1) = ErrAccess
{-# LINE 217 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (2) = ErrCommand
{-# LINE 218 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (3) = ErrInvalid
{-# LINE 219 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (4) = ErrExist
{-# LINE 220 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (5) = ErrNoentity
{-# LINE 221 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (6) = ErrConnectionrefused
{-# LINE 222 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (7) = ErrProtocol
{-# LINE 223 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (8) = ErrTimeout
{-# LINE 224 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (9) = ErrAuthkey
{-# LINE 225 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (10) = ErrInternal
{-# LINE 226 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (11) = ErrConnectionterminated
{-# LINE 227 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (12) = ErrKilled
{-# LINE 228 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (13) = ErrInvalidserver
{-# LINE 229 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (14) = ErrModinitfailed
{-# LINE 230 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (15) = ErrBadstate
{-# LINE 231 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (16) = ErrNodata
{-# LINE 232 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (17) = ErrVersion
{-# LINE 233 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (18) = ErrToolarge
{-# LINE 234 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (19) = ErrNotsupported
{-# LINE 235 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (20) = ErrUnknown
{-# LINE 236 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (21) = ErrNoextension
{-# LINE 237 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (22) = ErrObsolete
{-# LINE 238 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (23) = ErrNotimplemented
{-# LINE 239 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (24) = ErrForked
{-# LINE 240 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (25) = ErrIo
{-# LINE 241 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (26) = ErrBusy
{-# LINE 242 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt (27) = ErrMax
{-# LINE 243 "src/Sound/Pulse/Def.hsc" #-}
errorCodeFromInt x = error ("PA unexped value @errorCodeFromInt:" ++ show x)
data SeekMode
    = SeekRelative
    | SeekAbsolute
    | SeekRelativeOnRead
    | SeekRelativeEnd
    deriving (Eq, Show)

seekModeToInt :: SeekMode -> CInt
seekModeToInt SeekRelative = 0
{-# LINE 253 "src/Sound/Pulse/Def.hsc" #-}
seekModeToInt SeekAbsolute = 1
{-# LINE 254 "src/Sound/Pulse/Def.hsc" #-}
seekModeToInt SeekRelativeOnRead = 2
{-# LINE 255 "src/Sound/Pulse/Def.hsc" #-}
seekModeToInt SeekRelativeEnd = 3
{-# LINE 256 "src/Sound/Pulse/Def.hsc" #-}

seekModeFromInt :: CInt -> SeekMode
seekModeFromInt (0) = SeekRelative
{-# LINE 259 "src/Sound/Pulse/Def.hsc" #-}
seekModeFromInt (1) = SeekAbsolute
{-# LINE 260 "src/Sound/Pulse/Def.hsc" #-}
seekModeFromInt (2) = SeekRelativeOnRead
{-# LINE 261 "src/Sound/Pulse/Def.hsc" #-}
seekModeFromInt (3) = SeekRelativeEnd
{-# LINE 262 "src/Sound/Pulse/Def.hsc" #-}
seekModeFromInt x = error ("PA unexped value @seekModeFromInt:" ++ show x)
data SinkState
    = SinkInvalidState
    | SinkRunning
    | SinkIdle
    | SinkSuspended
    | SinkInit
    | SinkUnlinked
    deriving (Eq, Show)

sinkStateToInt :: SinkState -> CInt
sinkStateToInt SinkInvalidState = -1
{-# LINE 274 "src/Sound/Pulse/Def.hsc" #-}
sinkStateToInt SinkRunning = 0
{-# LINE 275 "src/Sound/Pulse/Def.hsc" #-}
sinkStateToInt SinkIdle = 1
{-# LINE 276 "src/Sound/Pulse/Def.hsc" #-}
sinkStateToInt SinkSuspended = 2
{-# LINE 277 "src/Sound/Pulse/Def.hsc" #-}
sinkStateToInt SinkInit = -2
{-# LINE 278 "src/Sound/Pulse/Def.hsc" #-}
sinkStateToInt SinkUnlinked = -3
{-# LINE 279 "src/Sound/Pulse/Def.hsc" #-}

sinkStateFromInt :: CInt -> SinkState
sinkStateFromInt (-1) = SinkInvalidState
{-# LINE 282 "src/Sound/Pulse/Def.hsc" #-}
sinkStateFromInt (0) = SinkRunning
{-# LINE 283 "src/Sound/Pulse/Def.hsc" #-}
sinkStateFromInt (1) = SinkIdle
{-# LINE 284 "src/Sound/Pulse/Def.hsc" #-}
sinkStateFromInt (2) = SinkSuspended
{-# LINE 285 "src/Sound/Pulse/Def.hsc" #-}
sinkStateFromInt (-2) = SinkInit
{-# LINE 286 "src/Sound/Pulse/Def.hsc" #-}
sinkStateFromInt (-3) = SinkUnlinked
{-# LINE 287 "src/Sound/Pulse/Def.hsc" #-}
sinkStateFromInt x = error ("PA unexped value @sinkStateFromInt:" ++ show x)
data SourceState
    = SourceInvalidState
    | SourceRunning
    | SourceIdle
    | SourceSuspended
    | SourceInit
    | SourceUnlinked
    deriving (Eq, Show)

sourceStateToInt :: SourceState -> CInt
sourceStateToInt SourceInvalidState = -1
{-# LINE 299 "src/Sound/Pulse/Def.hsc" #-}
sourceStateToInt SourceRunning = 0
{-# LINE 300 "src/Sound/Pulse/Def.hsc" #-}
sourceStateToInt SourceIdle = 1
{-# LINE 301 "src/Sound/Pulse/Def.hsc" #-}
sourceStateToInt SourceSuspended = 2
{-# LINE 302 "src/Sound/Pulse/Def.hsc" #-}
sourceStateToInt SourceInit = -2
{-# LINE 303 "src/Sound/Pulse/Def.hsc" #-}
sourceStateToInt SourceUnlinked = -3
{-# LINE 304 "src/Sound/Pulse/Def.hsc" #-}

sourceStateFromInt :: CInt -> SourceState
sourceStateFromInt (-1) = SourceInvalidState
{-# LINE 307 "src/Sound/Pulse/Def.hsc" #-}
sourceStateFromInt (0) = SourceRunning
{-# LINE 308 "src/Sound/Pulse/Def.hsc" #-}
sourceStateFromInt (1) = SourceIdle
{-# LINE 309 "src/Sound/Pulse/Def.hsc" #-}
sourceStateFromInt (2) = SourceSuspended
{-# LINE 310 "src/Sound/Pulse/Def.hsc" #-}
sourceStateFromInt (-2) = SourceInit
{-# LINE 311 "src/Sound/Pulse/Def.hsc" #-}
sourceStateFromInt (-3) = SourceUnlinked
{-# LINE 312 "src/Sound/Pulse/Def.hsc" #-}
sourceStateFromInt x = error ("PA unexped value @sourceStateFromInt:" ++ show x)
data PortAvailable
    = PortAvailableUnknown
    | PortAvailableNo
    | PortAvailableYes
    deriving (Eq, Show)

portAvailableToInt :: PortAvailable -> CInt
portAvailableToInt PortAvailableUnknown = 0
{-# LINE 321 "src/Sound/Pulse/Def.hsc" #-}
portAvailableToInt PortAvailableNo = 1
{-# LINE 322 "src/Sound/Pulse/Def.hsc" #-}
portAvailableToInt PortAvailableYes = 2
{-# LINE 323 "src/Sound/Pulse/Def.hsc" #-}

portAvailableFromInt :: CInt -> PortAvailable
portAvailableFromInt (0) = PortAvailableUnknown
{-# LINE 326 "src/Sound/Pulse/Def.hsc" #-}
portAvailableFromInt (1) = PortAvailableNo
{-# LINE 327 "src/Sound/Pulse/Def.hsc" #-}
portAvailableFromInt (2) = PortAvailableYes
{-# LINE 328 "src/Sound/Pulse/Def.hsc" #-}
portAvailableFromInt x = error ("PA unexped value @portAvailableFromInt:" ++ show x)
data ChannelPosition
    = ChannelPositionInvalid
    | ChannelPositionMono
    | ChannelPositionFrontLeft
    | ChannelPositionFrontRight
    | ChannelPositionFrontCenter
    | ChannelPositionLeft
    | ChannelPositionRight
    | ChannelPositionCenter
    | ChannelPositionRearCenter
    | ChannelPositionRearLeft
    | ChannelPositionRearRight
    | ChannelPositionLfe
    | ChannelPositionSubwoofer
    | ChannelPositionFrontLeftOfCenter
    | ChannelPositionFrontRightOfCenter
    | ChannelPositionSideLeft
    | ChannelPositionSideRight
    | ChannelPositionAux0
    | ChannelPositionAux1
    | ChannelPositionAux2
    | ChannelPositionAux3
    | ChannelPositionAux4
    | ChannelPositionAux5
    | ChannelPositionAux6
    | ChannelPositionAux7
    | ChannelPositionAux8
    | ChannelPositionAux9
    | ChannelPositionAux10
    | ChannelPositionAux11
    | ChannelPositionAux12
    | ChannelPositionAux13
    | ChannelPositionAux14
    | ChannelPositionAux15
    | ChannelPositionAux16
    | ChannelPositionAux17
    | ChannelPositionAux18
    | ChannelPositionAux19
    | ChannelPositionAux20
    | ChannelPositionAux21
    | ChannelPositionAux22
    | ChannelPositionAux23
    | ChannelPositionAux24
    | ChannelPositionAux25
    | ChannelPositionAux26
    | ChannelPositionAux27
    | ChannelPositionAux28
    | ChannelPositionAux29
    | ChannelPositionAux30
    | ChannelPositionAux31
    | ChannelPositionTopCenter
    | ChannelPositionTopFrontLeft
    | ChannelPositionTopFrontRight
    | ChannelPositionTopFrontCenter
    | ChannelPositionTopRearLeft
    | ChannelPositionTopRearRight
    | ChannelPositionTopRearCenter
    | ChannelPositionMax
    deriving (Eq, Show)

channelPositionToInt :: ChannelPosition -> CInt
channelPositionToInt ChannelPositionInvalid = -1
{-# LINE 391 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionMono = 0
{-# LINE 392 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionFrontLeft = 1
{-# LINE 393 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionFrontRight = 2
{-# LINE 394 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionFrontCenter = 3
{-# LINE 395 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionLeft = 1
{-# LINE 396 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionRight = 2
{-# LINE 397 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionCenter = 3
{-# LINE 398 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionRearCenter = 4
{-# LINE 399 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionRearLeft = 5
{-# LINE 400 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionRearRight = 6
{-# LINE 401 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionLfe = 7
{-# LINE 402 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionSubwoofer = 7
{-# LINE 403 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionFrontLeftOfCenter = 8
{-# LINE 404 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionFrontRightOfCenter = 9
{-# LINE 405 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionSideLeft = 10
{-# LINE 406 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionSideRight = 11
{-# LINE 407 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux0 = 12
{-# LINE 408 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux1 = 13
{-# LINE 409 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux2 = 14
{-# LINE 410 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux3 = 15
{-# LINE 411 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux4 = 16
{-# LINE 412 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux5 = 17
{-# LINE 413 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux6 = 18
{-# LINE 414 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux7 = 19
{-# LINE 415 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux8 = 20
{-# LINE 416 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux9 = 21
{-# LINE 417 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux10 = 22
{-# LINE 418 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux11 = 23
{-# LINE 419 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux12 = 24
{-# LINE 420 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux13 = 25
{-# LINE 421 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux14 = 26
{-# LINE 422 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux15 = 27
{-# LINE 423 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux16 = 28
{-# LINE 424 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux17 = 29
{-# LINE 425 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux18 = 30
{-# LINE 426 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux19 = 31
{-# LINE 427 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux20 = 32
{-# LINE 428 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux21 = 33
{-# LINE 429 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux22 = 34
{-# LINE 430 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux23 = 35
{-# LINE 431 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux24 = 36
{-# LINE 432 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux25 = 37
{-# LINE 433 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux26 = 38
{-# LINE 434 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux27 = 39
{-# LINE 435 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux28 = 40
{-# LINE 436 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux29 = 41
{-# LINE 437 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux30 = 42
{-# LINE 438 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionAux31 = 43
{-# LINE 439 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionTopCenter = 44
{-# LINE 440 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionTopFrontLeft = 45
{-# LINE 441 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionTopFrontRight = 46
{-# LINE 442 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionTopFrontCenter = 47
{-# LINE 443 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionTopRearLeft = 48
{-# LINE 444 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionTopRearRight = 49
{-# LINE 445 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionTopRearCenter = 50
{-# LINE 446 "src/Sound/Pulse/Def.hsc" #-}
channelPositionToInt ChannelPositionMax = 51
{-# LINE 447 "src/Sound/Pulse/Def.hsc" #-}

channelPositionFromInt :: CInt -> ChannelPosition
channelPositionFromInt (-1) = ChannelPositionInvalid
{-# LINE 450 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (0) = ChannelPositionMono
{-# LINE 451 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (1) = ChannelPositionFrontLeft
{-# LINE 452 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (2) = ChannelPositionFrontRight
{-# LINE 453 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (3) = ChannelPositionFrontCenter
{-# LINE 454 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (1) = ChannelPositionLeft
{-# LINE 455 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (2) = ChannelPositionRight
{-# LINE 456 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (3) = ChannelPositionCenter
{-# LINE 457 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (4) = ChannelPositionRearCenter
{-# LINE 458 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (5) = ChannelPositionRearLeft
{-# LINE 459 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (6) = ChannelPositionRearRight
{-# LINE 460 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (7) = ChannelPositionLfe
{-# LINE 461 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (7) = ChannelPositionSubwoofer
{-# LINE 462 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (8) = ChannelPositionFrontLeftOfCenter
{-# LINE 463 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (9) = ChannelPositionFrontRightOfCenter
{-# LINE 464 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (10) = ChannelPositionSideLeft
{-# LINE 465 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (11) = ChannelPositionSideRight
{-# LINE 466 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (12) = ChannelPositionAux0
{-# LINE 467 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (13) = ChannelPositionAux1
{-# LINE 468 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (14) = ChannelPositionAux2
{-# LINE 469 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (15) = ChannelPositionAux3
{-# LINE 470 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (16) = ChannelPositionAux4
{-# LINE 471 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (17) = ChannelPositionAux5
{-# LINE 472 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (18) = ChannelPositionAux6
{-# LINE 473 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (19) = ChannelPositionAux7
{-# LINE 474 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (20) = ChannelPositionAux8
{-# LINE 475 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (21) = ChannelPositionAux9
{-# LINE 476 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (22) = ChannelPositionAux10
{-# LINE 477 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (23) = ChannelPositionAux11
{-# LINE 478 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (24) = ChannelPositionAux12
{-# LINE 479 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (25) = ChannelPositionAux13
{-# LINE 480 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (26) = ChannelPositionAux14
{-# LINE 481 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (27) = ChannelPositionAux15
{-# LINE 482 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (28) = ChannelPositionAux16
{-# LINE 483 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (29) = ChannelPositionAux17
{-# LINE 484 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (30) = ChannelPositionAux18
{-# LINE 485 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (31) = ChannelPositionAux19
{-# LINE 486 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (32) = ChannelPositionAux20
{-# LINE 487 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (33) = ChannelPositionAux21
{-# LINE 488 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (34) = ChannelPositionAux22
{-# LINE 489 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (35) = ChannelPositionAux23
{-# LINE 490 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (36) = ChannelPositionAux24
{-# LINE 491 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (37) = ChannelPositionAux25
{-# LINE 492 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (38) = ChannelPositionAux26
{-# LINE 493 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (39) = ChannelPositionAux27
{-# LINE 494 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (40) = ChannelPositionAux28
{-# LINE 495 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (41) = ChannelPositionAux29
{-# LINE 496 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (42) = ChannelPositionAux30
{-# LINE 497 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (43) = ChannelPositionAux31
{-# LINE 498 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (44) = ChannelPositionTopCenter
{-# LINE 499 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (45) = ChannelPositionTopFrontLeft
{-# LINE 500 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (46) = ChannelPositionTopFrontRight
{-# LINE 501 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (47) = ChannelPositionTopFrontCenter
{-# LINE 502 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (48) = ChannelPositionTopRearLeft
{-# LINE 503 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (49) = ChannelPositionTopRearRight
{-# LINE 504 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (50) = ChannelPositionTopRearCenter
{-# LINE 505 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt (51) = ChannelPositionMax
{-# LINE 506 "src/Sound/Pulse/Def.hsc" #-}
channelPositionFromInt x = error ("PA unexped value @channelPositionFromInt:" ++ show x)
data ChannelMapDef
    = ChannelMapAiff
    | ChannelMapAlsa
    | ChannelMapAux
    | ChannelMapWaveex
    | ChannelMapOss
    | ChannelMapDefMax
    | ChannelMapDefault
    deriving (Eq, Show)

channelMapDefToInt :: ChannelMapDef -> CInt
channelMapDefToInt ChannelMapAiff = 0
{-# LINE 519 "src/Sound/Pulse/Def.hsc" #-}
channelMapDefToInt ChannelMapAlsa = 1
{-# LINE 520 "src/Sound/Pulse/Def.hsc" #-}
channelMapDefToInt ChannelMapAux = 2
{-# LINE 521 "src/Sound/Pulse/Def.hsc" #-}
channelMapDefToInt ChannelMapWaveex = 3
{-# LINE 522 "src/Sound/Pulse/Def.hsc" #-}
channelMapDefToInt ChannelMapOss = 4
{-# LINE 523 "src/Sound/Pulse/Def.hsc" #-}
channelMapDefToInt ChannelMapDefMax = 5
{-# LINE 524 "src/Sound/Pulse/Def.hsc" #-}
channelMapDefToInt ChannelMapDefault = 0
{-# LINE 525 "src/Sound/Pulse/Def.hsc" #-}

channelMapDefFromInt :: CInt -> ChannelMapDef
channelMapDefFromInt (0) = ChannelMapAiff
{-# LINE 528 "src/Sound/Pulse/Def.hsc" #-}
channelMapDefFromInt (1) = ChannelMapAlsa
{-# LINE 529 "src/Sound/Pulse/Def.hsc" #-}
channelMapDefFromInt (2) = ChannelMapAux
{-# LINE 530 "src/Sound/Pulse/Def.hsc" #-}
channelMapDefFromInt (3) = ChannelMapWaveex
{-# LINE 531 "src/Sound/Pulse/Def.hsc" #-}
channelMapDefFromInt (4) = ChannelMapOss
{-# LINE 532 "src/Sound/Pulse/Def.hsc" #-}
channelMapDefFromInt (5) = ChannelMapDefMax
{-# LINE 533 "src/Sound/Pulse/Def.hsc" #-}
channelMapDefFromInt (0) = ChannelMapDefault
{-# LINE 534 "src/Sound/Pulse/Def.hsc" #-}
channelMapDefFromInt x = error ("PA unexped value @channelMapDefFromInt:" ++ show x)
data SampleFormat
    = SampleU8
    | SampleAlaw
    | SampleUlaw
    | SampleS16le
    | SampleS16be
    | SampleFloat32le
    | SampleFloat32be
    | SampleS32le
    | SampleS32be
    | SampleS24le
    | SampleS24be
    | SampleS2432le
    | SampleS2432be
    | SampleMax
    | SampleInvalid
    deriving (Eq, Show)

sampleFormatToInt :: SampleFormat -> CInt
sampleFormatToInt SampleU8 = 0
{-# LINE 555 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatToInt SampleAlaw = 1
{-# LINE 556 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatToInt SampleUlaw = 2
{-# LINE 557 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatToInt SampleS16le = 3
{-# LINE 558 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatToInt SampleS16be = 4
{-# LINE 559 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatToInt SampleFloat32le = 5
{-# LINE 560 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatToInt SampleFloat32be = 6
{-# LINE 561 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatToInt SampleS32le = 7
{-# LINE 562 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatToInt SampleS32be = 8
{-# LINE 563 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatToInt SampleS24le = 9
{-# LINE 564 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatToInt SampleS24be = 10
{-# LINE 565 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatToInt SampleS2432le = 11
{-# LINE 566 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatToInt SampleS2432be = 12
{-# LINE 567 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatToInt SampleMax = 13
{-# LINE 568 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatToInt SampleInvalid = -1
{-# LINE 569 "src/Sound/Pulse/Def.hsc" #-}

sampleFormatFromInt :: CInt -> SampleFormat
sampleFormatFromInt (0) = SampleU8
{-# LINE 572 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatFromInt (1) = SampleAlaw
{-# LINE 573 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatFromInt (2) = SampleUlaw
{-# LINE 574 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatFromInt (3) = SampleS16le
{-# LINE 575 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatFromInt (4) = SampleS16be
{-# LINE 576 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatFromInt (5) = SampleFloat32le
{-# LINE 577 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatFromInt (6) = SampleFloat32be
{-# LINE 578 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatFromInt (7) = SampleS32le
{-# LINE 579 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatFromInt (8) = SampleS32be
{-# LINE 580 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatFromInt (9) = SampleS24le
{-# LINE 581 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatFromInt (10) = SampleS24be
{-# LINE 582 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatFromInt (11) = SampleS2432le
{-# LINE 583 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatFromInt (12) = SampleS2432be
{-# LINE 584 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatFromInt (13) = SampleMax
{-# LINE 585 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatFromInt (-1) = SampleInvalid
{-# LINE 586 "src/Sound/Pulse/Def.hsc" #-}
sampleFormatFromInt x = error ("PA unexped value @sampleFormatFromInt:" ++ show x)
data ContextFlags
    = ContextNoflags
    | ContextNoautospawn
    | ContextNofail
    deriving (Eq, Show)

contextFlagsToInt :: ContextFlags -> CInt
contextFlagsToInt ContextNoflags = 0
{-# LINE 595 "src/Sound/Pulse/Def.hsc" #-}
contextFlagsToInt ContextNoautospawn = 1
{-# LINE 596 "src/Sound/Pulse/Def.hsc" #-}
contextFlagsToInt ContextNofail = 2
{-# LINE 597 "src/Sound/Pulse/Def.hsc" #-}

contextFlagssToInt :: [ContextFlags] -> CInt
contextFlagssToInt = foldFlag contextFlagsToInt

contextFlagssFromInt :: CInt -> [ContextFlags]
contextFlagssFromInt i =
    let
        t0 = if (i .&. 0 /= 0) then (ContextNoflags:) else id
{-# LINE 605 "src/Sound/Pulse/Def.hsc" #-}
        t1 = if (i .&. 1 /= 0) then (ContextNoautospawn:) else id
{-# LINE 606 "src/Sound/Pulse/Def.hsc" #-}
        t2 = if (i .&. 2 /= 0) then (ContextNofail:) else id
{-# LINE 607 "src/Sound/Pulse/Def.hsc" #-}
    in t0 . t1 . t2 . id $ []
data SubscriptionMask
    = SubscriptionMaskNull
    | SubscriptionMaskSink
    | SubscriptionMaskSource
    | SubscriptionMaskSinkInput
    | SubscriptionMaskSourceOutput
    | SubscriptionMaskModule
    | SubscriptionMaskClient
    | SubscriptionMaskSampleCache
    | SubscriptionMaskServer
    | SubscriptionMaskAutoload
    | SubscriptionMaskCard
    | SubscriptionMaskAll
    deriving (Eq, Show)

subscriptionMaskToInt :: SubscriptionMask -> CInt
subscriptionMaskToInt SubscriptionMaskNull = 0
{-# LINE 625 "src/Sound/Pulse/Def.hsc" #-}
subscriptionMaskToInt SubscriptionMaskSink = 1
{-# LINE 626 "src/Sound/Pulse/Def.hsc" #-}
subscriptionMaskToInt SubscriptionMaskSource = 2
{-# LINE 627 "src/Sound/Pulse/Def.hsc" #-}
subscriptionMaskToInt SubscriptionMaskSinkInput = 4
{-# LINE 628 "src/Sound/Pulse/Def.hsc" #-}
subscriptionMaskToInt SubscriptionMaskSourceOutput = 8
{-# LINE 629 "src/Sound/Pulse/Def.hsc" #-}
subscriptionMaskToInt SubscriptionMaskModule = 16
{-# LINE 630 "src/Sound/Pulse/Def.hsc" #-}
subscriptionMaskToInt SubscriptionMaskClient = 32
{-# LINE 631 "src/Sound/Pulse/Def.hsc" #-}
subscriptionMaskToInt SubscriptionMaskSampleCache = 64
{-# LINE 632 "src/Sound/Pulse/Def.hsc" #-}
subscriptionMaskToInt SubscriptionMaskServer = 128
{-# LINE 633 "src/Sound/Pulse/Def.hsc" #-}
subscriptionMaskToInt SubscriptionMaskAutoload = 256
{-# LINE 634 "src/Sound/Pulse/Def.hsc" #-}
subscriptionMaskToInt SubscriptionMaskCard = 512
{-# LINE 635 "src/Sound/Pulse/Def.hsc" #-}
subscriptionMaskToInt SubscriptionMaskAll = 767
{-# LINE 636 "src/Sound/Pulse/Def.hsc" #-}

subscriptionMasksToInt :: [SubscriptionMask] -> CInt
subscriptionMasksToInt = foldFlag subscriptionMaskToInt

subscriptionMasksFromInt :: CInt -> [SubscriptionMask]
subscriptionMasksFromInt i =
    let
        t0 = if (i .&. 0 /= 0) then (SubscriptionMaskNull:) else id
{-# LINE 644 "src/Sound/Pulse/Def.hsc" #-}
        t1 = if (i .&. 1 /= 0) then (SubscriptionMaskSink:) else id
{-# LINE 645 "src/Sound/Pulse/Def.hsc" #-}
        t2 = if (i .&. 2 /= 0) then (SubscriptionMaskSource:) else id
{-# LINE 646 "src/Sound/Pulse/Def.hsc" #-}
        t3 = if (i .&. 4 /= 0) then (SubscriptionMaskSinkInput:) else id
{-# LINE 647 "src/Sound/Pulse/Def.hsc" #-}
        t4 = if (i .&. 8 /= 0) then (SubscriptionMaskSourceOutput:) else id
{-# LINE 648 "src/Sound/Pulse/Def.hsc" #-}
        t5 = if (i .&. 16 /= 0) then (SubscriptionMaskModule:) else id
{-# LINE 649 "src/Sound/Pulse/Def.hsc" #-}
        t6 = if (i .&. 32 /= 0) then (SubscriptionMaskClient:) else id
{-# LINE 650 "src/Sound/Pulse/Def.hsc" #-}
        t7 = if (i .&. 64 /= 0) then (SubscriptionMaskSampleCache:) else id
{-# LINE 651 "src/Sound/Pulse/Def.hsc" #-}
        t8 = if (i .&. 128 /= 0) then (SubscriptionMaskServer:) else id
{-# LINE 652 "src/Sound/Pulse/Def.hsc" #-}
        t9 = if (i .&. 256 /= 0) then (SubscriptionMaskAutoload:) else id
{-# LINE 653 "src/Sound/Pulse/Def.hsc" #-}
        t10 = if (i .&. 512 /= 0) then (SubscriptionMaskCard:) else id
{-# LINE 654 "src/Sound/Pulse/Def.hsc" #-}
        t11 = if (i .&. 767 /= 0) then (SubscriptionMaskAll:) else id
{-# LINE 655 "src/Sound/Pulse/Def.hsc" #-}
    in t0 . t1 . t2 . t3 . t4 . t5 . t6 . t7 . t8 . t9 . t10 . t11 . id $ []
data SinkFlags
    = SinkNoflags
    | SinkHwVolumeCtrl
    | SinkLatency
    | SinkHardware
    | SinkNetwork
    | SinkHwMuteCtrl
    | SinkDecibelVolume
    | SinkFlatVolume
    | SinkDynamicLatency
    | SinkSetFormats
    deriving (Eq, Show)

sinkFlagsToInt :: SinkFlags -> CInt
sinkFlagsToInt SinkNoflags = 0
{-# LINE 671 "src/Sound/Pulse/Def.hsc" #-}
sinkFlagsToInt SinkHwVolumeCtrl = 1
{-# LINE 672 "src/Sound/Pulse/Def.hsc" #-}
sinkFlagsToInt SinkLatency = 2
{-# LINE 673 "src/Sound/Pulse/Def.hsc" #-}
sinkFlagsToInt SinkHardware = 4
{-# LINE 674 "src/Sound/Pulse/Def.hsc" #-}
sinkFlagsToInt SinkNetwork = 8
{-# LINE 675 "src/Sound/Pulse/Def.hsc" #-}
sinkFlagsToInt SinkHwMuteCtrl = 16
{-# LINE 676 "src/Sound/Pulse/Def.hsc" #-}
sinkFlagsToInt SinkDecibelVolume = 32
{-# LINE 677 "src/Sound/Pulse/Def.hsc" #-}
sinkFlagsToInt SinkFlatVolume = 64
{-# LINE 678 "src/Sound/Pulse/Def.hsc" #-}
sinkFlagsToInt SinkDynamicLatency = 128
{-# LINE 679 "src/Sound/Pulse/Def.hsc" #-}
sinkFlagsToInt SinkSetFormats = 256
{-# LINE 680 "src/Sound/Pulse/Def.hsc" #-}

sinkFlagssToInt :: [SinkFlags] -> CInt
sinkFlagssToInt = foldFlag sinkFlagsToInt

sinkFlagssFromInt :: CInt -> [SinkFlags]
sinkFlagssFromInt i =
    let
        t0 = if (i .&. 0 /= 0) then (SinkNoflags:) else id
{-# LINE 688 "src/Sound/Pulse/Def.hsc" #-}
        t1 = if (i .&. 1 /= 0) then (SinkHwVolumeCtrl:) else id
{-# LINE 689 "src/Sound/Pulse/Def.hsc" #-}
        t2 = if (i .&. 2 /= 0) then (SinkLatency:) else id
{-# LINE 690 "src/Sound/Pulse/Def.hsc" #-}
        t3 = if (i .&. 4 /= 0) then (SinkHardware:) else id
{-# LINE 691 "src/Sound/Pulse/Def.hsc" #-}
        t4 = if (i .&. 8 /= 0) then (SinkNetwork:) else id
{-# LINE 692 "src/Sound/Pulse/Def.hsc" #-}
        t5 = if (i .&. 16 /= 0) then (SinkHwMuteCtrl:) else id
{-# LINE 693 "src/Sound/Pulse/Def.hsc" #-}
        t6 = if (i .&. 32 /= 0) then (SinkDecibelVolume:) else id
{-# LINE 694 "src/Sound/Pulse/Def.hsc" #-}
        t7 = if (i .&. 64 /= 0) then (SinkFlatVolume:) else id
{-# LINE 695 "src/Sound/Pulse/Def.hsc" #-}
        t8 = if (i .&. 128 /= 0) then (SinkDynamicLatency:) else id
{-# LINE 696 "src/Sound/Pulse/Def.hsc" #-}
        t9 = if (i .&. 256 /= 0) then (SinkSetFormats:) else id
{-# LINE 697 "src/Sound/Pulse/Def.hsc" #-}
    in t0 . t1 . t2 . t3 . t4 . t5 . t6 . t7 . t8 . t9 . id $ []
data SourceFlags
    = SourceNoflags
    | SourceHwVolumeCtrl
    | SourceLatency
    | SourceHardware
    | SourceNetwork
    | SourceHwMuteCtrl
    | SourceDecibelVolume
    | SourceDynamicLatency
    | SourceFlatVolume
    deriving (Eq, Show)

sourceFlagsToInt :: SourceFlags -> CInt
sourceFlagsToInt SourceNoflags = 0
{-# LINE 712 "src/Sound/Pulse/Def.hsc" #-}
sourceFlagsToInt SourceHwVolumeCtrl = 1
{-# LINE 713 "src/Sound/Pulse/Def.hsc" #-}
sourceFlagsToInt SourceLatency = 2
{-# LINE 714 "src/Sound/Pulse/Def.hsc" #-}
sourceFlagsToInt SourceHardware = 4
{-# LINE 715 "src/Sound/Pulse/Def.hsc" #-}
sourceFlagsToInt SourceNetwork = 8
{-# LINE 716 "src/Sound/Pulse/Def.hsc" #-}
sourceFlagsToInt SourceHwMuteCtrl = 16
{-# LINE 717 "src/Sound/Pulse/Def.hsc" #-}
sourceFlagsToInt SourceDecibelVolume = 32
{-# LINE 718 "src/Sound/Pulse/Def.hsc" #-}
sourceFlagsToInt SourceDynamicLatency = 64
{-# LINE 719 "src/Sound/Pulse/Def.hsc" #-}
sourceFlagsToInt SourceFlatVolume = 128
{-# LINE 720 "src/Sound/Pulse/Def.hsc" #-}

sourceFlagssToInt :: [SourceFlags] -> CInt
sourceFlagssToInt = foldFlag sourceFlagsToInt

sourceFlagssFromInt :: CInt -> [SourceFlags]
sourceFlagssFromInt i =
    let
        t0 = if (i .&. 0 /= 0) then (SourceNoflags:) else id
{-# LINE 728 "src/Sound/Pulse/Def.hsc" #-}
        t1 = if (i .&. 1 /= 0) then (SourceHwVolumeCtrl:) else id
{-# LINE 729 "src/Sound/Pulse/Def.hsc" #-}
        t2 = if (i .&. 2 /= 0) then (SourceLatency:) else id
{-# LINE 730 "src/Sound/Pulse/Def.hsc" #-}
        t3 = if (i .&. 4 /= 0) then (SourceHardware:) else id
{-# LINE 731 "src/Sound/Pulse/Def.hsc" #-}
        t4 = if (i .&. 8 /= 0) then (SourceNetwork:) else id
{-# LINE 732 "src/Sound/Pulse/Def.hsc" #-}
        t5 = if (i .&. 16 /= 0) then (SourceHwMuteCtrl:) else id
{-# LINE 733 "src/Sound/Pulse/Def.hsc" #-}
        t6 = if (i .&. 32 /= 0) then (SourceDecibelVolume:) else id
{-# LINE 734 "src/Sound/Pulse/Def.hsc" #-}
        t7 = if (i .&. 64 /= 0) then (SourceDynamicLatency:) else id
{-# LINE 735 "src/Sound/Pulse/Def.hsc" #-}
        t8 = if (i .&. 128 /= 0) then (SourceFlatVolume:) else id
{-# LINE 736 "src/Sound/Pulse/Def.hsc" #-}
    in t0 . t1 . t2 . t3 . t4 . t5 . t6 . t7 . t8 . id $ []