{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
module SDL.Audio
(
AudioDevice
, openAudioDevice
, closeAudioDevice
, OpenDeviceSpec(..)
, AudioDeviceUsage(..)
, Channels(..)
, Changeable(..)
, setAudioDeviceLocked
, LockState(..)
, PlaybackState(..)
, setAudioDevicePlaybackState
, AudioDeviceStatus(..)
, audioDeviceStatus
, AudioFormat(..)
, getAudioDeviceNames
, AudioSpec(..)
, getAudioDrivers
, currentAudioDriver
, AudioDriver
, audioDriverName
, audioInit
) where
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Bits
import Data.Data (Data)
import Data.IORef (newIORef, writeIORef, readIORef)
import Data.Int (Int8, Int16, Int32)
import Data.Text (Text)
import Data.Traversable (for)
import Data.Typeable
import Data.Word
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Utils
import Foreign.Ptr
import Foreign.Storable
import GHC.Exts (Constraint)
import GHC.Generics (Generic)
import SDL.Internal.Exception
import qualified Data.ByteString as BS
import qualified Data.Text.Encoding as Text
import qualified Data.Vector as V
import qualified Data.Vector.Storable.Mutable as MV
import qualified SDL.Raw.Audio as Raw
import qualified SDL.Raw.Enum as Raw
import qualified SDL.Raw.Types as Raw
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
import Data.Foldable (Foldable)
import Data.Traversable (Traversable)
#endif
#if MIN_VERSION_base(4,12,0)
import Data.Kind (Type)
#else
# define Type *
#endif
data OpenDeviceSpec = forall sampleType. OpenDeviceSpec
{ OpenDeviceSpec -> Changeable CInt
openDeviceFreq :: !(Changeable CInt)
, ()
openDeviceFormat :: !(Changeable (AudioFormat sampleType))
, OpenDeviceSpec -> Changeable Channels
openDeviceChannels :: !(Changeable Channels)
, OpenDeviceSpec -> Word16
openDeviceSamples :: !Word16
, OpenDeviceSpec
-> forall actualSampleType.
AudioFormat actualSampleType -> IOVector actualSampleType -> IO ()
openDeviceCallback :: forall actualSampleType. AudioFormat actualSampleType -> MV.IOVector actualSampleType -> IO ()
, OpenDeviceSpec -> AudioDeviceUsage
openDeviceUsage :: !AudioDeviceUsage
, OpenDeviceSpec -> Maybe Text
openDeviceName :: !(Maybe Text)
} deriving (Typeable)
openAudioDevice :: MonadIO m => OpenDeviceSpec -> m (AudioDevice, AudioSpec)
openAudioDevice :: forall (m :: Type -> Type).
MonadIO m =>
OpenDeviceSpec -> m (AudioDevice, AudioSpec)
openAudioDevice OpenDeviceSpec{Maybe Text
Word16
Changeable CInt
Changeable Channels
Changeable (AudioFormat sampleType)
AudioDeviceUsage
forall actualSampleType.
AudioFormat actualSampleType -> IOVector actualSampleType -> IO ()
openDeviceFreq :: OpenDeviceSpec -> Changeable CInt
openDeviceFormat :: ()
openDeviceChannels :: OpenDeviceSpec -> Changeable Channels
openDeviceSamples :: OpenDeviceSpec -> Word16
openDeviceCallback :: OpenDeviceSpec
-> forall actualSampleType.
AudioFormat actualSampleType -> IOVector actualSampleType -> IO ()
openDeviceUsage :: OpenDeviceSpec -> AudioDeviceUsage
openDeviceName :: OpenDeviceSpec -> Maybe Text
openDeviceFreq :: Changeable CInt
openDeviceFormat :: Changeable (AudioFormat sampleType)
openDeviceChannels :: Changeable Channels
openDeviceSamples :: Word16
openDeviceCallback :: forall actualSampleType.
AudioFormat actualSampleType -> IOVector actualSampleType -> IO ()
openDeviceUsage :: AudioDeviceUsage
openDeviceName :: Maybe Text
..} = IO (AudioDevice, AudioSpec) -> m (AudioDevice, AudioSpec)
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (AudioDevice, AudioSpec) -> m (AudioDevice, AudioSpec))
-> IO (AudioDevice, AudioSpec) -> m (AudioDevice, AudioSpec)
forall a b. (a -> b) -> a -> b
$
(Text
-> (Ptr CChar -> IO (AudioDevice, AudioSpec))
-> IO (AudioDevice, AudioSpec))
-> Maybe Text
-> (Ptr CChar -> IO (AudioDevice, AudioSpec))
-> IO (AudioDevice, AudioSpec)
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith (ByteString
-> (Ptr CChar -> IO (AudioDevice, AudioSpec))
-> IO (AudioDevice, AudioSpec)
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString (ByteString
-> (Ptr CChar -> IO (AudioDevice, AudioSpec))
-> IO (AudioDevice, AudioSpec))
-> (Text -> ByteString)
-> Text
-> (Ptr CChar -> IO (AudioDevice, AudioSpec))
-> IO (AudioDevice, AudioSpec)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8) Maybe Text
openDeviceName ((Ptr CChar -> IO (AudioDevice, AudioSpec))
-> IO (AudioDevice, AudioSpec))
-> (Ptr CChar -> IO (AudioDevice, AudioSpec))
-> IO (AudioDevice, AudioSpec)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
cDevName -> do
IORef AnAudioFormat
anAudioFormatRef <- AnAudioFormat -> IO (IORef AnAudioFormat)
forall a. a -> IO (IORef a)
newIORef AnAudioFormat
forall a. HasCallStack => a
undefined
AudioCallback
cb <- (Ptr () -> Ptr Word8 -> CInt -> IO ()) -> IO AudioCallback
Raw.mkAudioCallback ((Ptr () -> Ptr Word8 -> CInt -> IO ()) -> IO AudioCallback)
-> (Ptr () -> Ptr Word8 -> CInt -> IO ()) -> IO AudioCallback
forall a b. (a -> b) -> a -> b
$ \Ptr ()
_ Ptr Word8
buffer CInt
len -> do
ForeignPtr Word8
fp <- Ptr Word8 -> IO (ForeignPtr Word8)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr Word8
buffer
AnAudioFormat
anAudioFormat <- IORef AnAudioFormat -> IO AnAudioFormat
forall a. IORef a -> IO a
readIORef IORef AnAudioFormat
anAudioFormatRef
case AnAudioFormat
anAudioFormat of
AnAudioFormat AudioFormat sampleType
audioFormat ->
case AudioFormat sampleType -> Dict (Storable sampleType)
forall sampleType.
AudioFormat sampleType -> Dict (Storable sampleType)
audioFormatStorable AudioFormat sampleType
audioFormat of
Dict (Storable sampleType)
Dict -> AudioFormat sampleType -> IOVector sampleType -> IO ()
forall actualSampleType.
AudioFormat actualSampleType -> IOVector actualSampleType -> IO ()
openDeviceCallback AudioFormat sampleType
audioFormat
(MVector RealWorld Word8 -> IOVector sampleType
forall a b s.
(Storable a, Storable b) =>
MVector s a -> MVector s b
MV.unsafeCast (ForeignPtr Word8 -> Int -> MVector RealWorld Word8
forall a s. ForeignPtr a -> Int -> MVector s a
MV.unsafeFromForeignPtr0 ForeignPtr Word8
fp (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
len)))
AudioSpec
-> (Ptr AudioSpec -> IO (AudioDevice, AudioSpec))
-> IO (AudioDevice, AudioSpec)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (AudioCallback -> AudioSpec
desiredSpec AudioCallback
cb) ((Ptr AudioSpec -> IO (AudioDevice, AudioSpec))
-> IO (AudioDevice, AudioSpec))
-> (Ptr AudioSpec -> IO (AudioDevice, AudioSpec))
-> IO (AudioDevice, AudioSpec)
forall a b. (a -> b) -> a -> b
$ \Ptr AudioSpec
desiredSpecPtr ->
(Ptr AudioSpec -> IO (AudioDevice, AudioSpec))
-> IO (AudioDevice, AudioSpec)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr AudioSpec -> IO (AudioDevice, AudioSpec))
-> IO (AudioDevice, AudioSpec))
-> (Ptr AudioSpec -> IO (AudioDevice, AudioSpec))
-> IO (AudioDevice, AudioSpec)
forall a b. (a -> b) -> a -> b
$ \Ptr AudioSpec
actualSpecPtr -> do
Word32
devId <- Text -> Text -> IO Word32 -> IO Word32
forall a (m :: Type -> Type).
(Eq a, MonadIO m, Num a) =>
Text -> Text -> m a -> m a
throwIf0 Text
"SDL.Audio.openAudioDevice" Text
"SDL_OpenAudioDevice" (IO Word32 -> IO Word32) -> IO Word32 -> IO Word32
forall a b. (a -> b) -> a -> b
$
Ptr CChar
-> CInt -> Ptr AudioSpec -> Ptr AudioSpec -> CInt -> IO Word32
forall (m :: Type -> Type).
MonadIO m =>
Ptr CChar
-> CInt -> Ptr AudioSpec -> Ptr AudioSpec -> CInt -> m Word32
Raw.openAudioDevice Ptr CChar
cDevName (AudioDeviceUsage -> CInt
forall a. Num a => AudioDeviceUsage -> a
encodeUsage AudioDeviceUsage
openDeviceUsage) Ptr AudioSpec
desiredSpecPtr Ptr AudioSpec
actualSpecPtr CInt
changes
AudioSpec
actual <- Ptr AudioSpec -> IO AudioSpec
forall a. Storable a => Ptr a -> IO a
peek Ptr AudioSpec
actualSpecPtr
let audioDevice :: AudioDevice
audioDevice = Word32 -> AudioDevice
AudioDevice Word32
devId
anAudioFormat :: AnAudioFormat
anAudioFormat = Word16 -> AnAudioFormat
decodeAudioFormat (AudioSpec -> Word16
Raw.audioSpecFormat AudioSpec
actual)
spec :: AudioSpec
spec =
case AnAudioFormat
anAudioFormat of
AnAudioFormat AudioFormat sampleType
audioFormat ->
AudioSpec { audioSpecFreq :: CInt
audioSpecFreq = AudioSpec -> CInt
Raw.audioSpecFreq AudioSpec
actual
, audioSpecFormat :: AudioFormat sampleType
audioSpecFormat = AudioFormat sampleType
audioFormat
, audioSpecChannels :: Channels
audioSpecChannels = Text -> Text -> (Word8 -> Maybe Channels) -> Word8 -> Channels
forall a b. Show a => Text -> Text -> (a -> Maybe b) -> a -> b
fromC Text
"SDL.Audio.openAudioDevice" Text
"audioSpecChannels" Word8 -> Maybe Channels
forall {a}. (Eq a, Num a) => a -> Maybe Channels
readChannels (AudioSpec -> Word8
Raw.audioSpecChannels AudioSpec
actual)
, audioSpecSilence :: Word8
audioSpecSilence = AudioSpec -> Word8
Raw.audioSpecSilence AudioSpec
actual
, audioSpecSize :: Word32
audioSpecSize = AudioSpec -> Word32
Raw.audioSpecSize AudioSpec
actual
, audioSpecSamples :: Word16
audioSpecSamples = AudioSpec -> Word16
Raw.audioSpecSamples AudioSpec
actual
, audioSpecCallback :: AudioFormat sampleType -> IOVector sampleType -> IO ()
audioSpecCallback = AudioFormat sampleType -> IOVector sampleType -> IO ()
forall actualSampleType.
AudioFormat actualSampleType -> IOVector actualSampleType -> IO ()
openDeviceCallback
}
IORef AnAudioFormat -> AnAudioFormat -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef AnAudioFormat
anAudioFormatRef AnAudioFormat
anAudioFormat
(AudioDevice, AudioSpec) -> IO (AudioDevice, AudioSpec)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (AudioDevice
audioDevice, AudioSpec
spec)
where
changes :: CInt
changes = (CInt -> CInt -> CInt) -> CInt -> [CInt] -> CInt
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
(.|.) CInt
0 [ (CInt -> CInt) -> (CInt -> CInt) -> Changeable CInt -> CInt
forall a b. (a -> b) -> (a -> b) -> Changeable a -> b
foldChangeable (CInt -> CInt -> CInt
forall a b. a -> b -> a
const CInt
0) (CInt -> CInt -> CInt
forall a b. a -> b -> a
const CInt
forall {a}. (Eq a, Num a) => a
Raw.SDL_AUDIO_ALLOW_FREQUENCY_CHANGE) Changeable CInt
openDeviceFreq
, (AudioFormat sampleType -> CInt)
-> (AudioFormat sampleType -> CInt)
-> Changeable (AudioFormat sampleType)
-> CInt
forall a b. (a -> b) -> (a -> b) -> Changeable a -> b
foldChangeable (CInt -> AudioFormat sampleType -> CInt
forall a b. a -> b -> a
const CInt
0) (CInt -> AudioFormat sampleType -> CInt
forall a b. a -> b -> a
const CInt
forall {a}. (Eq a, Num a) => a
Raw.SDL_AUDIO_ALLOW_FORMAT_CHANGE) Changeable (AudioFormat sampleType)
openDeviceFormat
, (Channels -> CInt)
-> (Channels -> CInt) -> Changeable Channels -> CInt
forall a b. (a -> b) -> (a -> b) -> Changeable a -> b
foldChangeable (CInt -> Channels -> CInt
forall a b. a -> b -> a
const CInt
0) (CInt -> Channels -> CInt
forall a b. a -> b -> a
const CInt
forall {a}. (Eq a, Num a) => a
Raw.SDL_AUDIO_ALLOW_CHANNELS_CHANGE) Changeable Channels
openDeviceChannels
]
channelsToWord8 :: Channels -> a
channelsToWord8 Channels
Mono = a
1
channelsToWord8 Channels
Stereo = a
2
channelsToWord8 Channels
Quad = a
4
channelsToWord8 Channels
FivePointOne = a
6
readChannels :: a -> Maybe Channels
readChannels a
1 = Channels -> Maybe Channels
forall a. a -> Maybe a
Just Channels
Mono
readChannels a
2 = Channels -> Maybe Channels
forall a. a -> Maybe a
Just Channels
Stereo
readChannels a
4 = Channels -> Maybe Channels
forall a. a -> Maybe a
Just Channels
Quad
readChannels a
6 = Channels -> Maybe Channels
forall a. a -> Maybe a
Just Channels
FivePointOne
readChannels a
_ = Maybe Channels
forall a. Maybe a
Nothing
desiredSpec :: AudioCallback -> AudioSpec
desiredSpec AudioCallback
cb = Raw.AudioSpec
{ audioSpecFreq :: CInt
Raw.audioSpecFreq = Changeable CInt -> CInt
forall a. Changeable a -> a
unpackChangeable Changeable CInt
openDeviceFreq
, audioSpecFormat :: Word16
Raw.audioSpecFormat = AudioFormat sampleType -> Word16
forall sampleType. AudioFormat sampleType -> Word16
encodeAudioFormat (Changeable (AudioFormat sampleType) -> AudioFormat sampleType
forall a. Changeable a -> a
unpackChangeable Changeable (AudioFormat sampleType)
openDeviceFormat)
, audioSpecChannels :: Word8
Raw.audioSpecChannels = Channels -> Word8
forall {a}. Num a => Channels -> a
channelsToWord8 (Changeable Channels -> Channels
forall a. Changeable a -> a
unpackChangeable Changeable Channels
openDeviceChannels)
, audioSpecSilence :: Word8
Raw.audioSpecSilence = Word8
0
, audioSpecSize :: Word32
Raw.audioSpecSize = Word32
0
, audioSpecSamples :: Word16
Raw.audioSpecSamples = Word16
openDeviceSamples
, audioSpecCallback :: AudioCallback
Raw.audioSpecCallback = AudioCallback
cb
, audioSpecUserdata :: Ptr ()
Raw.audioSpecUserdata = Ptr ()
forall a. Ptr a
nullPtr
}
audioFormatStorable :: AudioFormat sampleType -> Dict (Storable sampleType)
audioFormatStorable :: forall sampleType.
AudioFormat sampleType -> Dict (Storable sampleType)
audioFormatStorable AudioFormat sampleType
Signed8BitAudio = Dict (Storable sampleType)
forall (c :: Constraint). c => Dict c
Dict
audioFormatStorable AudioFormat sampleType
Unsigned8BitAudio = Dict (Storable sampleType)
forall (c :: Constraint). c => Dict c
Dict
audioFormatStorable AudioFormat sampleType
Signed16BitLEAudio = Dict (Storable sampleType)
forall (c :: Constraint). c => Dict c
Dict
audioFormatStorable AudioFormat sampleType
Signed16BitBEAudio = Dict (Storable sampleType)
forall (c :: Constraint). c => Dict c
Dict
audioFormatStorable AudioFormat sampleType
Signed16BitNativeAudio = Dict (Storable sampleType)
forall (c :: Constraint). c => Dict c
Dict
audioFormatStorable AudioFormat sampleType
Unsigned16BitLEAudio = Dict (Storable sampleType)
forall (c :: Constraint). c => Dict c
Dict
audioFormatStorable AudioFormat sampleType
Unsigned16BitBEAudio = Dict (Storable sampleType)
forall (c :: Constraint). c => Dict c
Dict
audioFormatStorable AudioFormat sampleType
Unsigned16BitNativeAudio = Dict (Storable sampleType)
forall (c :: Constraint). c => Dict c
Dict
audioFormatStorable AudioFormat sampleType
Signed32BitLEAudio = Dict (Storable sampleType)
forall (c :: Constraint). c => Dict c
Dict
audioFormatStorable AudioFormat sampleType
Signed32BitBEAudio = Dict (Storable sampleType)
forall (c :: Constraint). c => Dict c
Dict
audioFormatStorable AudioFormat sampleType
Signed32BitNativeAudio = Dict (Storable sampleType)
forall (c :: Constraint). c => Dict c
Dict
audioFormatStorable AudioFormat sampleType
FloatingLEAudio = Dict (Storable sampleType)
forall (c :: Constraint). c => Dict c
Dict
audioFormatStorable AudioFormat sampleType
FloatingBEAudio = Dict (Storable sampleType)
forall (c :: Constraint). c => Dict c
Dict
audioFormatStorable AudioFormat sampleType
FloatingNativeAudio = Dict (Storable sampleType)
forall (c :: Constraint). c => Dict c
Dict
data Dict :: Constraint -> Type where
Dict :: c => Dict c
closeAudioDevice :: MonadIO m => AudioDevice -> m ()
closeAudioDevice :: forall (m :: Type -> Type). MonadIO m => AudioDevice -> m ()
closeAudioDevice (AudioDevice Word32
d) = Word32 -> m ()
forall (m :: Type -> Type). MonadIO m => Word32 -> m ()
Raw.closeAudioDevice Word32
d
newtype AudioDevice = AudioDevice (Raw.AudioDeviceID)
deriving (AudioDevice -> AudioDevice -> Bool
(AudioDevice -> AudioDevice -> Bool)
-> (AudioDevice -> AudioDevice -> Bool) -> Eq AudioDevice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AudioDevice -> AudioDevice -> Bool
== :: AudioDevice -> AudioDevice -> Bool
$c/= :: AudioDevice -> AudioDevice -> Bool
/= :: AudioDevice -> AudioDevice -> Bool
Eq, Typeable)
getAudioDeviceNames :: MonadIO m => AudioDeviceUsage -> m (Maybe (V.Vector Text))
getAudioDeviceNames :: forall (m :: Type -> Type).
MonadIO m =>
AudioDeviceUsage -> m (Maybe (Vector Text))
getAudioDeviceNames AudioDeviceUsage
usage = IO (Maybe (Vector Text)) -> m (Maybe (Vector Text))
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Vector Text)) -> m (Maybe (Vector Text)))
-> IO (Maybe (Vector Text)) -> m (Maybe (Vector Text))
forall a b. (a -> b) -> a -> b
$ do
CInt
n <- CInt -> IO CInt
forall (m :: Type -> Type). MonadIO m => CInt -> m CInt
Raw.getNumAudioDevices CInt
usage'
if CInt
n CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== -CInt
1
then Maybe (Vector Text) -> IO (Maybe (Vector Text))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe (Vector Text)
forall a. Maybe a
Nothing
else ([Text] -> Maybe (Vector Text))
-> IO [Text] -> IO (Maybe (Vector Text))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vector Text -> Maybe (Vector Text)
forall a. a -> Maybe a
Just (Vector Text -> Maybe (Vector Text))
-> ([Text] -> Vector Text) -> [Text] -> Maybe (Vector Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Vector Text
forall a. [a] -> Vector a
V.fromList) (IO [Text] -> IO (Maybe (Vector Text)))
-> IO [Text] -> IO (Maybe (Vector Text))
forall a b. (a -> b) -> a -> b
$
[CInt] -> (CInt -> IO Text) -> IO [Text]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [CInt
0 .. (CInt
n CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1)] ((CInt -> IO Text) -> IO [Text]) -> (CInt -> IO Text) -> IO [Text]
forall a b. (a -> b) -> a -> b
$ \CInt
i -> do
Ptr CChar
cstr <- Text -> Text -> IO (Ptr CChar) -> IO (Ptr CChar)
forall (m :: Type -> Type) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull Text
"SDL.Audio.getAudioDeviceNames" Text
"SDL_GetAudioDeviceName" (IO (Ptr CChar) -> IO (Ptr CChar))
-> IO (Ptr CChar) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$
CInt -> CInt -> IO (Ptr CChar)
forall (m :: Type -> Type).
MonadIO m =>
CInt -> CInt -> m (Ptr CChar)
Raw.getAudioDeviceName CInt
i CInt
usage'
ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> IO ByteString
BS.packCString Ptr CChar
cstr
where usage' :: CInt
usage' = AudioDeviceUsage -> CInt
forall a. Num a => AudioDeviceUsage -> a
encodeUsage AudioDeviceUsage
usage
data AudioFormat sampleType where
Signed8BitAudio :: AudioFormat Int8
Unsigned8BitAudio :: AudioFormat Word8
Signed16BitLEAudio :: AudioFormat Int16
Signed16BitBEAudio :: AudioFormat Int16
Signed16BitNativeAudio :: AudioFormat Int16
Unsigned16BitLEAudio :: AudioFormat Word16
Unsigned16BitBEAudio :: AudioFormat Word16
Unsigned16BitNativeAudio :: AudioFormat Word16
Signed32BitLEAudio :: AudioFormat Int32
Signed32BitBEAudio :: AudioFormat Int32
Signed32BitNativeAudio :: AudioFormat Int32
FloatingLEAudio :: AudioFormat Float
FloatingBEAudio :: AudioFormat Float
FloatingNativeAudio :: AudioFormat Float
deriving instance Eq (AudioFormat sampleType)
deriving instance Ord (AudioFormat sampleType)
deriving instance Show (AudioFormat sampleType)
data AnAudioFormat where
AnAudioFormat :: AudioFormat sampleType -> AnAudioFormat
encodeAudioFormat :: AudioFormat sampleType -> Word16
encodeAudioFormat :: forall sampleType. AudioFormat sampleType -> Word16
encodeAudioFormat AudioFormat sampleType
Signed8BitAudio = Word16
Raw.SDL_AUDIO_S8
encodeAudioFormat AudioFormat sampleType
Unsigned8BitAudio = Word16
Raw.SDL_AUDIO_U8
encodeAudioFormat AudioFormat sampleType
Signed16BitLEAudio = Word16
Raw.SDL_AUDIO_S16LSB
encodeAudioFormat AudioFormat sampleType
Signed16BitBEAudio = Word16
Raw.SDL_AUDIO_S16MSB
encodeAudioFormat AudioFormat sampleType
Signed16BitNativeAudio = Word16
Raw.SDL_AUDIO_S16SYS
encodeAudioFormat AudioFormat sampleType
Unsigned16BitLEAudio = Word16
Raw.SDL_AUDIO_U16LSB
encodeAudioFormat AudioFormat sampleType
Unsigned16BitBEAudio = Word16
Raw.SDL_AUDIO_U16MSB
encodeAudioFormat AudioFormat sampleType
Unsigned16BitNativeAudio = Word16
Raw.SDL_AUDIO_U16SYS
encodeAudioFormat AudioFormat sampleType
Signed32BitLEAudio = Word16
Raw.SDL_AUDIO_S32LSB
encodeAudioFormat AudioFormat sampleType
Signed32BitBEAudio = Word16
Raw.SDL_AUDIO_S32MSB
encodeAudioFormat AudioFormat sampleType
Signed32BitNativeAudio = Word16
Raw.SDL_AUDIO_S32SYS
encodeAudioFormat AudioFormat sampleType
FloatingLEAudio = Word16
Raw.SDL_AUDIO_F32LSB
encodeAudioFormat AudioFormat sampleType
FloatingBEAudio = Word16
Raw.SDL_AUDIO_F32MSB
encodeAudioFormat AudioFormat sampleType
FloatingNativeAudio = Word16
Raw.SDL_AUDIO_F32SYS
decodeAudioFormat :: Word16 -> AnAudioFormat
decodeAudioFormat :: Word16 -> AnAudioFormat
decodeAudioFormat Word16
Raw.SDL_AUDIO_S8 = AudioFormat Int8 -> AnAudioFormat
forall sampleType. AudioFormat sampleType -> AnAudioFormat
AnAudioFormat AudioFormat Int8
Signed8BitAudio
decodeAudioFormat Word16
Raw.SDL_AUDIO_U8 = AudioFormat Word8 -> AnAudioFormat
forall sampleType. AudioFormat sampleType -> AnAudioFormat
AnAudioFormat AudioFormat Word8
Unsigned8BitAudio
decodeAudioFormat Word16
Raw.SDL_AUDIO_S16LSB = AudioFormat Int16 -> AnAudioFormat
forall sampleType. AudioFormat sampleType -> AnAudioFormat
AnAudioFormat AudioFormat Int16
Signed16BitLEAudio
decodeAudioFormat Word16
Raw.SDL_AUDIO_S16MSB = AudioFormat Int16 -> AnAudioFormat
forall sampleType. AudioFormat sampleType -> AnAudioFormat
AnAudioFormat AudioFormat Int16
Signed16BitBEAudio
decodeAudioFormat Word16
Raw.SDL_AUDIO_S16SYS = AudioFormat Int16 -> AnAudioFormat
forall sampleType. AudioFormat sampleType -> AnAudioFormat
AnAudioFormat AudioFormat Int16
Signed16BitNativeAudio
decodeAudioFormat Word16
Raw.SDL_AUDIO_U16LSB = AudioFormat Word16 -> AnAudioFormat
forall sampleType. AudioFormat sampleType -> AnAudioFormat
AnAudioFormat AudioFormat Word16
Unsigned16BitLEAudio
decodeAudioFormat Word16
Raw.SDL_AUDIO_U16MSB = AudioFormat Word16 -> AnAudioFormat
forall sampleType. AudioFormat sampleType -> AnAudioFormat
AnAudioFormat AudioFormat Word16
Unsigned16BitBEAudio
decodeAudioFormat Word16
Raw.SDL_AUDIO_U16SYS = AudioFormat Word16 -> AnAudioFormat
forall sampleType. AudioFormat sampleType -> AnAudioFormat
AnAudioFormat AudioFormat Word16
Unsigned16BitNativeAudio
decodeAudioFormat Word16
Raw.SDL_AUDIO_S32LSB = AudioFormat Int32 -> AnAudioFormat
forall sampleType. AudioFormat sampleType -> AnAudioFormat
AnAudioFormat AudioFormat Int32
Signed32BitLEAudio
decodeAudioFormat Word16
Raw.SDL_AUDIO_S32MSB = AudioFormat Int32 -> AnAudioFormat
forall sampleType. AudioFormat sampleType -> AnAudioFormat
AnAudioFormat AudioFormat Int32
Signed32BitBEAudio
decodeAudioFormat Word16
Raw.SDL_AUDIO_S32SYS = AudioFormat Int32 -> AnAudioFormat
forall sampleType. AudioFormat sampleType -> AnAudioFormat
AnAudioFormat AudioFormat Int32
Signed32BitNativeAudio
decodeAudioFormat Word16
Raw.SDL_AUDIO_F32LSB = AudioFormat Float -> AnAudioFormat
forall sampleType. AudioFormat sampleType -> AnAudioFormat
AnAudioFormat AudioFormat Float
FloatingLEAudio
decodeAudioFormat Word16
Raw.SDL_AUDIO_F32MSB = AudioFormat Float -> AnAudioFormat
forall sampleType. AudioFormat sampleType -> AnAudioFormat
AnAudioFormat AudioFormat Float
FloatingBEAudio
decodeAudioFormat Word16
Raw.SDL_AUDIO_F32SYS = AudioFormat Float -> AnAudioFormat
forall sampleType. AudioFormat sampleType -> AnAudioFormat
AnAudioFormat AudioFormat Float
FloatingNativeAudio
decodeAudioFormat Word16
x = [Char] -> AnAudioFormat
forall a. HasCallStack => [Char] -> a
error ([Char]
"decodeAudioFormat failed: Unknown format " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word16 -> [Char]
forall a. Show a => a -> [Char]
show Word16
x)
data Channels
= Mono
| Stereo
| Quad
| FivePointOne
deriving (Channels
Channels -> Channels -> Bounded Channels
forall a. a -> a -> Bounded a
$cminBound :: Channels
minBound :: Channels
$cmaxBound :: Channels
maxBound :: Channels
Bounded,Typeable Channels
Typeable Channels =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Channels -> c Channels)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Channels)
-> (Channels -> Constr)
-> (Channels -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Channels))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Channels))
-> ((forall b. Data b => b -> b) -> Channels -> Channels)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Channels -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Channels -> r)
-> (forall u. (forall d. Data d => d -> u) -> Channels -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Channels -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Channels -> m Channels)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Channels -> m Channels)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Channels -> m Channels)
-> Data Channels
Channels -> Constr
Channels -> DataType
(forall b. Data b => b -> b) -> Channels -> Channels
forall a.
Typeable a =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Channels -> u
forall u. (forall d. Data d => d -> u) -> Channels -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Channels -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Channels -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Channels -> m Channels
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Channels -> m Channels
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Channels
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Channels -> c Channels
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Channels)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Channels)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Channels -> c Channels
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Channels -> c Channels
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Channels
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Channels
$ctoConstr :: Channels -> Constr
toConstr :: Channels -> Constr
$cdataTypeOf :: Channels -> DataType
dataTypeOf :: Channels -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Channels)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Channels)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Channels)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Channels)
$cgmapT :: (forall b. Data b => b -> b) -> Channels -> Channels
gmapT :: (forall b. Data b => b -> b) -> Channels -> Channels
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Channels -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Channels -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Channels -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Channels -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Channels -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Channels -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Channels -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Channels -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Channels -> m Channels
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Channels -> m Channels
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Channels -> m Channels
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Channels -> m Channels
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Channels -> m Channels
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Channels -> m Channels
Data,Int -> Channels
Channels -> Int
Channels -> [Channels]
Channels -> Channels
Channels -> Channels -> [Channels]
Channels -> Channels -> Channels -> [Channels]
(Channels -> Channels)
-> (Channels -> Channels)
-> (Int -> Channels)
-> (Channels -> Int)
-> (Channels -> [Channels])
-> (Channels -> Channels -> [Channels])
-> (Channels -> Channels -> [Channels])
-> (Channels -> Channels -> Channels -> [Channels])
-> Enum Channels
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Channels -> Channels
succ :: Channels -> Channels
$cpred :: Channels -> Channels
pred :: Channels -> Channels
$ctoEnum :: Int -> Channels
toEnum :: Int -> Channels
$cfromEnum :: Channels -> Int
fromEnum :: Channels -> Int
$cenumFrom :: Channels -> [Channels]
enumFrom :: Channels -> [Channels]
$cenumFromThen :: Channels -> Channels -> [Channels]
enumFromThen :: Channels -> Channels -> [Channels]
$cenumFromTo :: Channels -> Channels -> [Channels]
enumFromTo :: Channels -> Channels -> [Channels]
$cenumFromThenTo :: Channels -> Channels -> Channels -> [Channels]
enumFromThenTo :: Channels -> Channels -> Channels -> [Channels]
Enum,Channels -> Channels -> Bool
(Channels -> Channels -> Bool)
-> (Channels -> Channels -> Bool) -> Eq Channels
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Channels -> Channels -> Bool
== :: Channels -> Channels -> Bool
$c/= :: Channels -> Channels -> Bool
/= :: Channels -> Channels -> Bool
Eq,(forall x. Channels -> Rep Channels x)
-> (forall x. Rep Channels x -> Channels) -> Generic Channels
forall x. Rep Channels x -> Channels
forall x. Channels -> Rep Channels x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Channels -> Rep Channels x
from :: forall x. Channels -> Rep Channels x
$cto :: forall x. Rep Channels x -> Channels
to :: forall x. Rep Channels x -> Channels
Generic,Eq Channels
Eq Channels =>
(Channels -> Channels -> Ordering)
-> (Channels -> Channels -> Bool)
-> (Channels -> Channels -> Bool)
-> (Channels -> Channels -> Bool)
-> (Channels -> Channels -> Bool)
-> (Channels -> Channels -> Channels)
-> (Channels -> Channels -> Channels)
-> Ord Channels
Channels -> Channels -> Bool
Channels -> Channels -> Ordering
Channels -> Channels -> Channels
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Channels -> Channels -> Ordering
compare :: Channels -> Channels -> Ordering
$c< :: Channels -> Channels -> Bool
< :: Channels -> Channels -> Bool
$c<= :: Channels -> Channels -> Bool
<= :: Channels -> Channels -> Bool
$c> :: Channels -> Channels -> Bool
> :: Channels -> Channels -> Bool
$c>= :: Channels -> Channels -> Bool
>= :: Channels -> Channels -> Bool
$cmax :: Channels -> Channels -> Channels
max :: Channels -> Channels -> Channels
$cmin :: Channels -> Channels -> Channels
min :: Channels -> Channels -> Channels
Ord,ReadPrec [Channels]
ReadPrec Channels
Int -> ReadS Channels
ReadS [Channels]
(Int -> ReadS Channels)
-> ReadS [Channels]
-> ReadPrec Channels
-> ReadPrec [Channels]
-> Read Channels
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Channels
readsPrec :: Int -> ReadS Channels
$creadList :: ReadS [Channels]
readList :: ReadS [Channels]
$creadPrec :: ReadPrec Channels
readPrec :: ReadPrec Channels
$creadListPrec :: ReadPrec [Channels]
readListPrec :: ReadPrec [Channels]
Read,Int -> Channels -> ShowS
[Channels] -> ShowS
Channels -> [Char]
(Int -> Channels -> ShowS)
-> (Channels -> [Char]) -> ([Channels] -> ShowS) -> Show Channels
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Channels -> ShowS
showsPrec :: Int -> Channels -> ShowS
$cshow :: Channels -> [Char]
show :: Channels -> [Char]
$cshowList :: [Channels] -> ShowS
showList :: [Channels] -> ShowS
Show,Typeable)
data AudioSpec = forall sampleType. AudioSpec
{ AudioSpec -> CInt
audioSpecFreq :: !CInt
, ()
audioSpecFormat :: !(AudioFormat sampleType)
, AudioSpec -> Channels
audioSpecChannels :: !Channels
, AudioSpec -> Word8
audioSpecSilence :: !Word8
, AudioSpec -> Word16
audioSpecSamples :: !Word16
, AudioSpec -> Word32
audioSpecSize :: !Word32
, ()
audioSpecCallback :: AudioFormat sampleType -> MV.IOVector sampleType -> IO ()
}
deriving (Typeable)
data AudioDeviceUsage
= ForPlayback
| ForCapture
deriving (AudioDeviceUsage
AudioDeviceUsage -> AudioDeviceUsage -> Bounded AudioDeviceUsage
forall a. a -> a -> Bounded a
$cminBound :: AudioDeviceUsage
minBound :: AudioDeviceUsage
$cmaxBound :: AudioDeviceUsage
maxBound :: AudioDeviceUsage
Bounded, Typeable AudioDeviceUsage
Typeable AudioDeviceUsage =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AudioDeviceUsage -> c AudioDeviceUsage)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AudioDeviceUsage)
-> (AudioDeviceUsage -> Constr)
-> (AudioDeviceUsage -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AudioDeviceUsage))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AudioDeviceUsage))
-> ((forall b. Data b => b -> b)
-> AudioDeviceUsage -> AudioDeviceUsage)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AudioDeviceUsage -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AudioDeviceUsage -> r)
-> (forall u.
(forall d. Data d => d -> u) -> AudioDeviceUsage -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> AudioDeviceUsage -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> AudioDeviceUsage -> m AudioDeviceUsage)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AudioDeviceUsage -> m AudioDeviceUsage)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AudioDeviceUsage -> m AudioDeviceUsage)
-> Data AudioDeviceUsage
AudioDeviceUsage -> Constr
AudioDeviceUsage -> DataType
(forall b. Data b => b -> b)
-> AudioDeviceUsage -> AudioDeviceUsage
forall a.
Typeable a =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> AudioDeviceUsage -> u
forall u. (forall d. Data d => d -> u) -> AudioDeviceUsage -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AudioDeviceUsage -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AudioDeviceUsage -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> AudioDeviceUsage -> m AudioDeviceUsage
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AudioDeviceUsage -> m AudioDeviceUsage
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AudioDeviceUsage
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AudioDeviceUsage -> c AudioDeviceUsage
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AudioDeviceUsage)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AudioDeviceUsage)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AudioDeviceUsage -> c AudioDeviceUsage
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AudioDeviceUsage -> c AudioDeviceUsage
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AudioDeviceUsage
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AudioDeviceUsage
$ctoConstr :: AudioDeviceUsage -> Constr
toConstr :: AudioDeviceUsage -> Constr
$cdataTypeOf :: AudioDeviceUsage -> DataType
dataTypeOf :: AudioDeviceUsage -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AudioDeviceUsage)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AudioDeviceUsage)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AudioDeviceUsage)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AudioDeviceUsage)
$cgmapT :: (forall b. Data b => b -> b)
-> AudioDeviceUsage -> AudioDeviceUsage
gmapT :: (forall b. Data b => b -> b)
-> AudioDeviceUsage -> AudioDeviceUsage
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AudioDeviceUsage -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AudioDeviceUsage -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AudioDeviceUsage -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AudioDeviceUsage -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AudioDeviceUsage -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> AudioDeviceUsage -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AudioDeviceUsage -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AudioDeviceUsage -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> AudioDeviceUsage -> m AudioDeviceUsage
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> AudioDeviceUsage -> m AudioDeviceUsage
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AudioDeviceUsage -> m AudioDeviceUsage
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AudioDeviceUsage -> m AudioDeviceUsage
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AudioDeviceUsage -> m AudioDeviceUsage
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AudioDeviceUsage -> m AudioDeviceUsage
Data, Int -> AudioDeviceUsage
AudioDeviceUsage -> Int
AudioDeviceUsage -> [AudioDeviceUsage]
AudioDeviceUsage -> AudioDeviceUsage
AudioDeviceUsage -> AudioDeviceUsage -> [AudioDeviceUsage]
AudioDeviceUsage
-> AudioDeviceUsage -> AudioDeviceUsage -> [AudioDeviceUsage]
(AudioDeviceUsage -> AudioDeviceUsage)
-> (AudioDeviceUsage -> AudioDeviceUsage)
-> (Int -> AudioDeviceUsage)
-> (AudioDeviceUsage -> Int)
-> (AudioDeviceUsage -> [AudioDeviceUsage])
-> (AudioDeviceUsage -> AudioDeviceUsage -> [AudioDeviceUsage])
-> (AudioDeviceUsage -> AudioDeviceUsage -> [AudioDeviceUsage])
-> (AudioDeviceUsage
-> AudioDeviceUsage -> AudioDeviceUsage -> [AudioDeviceUsage])
-> Enum AudioDeviceUsage
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: AudioDeviceUsage -> AudioDeviceUsage
succ :: AudioDeviceUsage -> AudioDeviceUsage
$cpred :: AudioDeviceUsage -> AudioDeviceUsage
pred :: AudioDeviceUsage -> AudioDeviceUsage
$ctoEnum :: Int -> AudioDeviceUsage
toEnum :: Int -> AudioDeviceUsage
$cfromEnum :: AudioDeviceUsage -> Int
fromEnum :: AudioDeviceUsage -> Int
$cenumFrom :: AudioDeviceUsage -> [AudioDeviceUsage]
enumFrom :: AudioDeviceUsage -> [AudioDeviceUsage]
$cenumFromThen :: AudioDeviceUsage -> AudioDeviceUsage -> [AudioDeviceUsage]
enumFromThen :: AudioDeviceUsage -> AudioDeviceUsage -> [AudioDeviceUsage]
$cenumFromTo :: AudioDeviceUsage -> AudioDeviceUsage -> [AudioDeviceUsage]
enumFromTo :: AudioDeviceUsage -> AudioDeviceUsage -> [AudioDeviceUsage]
$cenumFromThenTo :: AudioDeviceUsage
-> AudioDeviceUsage -> AudioDeviceUsage -> [AudioDeviceUsage]
enumFromThenTo :: AudioDeviceUsage
-> AudioDeviceUsage -> AudioDeviceUsage -> [AudioDeviceUsage]
Enum, AudioDeviceUsage -> AudioDeviceUsage -> Bool
(AudioDeviceUsage -> AudioDeviceUsage -> Bool)
-> (AudioDeviceUsage -> AudioDeviceUsage -> Bool)
-> Eq AudioDeviceUsage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AudioDeviceUsage -> AudioDeviceUsage -> Bool
== :: AudioDeviceUsage -> AudioDeviceUsage -> Bool
$c/= :: AudioDeviceUsage -> AudioDeviceUsage -> Bool
/= :: AudioDeviceUsage -> AudioDeviceUsage -> Bool
Eq, (forall x. AudioDeviceUsage -> Rep AudioDeviceUsage x)
-> (forall x. Rep AudioDeviceUsage x -> AudioDeviceUsage)
-> Generic AudioDeviceUsage
forall x. Rep AudioDeviceUsage x -> AudioDeviceUsage
forall x. AudioDeviceUsage -> Rep AudioDeviceUsage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AudioDeviceUsage -> Rep AudioDeviceUsage x
from :: forall x. AudioDeviceUsage -> Rep AudioDeviceUsage x
$cto :: forall x. Rep AudioDeviceUsage x -> AudioDeviceUsage
to :: forall x. Rep AudioDeviceUsage x -> AudioDeviceUsage
Generic, Eq AudioDeviceUsage
Eq AudioDeviceUsage =>
(AudioDeviceUsage -> AudioDeviceUsage -> Ordering)
-> (AudioDeviceUsage -> AudioDeviceUsage -> Bool)
-> (AudioDeviceUsage -> AudioDeviceUsage -> Bool)
-> (AudioDeviceUsage -> AudioDeviceUsage -> Bool)
-> (AudioDeviceUsage -> AudioDeviceUsage -> Bool)
-> (AudioDeviceUsage -> AudioDeviceUsage -> AudioDeviceUsage)
-> (AudioDeviceUsage -> AudioDeviceUsage -> AudioDeviceUsage)
-> Ord AudioDeviceUsage
AudioDeviceUsage -> AudioDeviceUsage -> Bool
AudioDeviceUsage -> AudioDeviceUsage -> Ordering
AudioDeviceUsage -> AudioDeviceUsage -> AudioDeviceUsage
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AudioDeviceUsage -> AudioDeviceUsage -> Ordering
compare :: AudioDeviceUsage -> AudioDeviceUsage -> Ordering
$c< :: AudioDeviceUsage -> AudioDeviceUsage -> Bool
< :: AudioDeviceUsage -> AudioDeviceUsage -> Bool
$c<= :: AudioDeviceUsage -> AudioDeviceUsage -> Bool
<= :: AudioDeviceUsage -> AudioDeviceUsage -> Bool
$c> :: AudioDeviceUsage -> AudioDeviceUsage -> Bool
> :: AudioDeviceUsage -> AudioDeviceUsage -> Bool
$c>= :: AudioDeviceUsage -> AudioDeviceUsage -> Bool
>= :: AudioDeviceUsage -> AudioDeviceUsage -> Bool
$cmax :: AudioDeviceUsage -> AudioDeviceUsage -> AudioDeviceUsage
max :: AudioDeviceUsage -> AudioDeviceUsage -> AudioDeviceUsage
$cmin :: AudioDeviceUsage -> AudioDeviceUsage -> AudioDeviceUsage
min :: AudioDeviceUsage -> AudioDeviceUsage -> AudioDeviceUsage
Ord, ReadPrec [AudioDeviceUsage]
ReadPrec AudioDeviceUsage
Int -> ReadS AudioDeviceUsage
ReadS [AudioDeviceUsage]
(Int -> ReadS AudioDeviceUsage)
-> ReadS [AudioDeviceUsage]
-> ReadPrec AudioDeviceUsage
-> ReadPrec [AudioDeviceUsage]
-> Read AudioDeviceUsage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AudioDeviceUsage
readsPrec :: Int -> ReadS AudioDeviceUsage
$creadList :: ReadS [AudioDeviceUsage]
readList :: ReadS [AudioDeviceUsage]
$creadPrec :: ReadPrec AudioDeviceUsage
readPrec :: ReadPrec AudioDeviceUsage
$creadListPrec :: ReadPrec [AudioDeviceUsage]
readListPrec :: ReadPrec [AudioDeviceUsage]
Read, Int -> AudioDeviceUsage -> ShowS
[AudioDeviceUsage] -> ShowS
AudioDeviceUsage -> [Char]
(Int -> AudioDeviceUsage -> ShowS)
-> (AudioDeviceUsage -> [Char])
-> ([AudioDeviceUsage] -> ShowS)
-> Show AudioDeviceUsage
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AudioDeviceUsage -> ShowS
showsPrec :: Int -> AudioDeviceUsage -> ShowS
$cshow :: AudioDeviceUsage -> [Char]
show :: AudioDeviceUsage -> [Char]
$cshowList :: [AudioDeviceUsage] -> ShowS
showList :: [AudioDeviceUsage] -> ShowS
Show, Typeable)
encodeUsage :: Num a => AudioDeviceUsage -> a
encodeUsage :: forall a. Num a => AudioDeviceUsage -> a
encodeUsage AudioDeviceUsage
usage =
case AudioDeviceUsage
usage of
AudioDeviceUsage
ForPlayback -> a
0
AudioDeviceUsage
ForCapture -> a
1
data Changeable a
= Mandate !a
| Desire !a
deriving (Typeable (Changeable a)
Typeable (Changeable a) =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Changeable a -> c (Changeable a))
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Changeable a))
-> (Changeable a -> Constr)
-> (Changeable a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Changeable a)))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Changeable a)))
-> ((forall b. Data b => b -> b) -> Changeable a -> Changeable a)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Changeable a -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Changeable a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Changeable a -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> Changeable a -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Changeable a -> m (Changeable a))
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Changeable a -> m (Changeable a))
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Changeable a -> m (Changeable a))
-> Data (Changeable a)
Changeable a -> Constr
Changeable a -> DataType
(forall b. Data b => b -> b) -> Changeable a -> Changeable a
forall a. Data a => Typeable (Changeable a)
forall a. Data a => Changeable a -> Constr
forall a. Data a => Changeable a -> DataType
forall a.
Data a =>
(forall b. Data b => b -> b) -> Changeable a -> Changeable a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Changeable a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Changeable a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Changeable a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Changeable a -> r
forall a (m :: Type -> Type).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Changeable a -> m (Changeable a)
forall a (m :: Type -> Type).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Changeable a -> m (Changeable a)
forall a (c :: Type -> Type).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Changeable a)
forall a (c :: Type -> Type).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Changeable a -> c (Changeable a)
forall a (t :: Type -> Type) (c :: Type -> Type).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Changeable a))
forall a (t :: Type -> Type -> Type) (c :: Type -> Type).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Changeable a))
forall a.
Typeable a =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Changeable a -> u
forall u. (forall d. Data d => d -> u) -> Changeable a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Changeable a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Changeable a -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Changeable a -> m (Changeable a)
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Changeable a -> m (Changeable a)
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Changeable a)
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Changeable a -> c (Changeable a)
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Changeable a))
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Changeable a))
$cgfoldl :: forall a (c :: Type -> Type).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Changeable a -> c (Changeable a)
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Changeable a -> c (Changeable a)
$cgunfold :: forall a (c :: Type -> Type).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Changeable a)
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Changeable a)
$ctoConstr :: forall a. Data a => Changeable a -> Constr
toConstr :: Changeable a -> Constr
$cdataTypeOf :: forall a. Data a => Changeable a -> DataType
dataTypeOf :: Changeable a -> DataType
$cdataCast1 :: forall a (t :: Type -> Type) (c :: Type -> Type).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Changeable a))
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Changeable a))
$cdataCast2 :: forall a (t :: Type -> Type -> Type) (c :: Type -> Type).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Changeable a))
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Changeable a))
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Changeable a -> Changeable a
gmapT :: (forall b. Data b => b -> b) -> Changeable a -> Changeable a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Changeable a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Changeable a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Changeable a -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Changeable a -> r
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Changeable a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Changeable a -> [u]
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Changeable a -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Changeable a -> u
$cgmapM :: forall a (m :: Type -> Type).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Changeable a -> m (Changeable a)
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Changeable a -> m (Changeable a)
$cgmapMp :: forall a (m :: Type -> Type).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Changeable a -> m (Changeable a)
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Changeable a -> m (Changeable a)
$cgmapMo :: forall a (m :: Type -> Type).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Changeable a -> m (Changeable a)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Changeable a -> m (Changeable a)
Data, (forall m. Monoid m => Changeable m -> m)
-> (forall m a. Monoid m => (a -> m) -> Changeable a -> m)
-> (forall m a. Monoid m => (a -> m) -> Changeable a -> m)
-> (forall a b. (a -> b -> b) -> b -> Changeable a -> b)
-> (forall a b. (a -> b -> b) -> b -> Changeable a -> b)
-> (forall b a. (b -> a -> b) -> b -> Changeable a -> b)
-> (forall b a. (b -> a -> b) -> b -> Changeable a -> b)
-> (forall a. (a -> a -> a) -> Changeable a -> a)
-> (forall a. (a -> a -> a) -> Changeable a -> a)
-> (forall a. Changeable a -> [a])
-> (forall a. Changeable a -> Bool)
-> (forall a. Changeable a -> Int)
-> (forall a. Eq a => a -> Changeable a -> Bool)
-> (forall a. Ord a => Changeable a -> a)
-> (forall a. Ord a => Changeable a -> a)
-> (forall a. Num a => Changeable a -> a)
-> (forall a. Num a => Changeable a -> a)
-> Foldable Changeable
forall a. Eq a => a -> Changeable a -> Bool
forall a. Num a => Changeable a -> a
forall a. Ord a => Changeable a -> a
forall m. Monoid m => Changeable m -> m
forall a. Changeable a -> Bool
forall a. Changeable a -> Int
forall a. Changeable a -> [a]
forall a. (a -> a -> a) -> Changeable a -> a
forall m a. Monoid m => (a -> m) -> Changeable a -> m
forall b a. (b -> a -> b) -> b -> Changeable a -> b
forall a b. (a -> b -> b) -> b -> Changeable a -> b
forall (t :: Type -> Type).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Changeable m -> m
fold :: forall m. Monoid m => Changeable m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Changeable a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Changeable a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Changeable a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Changeable a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Changeable a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Changeable a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Changeable a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Changeable a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Changeable a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Changeable a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Changeable a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Changeable a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Changeable a -> a
foldr1 :: forall a. (a -> a -> a) -> Changeable a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Changeable a -> a
foldl1 :: forall a. (a -> a -> a) -> Changeable a -> a
$ctoList :: forall a. Changeable a -> [a]
toList :: forall a. Changeable a -> [a]
$cnull :: forall a. Changeable a -> Bool
null :: forall a. Changeable a -> Bool
$clength :: forall a. Changeable a -> Int
length :: forall a. Changeable a -> Int
$celem :: forall a. Eq a => a -> Changeable a -> Bool
elem :: forall a. Eq a => a -> Changeable a -> Bool
$cmaximum :: forall a. Ord a => Changeable a -> a
maximum :: forall a. Ord a => Changeable a -> a
$cminimum :: forall a. Ord a => Changeable a -> a
minimum :: forall a. Ord a => Changeable a -> a
$csum :: forall a. Num a => Changeable a -> a
sum :: forall a. Num a => Changeable a -> a
$cproduct :: forall a. Num a => Changeable a -> a
product :: forall a. Num a => Changeable a -> a
Foldable, (forall a b. (a -> b) -> Changeable a -> Changeable b)
-> (forall a b. a -> Changeable b -> Changeable a)
-> Functor Changeable
forall a b. a -> Changeable b -> Changeable a
forall a b. (a -> b) -> Changeable a -> Changeable b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Changeable a -> Changeable b
fmap :: forall a b. (a -> b) -> Changeable a -> Changeable b
$c<$ :: forall a b. a -> Changeable b -> Changeable a
<$ :: forall a b. a -> Changeable b -> Changeable a
Functor, Changeable a -> Changeable a -> Bool
(Changeable a -> Changeable a -> Bool)
-> (Changeable a -> Changeable a -> Bool) -> Eq (Changeable a)
forall a. Eq a => Changeable a -> Changeable a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Changeable a -> Changeable a -> Bool
== :: Changeable a -> Changeable a -> Bool
$c/= :: forall a. Eq a => Changeable a -> Changeable a -> Bool
/= :: Changeable a -> Changeable a -> Bool
Eq, (forall x. Changeable a -> Rep (Changeable a) x)
-> (forall x. Rep (Changeable a) x -> Changeable a)
-> Generic (Changeable a)
forall x. Rep (Changeable a) x -> Changeable a
forall x. Changeable a -> Rep (Changeable a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Changeable a) x -> Changeable a
forall a x. Changeable a -> Rep (Changeable a) x
$cfrom :: forall a x. Changeable a -> Rep (Changeable a) x
from :: forall x. Changeable a -> Rep (Changeable a) x
$cto :: forall a x. Rep (Changeable a) x -> Changeable a
to :: forall x. Rep (Changeable a) x -> Changeable a
Generic, ReadPrec [Changeable a]
ReadPrec (Changeable a)
Int -> ReadS (Changeable a)
ReadS [Changeable a]
(Int -> ReadS (Changeable a))
-> ReadS [Changeable a]
-> ReadPrec (Changeable a)
-> ReadPrec [Changeable a]
-> Read (Changeable a)
forall a. Read a => ReadPrec [Changeable a]
forall a. Read a => ReadPrec (Changeable a)
forall a. Read a => Int -> ReadS (Changeable a)
forall a. Read a => ReadS [Changeable a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (Changeable a)
readsPrec :: Int -> ReadS (Changeable a)
$creadList :: forall a. Read a => ReadS [Changeable a]
readList :: ReadS [Changeable a]
$creadPrec :: forall a. Read a => ReadPrec (Changeable a)
readPrec :: ReadPrec (Changeable a)
$creadListPrec :: forall a. Read a => ReadPrec [Changeable a]
readListPrec :: ReadPrec [Changeable a]
Read, Int -> Changeable a -> ShowS
[Changeable a] -> ShowS
Changeable a -> [Char]
(Int -> Changeable a -> ShowS)
-> (Changeable a -> [Char])
-> ([Changeable a] -> ShowS)
-> Show (Changeable a)
forall a. Show a => Int -> Changeable a -> ShowS
forall a. Show a => [Changeable a] -> ShowS
forall a. Show a => Changeable a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Changeable a -> ShowS
showsPrec :: Int -> Changeable a -> ShowS
$cshow :: forall a. Show a => Changeable a -> [Char]
show :: Changeable a -> [Char]
$cshowList :: forall a. Show a => [Changeable a] -> ShowS
showList :: [Changeable a] -> ShowS
Show, Functor Changeable
Foldable Changeable
(Functor Changeable, Foldable Changeable) =>
(forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Changeable a -> f (Changeable b))
-> (forall (f :: Type -> Type) a.
Applicative f =>
Changeable (f a) -> f (Changeable a))
-> (forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> Changeable a -> m (Changeable b))
-> (forall (m :: Type -> Type) a.
Monad m =>
Changeable (m a) -> m (Changeable a))
-> Traversable Changeable
forall (t :: Type -> Type).
(Functor t, Foldable t) =>
(forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: Type -> Type) a.
Applicative f =>
t (f a) -> f (t a))
-> (forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: Type -> Type) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: Type -> Type) a.
Monad m =>
Changeable (m a) -> m (Changeable a)
forall (f :: Type -> Type) a.
Applicative f =>
Changeable (f a) -> f (Changeable a)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> Changeable a -> m (Changeable b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Changeable a -> f (Changeable b)
$ctraverse :: forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Changeable a -> f (Changeable b)
traverse :: forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Changeable a -> f (Changeable b)
$csequenceA :: forall (f :: Type -> Type) a.
Applicative f =>
Changeable (f a) -> f (Changeable a)
sequenceA :: forall (f :: Type -> Type) a.
Applicative f =>
Changeable (f a) -> f (Changeable a)
$cmapM :: forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> Changeable a -> m (Changeable b)
mapM :: forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> Changeable a -> m (Changeable b)
$csequence :: forall (m :: Type -> Type) a.
Monad m =>
Changeable (m a) -> m (Changeable a)
sequence :: forall (m :: Type -> Type) a.
Monad m =>
Changeable (m a) -> m (Changeable a)
Traversable, Typeable)
foldChangeable :: (a -> b) -> (a -> b) -> Changeable a -> b
foldChangeable :: forall a b. (a -> b) -> (a -> b) -> Changeable a -> b
foldChangeable a -> b
f a -> b
_ (Mandate a
a) = a -> b
f a
a
foldChangeable a -> b
_ a -> b
g (Desire a
a) = a -> b
g a
a
unpackChangeable :: Changeable a -> a
unpackChangeable :: forall a. Changeable a -> a
unpackChangeable = (a -> a) -> (a -> a) -> Changeable a -> a
forall a b. (a -> b) -> (a -> b) -> Changeable a -> b
foldChangeable a -> a
forall a. a -> a
id a -> a
forall a. a -> a
id
data LockState
= Locked
| Unlocked
deriving (LockState
LockState -> LockState -> Bounded LockState
forall a. a -> a -> Bounded a
$cminBound :: LockState
minBound :: LockState
$cmaxBound :: LockState
maxBound :: LockState
Bounded, Typeable LockState
Typeable LockState =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LockState -> c LockState)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LockState)
-> (LockState -> Constr)
-> (LockState -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LockState))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LockState))
-> ((forall b. Data b => b -> b) -> LockState -> LockState)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LockState -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LockState -> r)
-> (forall u. (forall d. Data d => d -> u) -> LockState -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> LockState -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> LockState -> m LockState)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LockState -> m LockState)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LockState -> m LockState)
-> Data LockState
LockState -> Constr
LockState -> DataType
(forall b. Data b => b -> b) -> LockState -> LockState
forall a.
Typeable a =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> LockState -> u
forall u. (forall d. Data d => d -> u) -> LockState -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LockState -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LockState -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> LockState -> m LockState
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LockState -> m LockState
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LockState
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LockState -> c LockState
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LockState)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LockState)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LockState -> c LockState
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LockState -> c LockState
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LockState
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LockState
$ctoConstr :: LockState -> Constr
toConstr :: LockState -> Constr
$cdataTypeOf :: LockState -> DataType
dataTypeOf :: LockState -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LockState)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LockState)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LockState)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LockState)
$cgmapT :: (forall b. Data b => b -> b) -> LockState -> LockState
gmapT :: (forall b. Data b => b -> b) -> LockState -> LockState
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LockState -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LockState -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LockState -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LockState -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LockState -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> LockState -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LockState -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LockState -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> LockState -> m LockState
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> LockState -> m LockState
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LockState -> m LockState
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LockState -> m LockState
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LockState -> m LockState
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LockState -> m LockState
Data, Int -> LockState
LockState -> Int
LockState -> [LockState]
LockState -> LockState
LockState -> LockState -> [LockState]
LockState -> LockState -> LockState -> [LockState]
(LockState -> LockState)
-> (LockState -> LockState)
-> (Int -> LockState)
-> (LockState -> Int)
-> (LockState -> [LockState])
-> (LockState -> LockState -> [LockState])
-> (LockState -> LockState -> [LockState])
-> (LockState -> LockState -> LockState -> [LockState])
-> Enum LockState
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: LockState -> LockState
succ :: LockState -> LockState
$cpred :: LockState -> LockState
pred :: LockState -> LockState
$ctoEnum :: Int -> LockState
toEnum :: Int -> LockState
$cfromEnum :: LockState -> Int
fromEnum :: LockState -> Int
$cenumFrom :: LockState -> [LockState]
enumFrom :: LockState -> [LockState]
$cenumFromThen :: LockState -> LockState -> [LockState]
enumFromThen :: LockState -> LockState -> [LockState]
$cenumFromTo :: LockState -> LockState -> [LockState]
enumFromTo :: LockState -> LockState -> [LockState]
$cenumFromThenTo :: LockState -> LockState -> LockState -> [LockState]
enumFromThenTo :: LockState -> LockState -> LockState -> [LockState]
Enum, LockState -> LockState -> Bool
(LockState -> LockState -> Bool)
-> (LockState -> LockState -> Bool) -> Eq LockState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LockState -> LockState -> Bool
== :: LockState -> LockState -> Bool
$c/= :: LockState -> LockState -> Bool
/= :: LockState -> LockState -> Bool
Eq, (forall x. LockState -> Rep LockState x)
-> (forall x. Rep LockState x -> LockState) -> Generic LockState
forall x. Rep LockState x -> LockState
forall x. LockState -> Rep LockState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LockState -> Rep LockState x
from :: forall x. LockState -> Rep LockState x
$cto :: forall x. Rep LockState x -> LockState
to :: forall x. Rep LockState x -> LockState
Generic, Eq LockState
Eq LockState =>
(LockState -> LockState -> Ordering)
-> (LockState -> LockState -> Bool)
-> (LockState -> LockState -> Bool)
-> (LockState -> LockState -> Bool)
-> (LockState -> LockState -> Bool)
-> (LockState -> LockState -> LockState)
-> (LockState -> LockState -> LockState)
-> Ord LockState
LockState -> LockState -> Bool
LockState -> LockState -> Ordering
LockState -> LockState -> LockState
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: LockState -> LockState -> Ordering
compare :: LockState -> LockState -> Ordering
$c< :: LockState -> LockState -> Bool
< :: LockState -> LockState -> Bool
$c<= :: LockState -> LockState -> Bool
<= :: LockState -> LockState -> Bool
$c> :: LockState -> LockState -> Bool
> :: LockState -> LockState -> Bool
$c>= :: LockState -> LockState -> Bool
>= :: LockState -> LockState -> Bool
$cmax :: LockState -> LockState -> LockState
max :: LockState -> LockState -> LockState
$cmin :: LockState -> LockState -> LockState
min :: LockState -> LockState -> LockState
Ord, ReadPrec [LockState]
ReadPrec LockState
Int -> ReadS LockState
ReadS [LockState]
(Int -> ReadS LockState)
-> ReadS [LockState]
-> ReadPrec LockState
-> ReadPrec [LockState]
-> Read LockState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS LockState
readsPrec :: Int -> ReadS LockState
$creadList :: ReadS [LockState]
readList :: ReadS [LockState]
$creadPrec :: ReadPrec LockState
readPrec :: ReadPrec LockState
$creadListPrec :: ReadPrec [LockState]
readListPrec :: ReadPrec [LockState]
Read, Int -> LockState -> ShowS
[LockState] -> ShowS
LockState -> [Char]
(Int -> LockState -> ShowS)
-> (LockState -> [Char])
-> ([LockState] -> ShowS)
-> Show LockState
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LockState -> ShowS
showsPrec :: Int -> LockState -> ShowS
$cshow :: LockState -> [Char]
show :: LockState -> [Char]
$cshowList :: [LockState] -> ShowS
showList :: [LockState] -> ShowS
Show, Typeable)
setAudioDeviceLocked :: MonadIO m => AudioDevice -> LockState -> m ()
setAudioDeviceLocked :: forall (m :: Type -> Type).
MonadIO m =>
AudioDevice -> LockState -> m ()
setAudioDeviceLocked (AudioDevice Word32
d) LockState
Locked = Word32 -> m ()
forall (m :: Type -> Type). MonadIO m => Word32 -> m ()
Raw.lockAudioDevice Word32
d
setAudioDeviceLocked (AudioDevice Word32
d) LockState
Unlocked = Word32 -> m ()
forall (m :: Type -> Type). MonadIO m => Word32 -> m ()
Raw.unlockAudioDevice Word32
d
data PlaybackState
= Pause
| Play
deriving (PlaybackState
PlaybackState -> PlaybackState -> Bounded PlaybackState
forall a. a -> a -> Bounded a
$cminBound :: PlaybackState
minBound :: PlaybackState
$cmaxBound :: PlaybackState
maxBound :: PlaybackState
Bounded, Int -> PlaybackState
PlaybackState -> Int
PlaybackState -> [PlaybackState]
PlaybackState -> PlaybackState
PlaybackState -> PlaybackState -> [PlaybackState]
PlaybackState -> PlaybackState -> PlaybackState -> [PlaybackState]
(PlaybackState -> PlaybackState)
-> (PlaybackState -> PlaybackState)
-> (Int -> PlaybackState)
-> (PlaybackState -> Int)
-> (PlaybackState -> [PlaybackState])
-> (PlaybackState -> PlaybackState -> [PlaybackState])
-> (PlaybackState -> PlaybackState -> [PlaybackState])
-> (PlaybackState
-> PlaybackState -> PlaybackState -> [PlaybackState])
-> Enum PlaybackState
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PlaybackState -> PlaybackState
succ :: PlaybackState -> PlaybackState
$cpred :: PlaybackState -> PlaybackState
pred :: PlaybackState -> PlaybackState
$ctoEnum :: Int -> PlaybackState
toEnum :: Int -> PlaybackState
$cfromEnum :: PlaybackState -> Int
fromEnum :: PlaybackState -> Int
$cenumFrom :: PlaybackState -> [PlaybackState]
enumFrom :: PlaybackState -> [PlaybackState]
$cenumFromThen :: PlaybackState -> PlaybackState -> [PlaybackState]
enumFromThen :: PlaybackState -> PlaybackState -> [PlaybackState]
$cenumFromTo :: PlaybackState -> PlaybackState -> [PlaybackState]
enumFromTo :: PlaybackState -> PlaybackState -> [PlaybackState]
$cenumFromThenTo :: PlaybackState -> PlaybackState -> PlaybackState -> [PlaybackState]
enumFromThenTo :: PlaybackState -> PlaybackState -> PlaybackState -> [PlaybackState]
Enum, PlaybackState -> PlaybackState -> Bool
(PlaybackState -> PlaybackState -> Bool)
-> (PlaybackState -> PlaybackState -> Bool) -> Eq PlaybackState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PlaybackState -> PlaybackState -> Bool
== :: PlaybackState -> PlaybackState -> Bool
$c/= :: PlaybackState -> PlaybackState -> Bool
/= :: PlaybackState -> PlaybackState -> Bool
Eq, Eq PlaybackState
Eq PlaybackState =>
(PlaybackState -> PlaybackState -> Ordering)
-> (PlaybackState -> PlaybackState -> Bool)
-> (PlaybackState -> PlaybackState -> Bool)
-> (PlaybackState -> PlaybackState -> Bool)
-> (PlaybackState -> PlaybackState -> Bool)
-> (PlaybackState -> PlaybackState -> PlaybackState)
-> (PlaybackState -> PlaybackState -> PlaybackState)
-> Ord PlaybackState
PlaybackState -> PlaybackState -> Bool
PlaybackState -> PlaybackState -> Ordering
PlaybackState -> PlaybackState -> PlaybackState
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PlaybackState -> PlaybackState -> Ordering
compare :: PlaybackState -> PlaybackState -> Ordering
$c< :: PlaybackState -> PlaybackState -> Bool
< :: PlaybackState -> PlaybackState -> Bool
$c<= :: PlaybackState -> PlaybackState -> Bool
<= :: PlaybackState -> PlaybackState -> Bool
$c> :: PlaybackState -> PlaybackState -> Bool
> :: PlaybackState -> PlaybackState -> Bool
$c>= :: PlaybackState -> PlaybackState -> Bool
>= :: PlaybackState -> PlaybackState -> Bool
$cmax :: PlaybackState -> PlaybackState -> PlaybackState
max :: PlaybackState -> PlaybackState -> PlaybackState
$cmin :: PlaybackState -> PlaybackState -> PlaybackState
min :: PlaybackState -> PlaybackState -> PlaybackState
Ord, ReadPrec [PlaybackState]
ReadPrec PlaybackState
Int -> ReadS PlaybackState
ReadS [PlaybackState]
(Int -> ReadS PlaybackState)
-> ReadS [PlaybackState]
-> ReadPrec PlaybackState
-> ReadPrec [PlaybackState]
-> Read PlaybackState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PlaybackState
readsPrec :: Int -> ReadS PlaybackState
$creadList :: ReadS [PlaybackState]
readList :: ReadS [PlaybackState]
$creadPrec :: ReadPrec PlaybackState
readPrec :: ReadPrec PlaybackState
$creadListPrec :: ReadPrec [PlaybackState]
readListPrec :: ReadPrec [PlaybackState]
Read, Typeable PlaybackState
Typeable PlaybackState =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PlaybackState -> c PlaybackState)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PlaybackState)
-> (PlaybackState -> Constr)
-> (PlaybackState -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PlaybackState))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PlaybackState))
-> ((forall b. Data b => b -> b) -> PlaybackState -> PlaybackState)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PlaybackState -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PlaybackState -> r)
-> (forall u. (forall d. Data d => d -> u) -> PlaybackState -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> PlaybackState -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> PlaybackState -> m PlaybackState)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PlaybackState -> m PlaybackState)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PlaybackState -> m PlaybackState)
-> Data PlaybackState
PlaybackState -> Constr
PlaybackState -> DataType
(forall b. Data b => b -> b) -> PlaybackState -> PlaybackState
forall a.
Typeable a =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PlaybackState -> u
forall u. (forall d. Data d => d -> u) -> PlaybackState -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PlaybackState -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PlaybackState -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> PlaybackState -> m PlaybackState
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PlaybackState -> m PlaybackState
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PlaybackState
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PlaybackState -> c PlaybackState
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PlaybackState)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PlaybackState)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PlaybackState -> c PlaybackState
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PlaybackState -> c PlaybackState
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PlaybackState
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PlaybackState
$ctoConstr :: PlaybackState -> Constr
toConstr :: PlaybackState -> Constr
$cdataTypeOf :: PlaybackState -> DataType
dataTypeOf :: PlaybackState -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PlaybackState)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PlaybackState)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PlaybackState)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PlaybackState)
$cgmapT :: (forall b. Data b => b -> b) -> PlaybackState -> PlaybackState
gmapT :: (forall b. Data b => b -> b) -> PlaybackState -> PlaybackState
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PlaybackState -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PlaybackState -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PlaybackState -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PlaybackState -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PlaybackState -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PlaybackState -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PlaybackState -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PlaybackState -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> PlaybackState -> m PlaybackState
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> PlaybackState -> m PlaybackState
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PlaybackState -> m PlaybackState
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PlaybackState -> m PlaybackState
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PlaybackState -> m PlaybackState
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PlaybackState -> m PlaybackState
Data, (forall x. PlaybackState -> Rep PlaybackState x)
-> (forall x. Rep PlaybackState x -> PlaybackState)
-> Generic PlaybackState
forall x. Rep PlaybackState x -> PlaybackState
forall x. PlaybackState -> Rep PlaybackState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PlaybackState -> Rep PlaybackState x
from :: forall x. PlaybackState -> Rep PlaybackState x
$cto :: forall x. Rep PlaybackState x -> PlaybackState
to :: forall x. Rep PlaybackState x -> PlaybackState
Generic, Int -> PlaybackState -> ShowS
[PlaybackState] -> ShowS
PlaybackState -> [Char]
(Int -> PlaybackState -> ShowS)
-> (PlaybackState -> [Char])
-> ([PlaybackState] -> ShowS)
-> Show PlaybackState
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PlaybackState -> ShowS
showsPrec :: Int -> PlaybackState -> ShowS
$cshow :: PlaybackState -> [Char]
show :: PlaybackState -> [Char]
$cshowList :: [PlaybackState] -> ShowS
showList :: [PlaybackState] -> ShowS
Show, Typeable)
setAudioDevicePlaybackState :: MonadIO m => AudioDevice -> PlaybackState -> m ()
setAudioDevicePlaybackState :: forall (m :: Type -> Type).
MonadIO m =>
AudioDevice -> PlaybackState -> m ()
setAudioDevicePlaybackState (AudioDevice Word32
d) PlaybackState
Pause = Word32 -> CInt -> m ()
forall (m :: Type -> Type). MonadIO m => Word32 -> CInt -> m ()
Raw.pauseAudioDevice Word32
d CInt
1
setAudioDevicePlaybackState (AudioDevice Word32
d) PlaybackState
Play = Word32 -> CInt -> m ()
forall (m :: Type -> Type). MonadIO m => Word32 -> CInt -> m ()
Raw.pauseAudioDevice Word32
d CInt
0
data AudioDeviceStatus
= Playing
| Paused
| Stopped
deriving (AudioDeviceStatus
AudioDeviceStatus -> AudioDeviceStatus -> Bounded AudioDeviceStatus
forall a. a -> a -> Bounded a
$cminBound :: AudioDeviceStatus
minBound :: AudioDeviceStatus
$cmaxBound :: AudioDeviceStatus
maxBound :: AudioDeviceStatus
Bounded, Int -> AudioDeviceStatus
AudioDeviceStatus -> Int
AudioDeviceStatus -> [AudioDeviceStatus]
AudioDeviceStatus -> AudioDeviceStatus
AudioDeviceStatus -> AudioDeviceStatus -> [AudioDeviceStatus]
AudioDeviceStatus
-> AudioDeviceStatus -> AudioDeviceStatus -> [AudioDeviceStatus]
(AudioDeviceStatus -> AudioDeviceStatus)
-> (AudioDeviceStatus -> AudioDeviceStatus)
-> (Int -> AudioDeviceStatus)
-> (AudioDeviceStatus -> Int)
-> (AudioDeviceStatus -> [AudioDeviceStatus])
-> (AudioDeviceStatus -> AudioDeviceStatus -> [AudioDeviceStatus])
-> (AudioDeviceStatus -> AudioDeviceStatus -> [AudioDeviceStatus])
-> (AudioDeviceStatus
-> AudioDeviceStatus -> AudioDeviceStatus -> [AudioDeviceStatus])
-> Enum AudioDeviceStatus
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: AudioDeviceStatus -> AudioDeviceStatus
succ :: AudioDeviceStatus -> AudioDeviceStatus
$cpred :: AudioDeviceStatus -> AudioDeviceStatus
pred :: AudioDeviceStatus -> AudioDeviceStatus
$ctoEnum :: Int -> AudioDeviceStatus
toEnum :: Int -> AudioDeviceStatus
$cfromEnum :: AudioDeviceStatus -> Int
fromEnum :: AudioDeviceStatus -> Int
$cenumFrom :: AudioDeviceStatus -> [AudioDeviceStatus]
enumFrom :: AudioDeviceStatus -> [AudioDeviceStatus]
$cenumFromThen :: AudioDeviceStatus -> AudioDeviceStatus -> [AudioDeviceStatus]
enumFromThen :: AudioDeviceStatus -> AudioDeviceStatus -> [AudioDeviceStatus]
$cenumFromTo :: AudioDeviceStatus -> AudioDeviceStatus -> [AudioDeviceStatus]
enumFromTo :: AudioDeviceStatus -> AudioDeviceStatus -> [AudioDeviceStatus]
$cenumFromThenTo :: AudioDeviceStatus
-> AudioDeviceStatus -> AudioDeviceStatus -> [AudioDeviceStatus]
enumFromThenTo :: AudioDeviceStatus
-> AudioDeviceStatus -> AudioDeviceStatus -> [AudioDeviceStatus]
Enum, AudioDeviceStatus -> AudioDeviceStatus -> Bool
(AudioDeviceStatus -> AudioDeviceStatus -> Bool)
-> (AudioDeviceStatus -> AudioDeviceStatus -> Bool)
-> Eq AudioDeviceStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AudioDeviceStatus -> AudioDeviceStatus -> Bool
== :: AudioDeviceStatus -> AudioDeviceStatus -> Bool
$c/= :: AudioDeviceStatus -> AudioDeviceStatus -> Bool
/= :: AudioDeviceStatus -> AudioDeviceStatus -> Bool
Eq, Eq AudioDeviceStatus
Eq AudioDeviceStatus =>
(AudioDeviceStatus -> AudioDeviceStatus -> Ordering)
-> (AudioDeviceStatus -> AudioDeviceStatus -> Bool)
-> (AudioDeviceStatus -> AudioDeviceStatus -> Bool)
-> (AudioDeviceStatus -> AudioDeviceStatus -> Bool)
-> (AudioDeviceStatus -> AudioDeviceStatus -> Bool)
-> (AudioDeviceStatus -> AudioDeviceStatus -> AudioDeviceStatus)
-> (AudioDeviceStatus -> AudioDeviceStatus -> AudioDeviceStatus)
-> Ord AudioDeviceStatus
AudioDeviceStatus -> AudioDeviceStatus -> Bool
AudioDeviceStatus -> AudioDeviceStatus -> Ordering
AudioDeviceStatus -> AudioDeviceStatus -> AudioDeviceStatus
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AudioDeviceStatus -> AudioDeviceStatus -> Ordering
compare :: AudioDeviceStatus -> AudioDeviceStatus -> Ordering
$c< :: AudioDeviceStatus -> AudioDeviceStatus -> Bool
< :: AudioDeviceStatus -> AudioDeviceStatus -> Bool
$c<= :: AudioDeviceStatus -> AudioDeviceStatus -> Bool
<= :: AudioDeviceStatus -> AudioDeviceStatus -> Bool
$c> :: AudioDeviceStatus -> AudioDeviceStatus -> Bool
> :: AudioDeviceStatus -> AudioDeviceStatus -> Bool
$c>= :: AudioDeviceStatus -> AudioDeviceStatus -> Bool
>= :: AudioDeviceStatus -> AudioDeviceStatus -> Bool
$cmax :: AudioDeviceStatus -> AudioDeviceStatus -> AudioDeviceStatus
max :: AudioDeviceStatus -> AudioDeviceStatus -> AudioDeviceStatus
$cmin :: AudioDeviceStatus -> AudioDeviceStatus -> AudioDeviceStatus
min :: AudioDeviceStatus -> AudioDeviceStatus -> AudioDeviceStatus
Ord, ReadPrec [AudioDeviceStatus]
ReadPrec AudioDeviceStatus
Int -> ReadS AudioDeviceStatus
ReadS [AudioDeviceStatus]
(Int -> ReadS AudioDeviceStatus)
-> ReadS [AudioDeviceStatus]
-> ReadPrec AudioDeviceStatus
-> ReadPrec [AudioDeviceStatus]
-> Read AudioDeviceStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AudioDeviceStatus
readsPrec :: Int -> ReadS AudioDeviceStatus
$creadList :: ReadS [AudioDeviceStatus]
readList :: ReadS [AudioDeviceStatus]
$creadPrec :: ReadPrec AudioDeviceStatus
readPrec :: ReadPrec AudioDeviceStatus
$creadListPrec :: ReadPrec [AudioDeviceStatus]
readListPrec :: ReadPrec [AudioDeviceStatus]
Read, Typeable AudioDeviceStatus
Typeable AudioDeviceStatus =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AudioDeviceStatus
-> c AudioDeviceStatus)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AudioDeviceStatus)
-> (AudioDeviceStatus -> Constr)
-> (AudioDeviceStatus -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AudioDeviceStatus))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AudioDeviceStatus))
-> ((forall b. Data b => b -> b)
-> AudioDeviceStatus -> AudioDeviceStatus)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AudioDeviceStatus -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AudioDeviceStatus -> r)
-> (forall u.
(forall d. Data d => d -> u) -> AudioDeviceStatus -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> AudioDeviceStatus -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> AudioDeviceStatus -> m AudioDeviceStatus)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AudioDeviceStatus -> m AudioDeviceStatus)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AudioDeviceStatus -> m AudioDeviceStatus)
-> Data AudioDeviceStatus
AudioDeviceStatus -> Constr
AudioDeviceStatus -> DataType
(forall b. Data b => b -> b)
-> AudioDeviceStatus -> AudioDeviceStatus
forall a.
Typeable a =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> AudioDeviceStatus -> u
forall u. (forall d. Data d => d -> u) -> AudioDeviceStatus -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AudioDeviceStatus -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AudioDeviceStatus -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> AudioDeviceStatus -> m AudioDeviceStatus
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AudioDeviceStatus -> m AudioDeviceStatus
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AudioDeviceStatus
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AudioDeviceStatus -> c AudioDeviceStatus
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AudioDeviceStatus)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AudioDeviceStatus)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AudioDeviceStatus -> c AudioDeviceStatus
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AudioDeviceStatus -> c AudioDeviceStatus
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AudioDeviceStatus
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AudioDeviceStatus
$ctoConstr :: AudioDeviceStatus -> Constr
toConstr :: AudioDeviceStatus -> Constr
$cdataTypeOf :: AudioDeviceStatus -> DataType
dataTypeOf :: AudioDeviceStatus -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AudioDeviceStatus)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AudioDeviceStatus)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AudioDeviceStatus)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AudioDeviceStatus)
$cgmapT :: (forall b. Data b => b -> b)
-> AudioDeviceStatus -> AudioDeviceStatus
gmapT :: (forall b. Data b => b -> b)
-> AudioDeviceStatus -> AudioDeviceStatus
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AudioDeviceStatus -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AudioDeviceStatus -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AudioDeviceStatus -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AudioDeviceStatus -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AudioDeviceStatus -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> AudioDeviceStatus -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AudioDeviceStatus -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AudioDeviceStatus -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> AudioDeviceStatus -> m AudioDeviceStatus
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> AudioDeviceStatus -> m AudioDeviceStatus
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AudioDeviceStatus -> m AudioDeviceStatus
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AudioDeviceStatus -> m AudioDeviceStatus
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AudioDeviceStatus -> m AudioDeviceStatus
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AudioDeviceStatus -> m AudioDeviceStatus
Data, (forall x. AudioDeviceStatus -> Rep AudioDeviceStatus x)
-> (forall x. Rep AudioDeviceStatus x -> AudioDeviceStatus)
-> Generic AudioDeviceStatus
forall x. Rep AudioDeviceStatus x -> AudioDeviceStatus
forall x. AudioDeviceStatus -> Rep AudioDeviceStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AudioDeviceStatus -> Rep AudioDeviceStatus x
from :: forall x. AudioDeviceStatus -> Rep AudioDeviceStatus x
$cto :: forall x. Rep AudioDeviceStatus x -> AudioDeviceStatus
to :: forall x. Rep AudioDeviceStatus x -> AudioDeviceStatus
Generic, Int -> AudioDeviceStatus -> ShowS
[AudioDeviceStatus] -> ShowS
AudioDeviceStatus -> [Char]
(Int -> AudioDeviceStatus -> ShowS)
-> (AudioDeviceStatus -> [Char])
-> ([AudioDeviceStatus] -> ShowS)
-> Show AudioDeviceStatus
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AudioDeviceStatus -> ShowS
showsPrec :: Int -> AudioDeviceStatus -> ShowS
$cshow :: AudioDeviceStatus -> [Char]
show :: AudioDeviceStatus -> [Char]
$cshowList :: [AudioDeviceStatus] -> ShowS
showList :: [AudioDeviceStatus] -> ShowS
Show, Typeable)
audioDeviceStatus :: MonadIO m => AudioDevice -> m AudioDeviceStatus
audioDeviceStatus :: forall (m :: Type -> Type).
MonadIO m =>
AudioDevice -> m AudioDeviceStatus
audioDeviceStatus (AudioDevice Word32
d) = IO AudioDeviceStatus -> m AudioDeviceStatus
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO AudioDeviceStatus -> m AudioDeviceStatus)
-> IO AudioDeviceStatus -> m AudioDeviceStatus
forall a b. (a -> b) -> a -> b
$
Text
-> Text
-> (Word32 -> Maybe AudioDeviceStatus)
-> Word32
-> AudioDeviceStatus
forall a b. Show a => Text -> Text -> (a -> Maybe b) -> a -> b
fromC Text
"SDL.Audio.audioDeviceStatus" Text
"SDL_AudioStatus" Word32 -> Maybe AudioDeviceStatus
readStatus (Word32 -> AudioDeviceStatus) -> IO Word32 -> IO AudioDeviceStatus
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> IO Word32
forall (m :: Type -> Type). MonadIO m => Word32 -> m Word32
Raw.getAudioDeviceStatus Word32
d
where
readStatus :: Word32 -> Maybe AudioDeviceStatus
readStatus Word32
n = case Word32
n of
Word32
Raw.SDL_AUDIO_PLAYING -> AudioDeviceStatus -> Maybe AudioDeviceStatus
forall a. a -> Maybe a
Just AudioDeviceStatus
Playing
Word32
Raw.SDL_AUDIO_STOPPED -> AudioDeviceStatus -> Maybe AudioDeviceStatus
forall a. a -> Maybe a
Just AudioDeviceStatus
Stopped
Word32
Raw.SDL_AUDIO_PAUSED -> AudioDeviceStatus -> Maybe AudioDeviceStatus
forall a. a -> Maybe a
Just AudioDeviceStatus
Paused
Word32
_ -> Maybe AudioDeviceStatus
forall a. Maybe a
Nothing
newtype AudioDriver = AudioDriver Text
deriving (AudioDriver -> AudioDriver -> Bool
(AudioDriver -> AudioDriver -> Bool)
-> (AudioDriver -> AudioDriver -> Bool) -> Eq AudioDriver
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AudioDriver -> AudioDriver -> Bool
== :: AudioDriver -> AudioDriver -> Bool
$c/= :: AudioDriver -> AudioDriver -> Bool
/= :: AudioDriver -> AudioDriver -> Bool
Eq, Int -> AudioDriver -> ShowS
[AudioDriver] -> ShowS
AudioDriver -> [Char]
(Int -> AudioDriver -> ShowS)
-> (AudioDriver -> [Char])
-> ([AudioDriver] -> ShowS)
-> Show AudioDriver
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AudioDriver -> ShowS
showsPrec :: Int -> AudioDriver -> ShowS
$cshow :: AudioDriver -> [Char]
show :: AudioDriver -> [Char]
$cshowList :: [AudioDriver] -> ShowS
showList :: [AudioDriver] -> ShowS
Show, Typeable)
audioDriverName :: AudioDriver -> Text
audioDriverName :: AudioDriver -> Text
audioDriverName (AudioDriver Text
t) = Text
t
getAudioDrivers :: MonadIO m => m (V.Vector AudioDriver)
getAudioDrivers :: forall (m :: Type -> Type). MonadIO m => m (Vector AudioDriver)
getAudioDrivers = IO (Vector AudioDriver) -> m (Vector AudioDriver)
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Vector AudioDriver) -> m (Vector AudioDriver))
-> IO (Vector AudioDriver) -> m (Vector AudioDriver)
forall a b. (a -> b) -> a -> b
$ do
CInt
n <- IO CInt
forall (m :: Type -> Type). MonadIO m => m CInt
Raw.getNumAudioDrivers
([AudioDriver] -> Vector AudioDriver)
-> IO [AudioDriver] -> IO (Vector AudioDriver)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [AudioDriver] -> Vector AudioDriver
forall a. [a] -> Vector a
V.fromList (IO [AudioDriver] -> IO (Vector AudioDriver))
-> IO [AudioDriver] -> IO (Vector AudioDriver)
forall a b. (a -> b) -> a -> b
$
[CInt] -> (CInt -> IO AudioDriver) -> IO [AudioDriver]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [CInt
0 .. (CInt
n CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1)] ((CInt -> IO AudioDriver) -> IO [AudioDriver])
-> (CInt -> IO AudioDriver) -> IO [AudioDriver]
forall a b. (a -> b) -> a -> b
$ \CInt
i -> do
Ptr CChar
cstr <- CInt -> IO (Ptr CChar)
forall (m :: Type -> Type). MonadIO m => CInt -> m (Ptr CChar)
Raw.getAudioDriver CInt
i
Text -> AudioDriver
AudioDriver (Text -> AudioDriver)
-> (ByteString -> Text) -> ByteString -> AudioDriver
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8 (ByteString -> AudioDriver) -> IO ByteString -> IO AudioDriver
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> IO ByteString
BS.packCString Ptr CChar
cstr
audioInit :: MonadIO m => AudioDriver -> m ()
audioInit :: forall (m :: Type -> Type). MonadIO m => AudioDriver -> m ()
audioInit (AudioDriver Text
n) = IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> (Ptr CChar -> IO ()) -> IO ()
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString (Text -> ByteString
Text.encodeUtf8 Text
n) ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> Text -> IO CInt -> IO ()
forall (m :: Type -> Type) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m ()
throwIfNeg_ Text
"SDL.Audio.audioInit" Text
"SDL_AudioInit" (IO CInt -> IO ()) -> (Ptr CChar -> IO CInt) -> Ptr CChar -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr CChar -> IO CInt
forall (m :: Type -> Type). MonadIO m => Ptr CChar -> m CInt
Raw.audioInit
currentAudioDriver :: MonadIO m => m (Maybe Text)
currentAudioDriver :: forall (m :: Type -> Type). MonadIO m => m (Maybe Text)
currentAudioDriver =
IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ (Ptr CChar -> IO Text) -> Ptr CChar -> IO (Maybe Text)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek ((ByteString -> Text) -> IO ByteString -> IO Text
forall a b. (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
Text.decodeUtf8 (IO ByteString -> IO Text)
-> (Ptr CChar -> IO ByteString) -> Ptr CChar -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr CChar -> IO ByteString
BS.packCString) (Ptr CChar -> IO (Maybe Text)) -> IO (Ptr CChar) -> IO (Maybe Text)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Ptr CChar)
forall (m :: Type -> Type). MonadIO m => m (Ptr CChar)
Raw.getCurrentAudioDriver