diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,5 @@
+# Revision history for pulseaudio
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,165 @@
+ GNU LESSER GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc.
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+ This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+ 0. Additional Definitions.
+
+ As used herein, "this License" refers to version 3 of the GNU Lesser
+General Public License, and the "GNU GPL" refers to version 3 of the GNU
+General Public License.
+
+ "The Library" refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+ An "Application" is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+ A "Combined Work" is a work produced by combining or linking an
+Application with the Library. The particular version of the Library
+with which the Combined Work was made is also called the "Linked
+Version".
+
+ The "Minimal Corresponding Source" for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+ The "Corresponding Application Code" for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+ 1. Exception to Section 3 of the GNU GPL.
+
+ You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+ 2. Conveying Modified Versions.
+
+ If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+ a) under this License, provided that you make a good faith effort to
+ ensure that, in the event an Application does not supply the
+ function or data, the facility still operates, and performs
+ whatever part of its purpose remains meaningful, or
+
+ b) under the GNU GPL, with none of the additional permissions of
+ this License applicable to that copy.
+
+ 3. Object Code Incorporating Material from Library Header Files.
+
+ The object code form of an Application may incorporate material from
+a header file that is part of the Library. You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+ a) Give prominent notice with each copy of the object code that the
+ Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the object code with a copy of the GNU GPL and this license
+ document.
+
+ 4. Combined Works.
+
+ You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+ a) Give prominent notice with each copy of the Combined Work that
+ the Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the Combined Work with a copy of the GNU GPL and this license
+ document.
+
+ c) For a Combined Work that displays copyright notices during
+ execution, include the copyright notice for the Library among
+ these notices, as well as a reference directing the user to the
+ copies of the GNU GPL and this license document.
+
+ d) Do one of the following:
+
+ 0) Convey the Minimal Corresponding Source under the terms of this
+ License, and the Corresponding Application Code in a form
+ suitable for, and under terms that permit, the user to
+ recombine or relink the Application with a modified version of
+ the Linked Version to produce a modified Combined Work, in the
+ manner specified by section 6 of the GNU GPL for conveying
+ Corresponding Source.
+
+ 1) Use a suitable shared library mechanism for linking with the
+ Library. A suitable mechanism is one that (a) uses at run time
+ a copy of the Library already present on the user's computer
+ system, and (b) will operate properly with a modified version
+ of the Library that is interface-compatible with the Linked
+ Version.
+
+ e) Provide Installation Information, but only if you would otherwise
+ be required to provide such information under section 6 of the
+ GNU GPL, and only to the extent that such information is
+ necessary to install and execute a modified version of the
+ Combined Work produced by recombining or relinking the
+ Application with a modified version of the Linked Version. (If
+ you use option 4d0, the Installation Information must accompany
+ the Minimal Corresponding Source and Corresponding Application
+ Code. If you use option 4d1, you must provide the Installation
+ Information in the manner specified by section 6 of the GNU GPL
+ for conveying Corresponding Source.)
+
+ 5. Combined Libraries.
+
+ You may place library facilities that are a work based on the
+Library side by side in a single library together with other library
+facilities that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+ a) Accompany the combined library with a copy of the same work based
+ on the Library, uncombined with any other library facilities,
+ conveyed under the terms of this License.
+
+ b) Give prominent notice with the combined library that part of it
+ is a work based on the Library, and explaining where to find the
+ accompanying uncombined form of the same work.
+
+ 6. Revised Versions of the GNU Lesser General Public License.
+
+ The Free Software Foundation may publish revised and/or new versions
+of the GNU Lesser General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the
+Library as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License "or any later version"
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+ If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/bin/Test.hs b/bin/Test.hs
new file mode 100644
--- /dev/null
+++ b/bin/Test.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+import Sound.Pulse.Context
+import Sound.Pulse.Mainloop.Simple
+
+import Data.Word (Word32)
+import Control.Monad (void)
+import Sound.Pulse.Mainloop
+import Sound.Pulse.Sinkinfo
+import Sound.Pulse.Subscribe
+import Sound.Pulse.Serverinfo
+import Sound.Pulse.Volume
+
+printSink :: Sinkinfo -> IO ()
+printSink sink = do
+ let vol = cVolumeToLinear $ siVolume sink
+ let base = volumeToLinear $ siBaseVolume sink
+ putStrLn . show $ map (\v -> v / base * 100) vol
+
+startLoop :: Context -> Sinkinfo -> IO ()
+startLoop cxt info = do
+ printSink info
+ void $ subscribeEvents cxt [SubscriptionMaskSink] fun
+ where fun :: ((SubscriptionEventFacility, SubscriptionEventType) -> Word32 -> IO ())
+ fun _ 0 = void $ getContextSinkByIndex cxt (siIndex info) printSink
+ fun _ _ = return ()
+
+getDefaultSink :: Context -> IO ()
+getDefaultSink cxt = void $ getServerInfo cxt fun
+ where fun :: ServerInfo -> IO ()
+ fun serv = let name = defaultSinkName serv in
+ do
+ putStrLn ("Default sink: " ++ name)
+ void $ getContextSinkByName cxt name (startLoop cxt)
+
+
+
+main :: IO ()
+main = do
+ impl <- getMainloopImpl
+ cxt <- getContext impl "hs-test"
+ setStateCallback cxt $ do
+ state <- getContextState cxt
+ putStrLn ("State: " ++ show state)
+ case state of
+ ContextFailed -> do
+ putStr "PulseError: "
+ putStrLn =<< getContextErrStr cxt
+ quitLoop impl =<< getContextErr cxt
+ ContextReady -> getDefaultSink cxt
+ _ -> return ()
+ connectContext cxt Nothing []
+ doLoop impl
diff --git a/pulseaudio.cabal b/pulseaudio.cabal
new file mode 100644
--- /dev/null
+++ b/pulseaudio.cabal
@@ -0,0 +1,134 @@
+-- Initial pulseaudio.cabal generated by cabal init. For further
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+-- The name of the package.
+name: pulseaudio
+
+-- The package version. See the Haskell package versioning policy (PVP)
+-- for standards guiding when and how versions should be incremented.
+-- https://wiki.haskell.org/Package_versioning_policy
+-- PVP summary: +-+------- breaking API changes
+-- | | +----- non-breaking API additions
+-- | | | +--- code changes with no API change
+version: 0.0.1.0
+
+-- A short (one-line) description of the package.
+synopsis: A low-level (incomplete) wrapper around the pulseaudio client asynchronous api
+
+-- A longer description of the package.
+description:
+ This package mainly exists, because I wanted to query the current system
+ volume from the pulse audio server.
+ .
+ Doing this required me to build at least the core of the pulse api.
+ .
+ This package is provided as is, with very little testing and only a small
+ subset of the pulse api implemented.
+ Expanding this package *should* be rather easy. At least for query/control.
+ If you are interested in doing this, but don't know how, feel free to contact me.
+ .
+ .
+ In package is a bit unrefined and rough. If you have better structure for
+ modules feel free to reorganize them and making a PR. This also means, don't
+ see this structur as fixed yet, it may change if someone has a better idea.
+
+-- The license under which the package is released.
+license: LGPL-3
+
+-- The file containing the license text.
+license-file: LICENSE
+
+-- The package author(s).
+author: Markus Ongyerth
+
+-- An email address to which users can send suggestions, bug reports, and
+-- patches.
+maintainer: ongy@ongy.net
+
+cabal-version: >=1.10
+
+-- A copyright notice.
+-- copyright:
+
+category: Sound
+
+build-type: Simple
+
+-- Extra files to be distributed with the package, such as examples or a
+-- README.
+extra-source-files: ChangeLog.md
+
+-- Constraint on the version of Cabal needed to build this package.
+cabal-version: >=1.10
+
+Source-repository head
+ type: git
+ location: https://github.com/ongy/pulseaudio
+
+
+executable pulse-test
+ buildable: False
+ -- .hs or .lhs file containing the Main module.
+ main-is: Test.hs
+ hs-source-dirs: bin
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- Other library packages from which modules are imported.
+ build-depends: base >=4.6.0.1 && <5, pulseaudio
+
+ -- Directories containing source files.
+ -- hs-source-dirs:
+
+ -- Base language which the package is written in.
+ default-language: Haskell2010
+
+ ghc-options: -Wall
+
+ extra-libraries: pulse
+
+library
+ -- Modules exported by the library.
+ exposed-modules: Sound.Pulse.Context
+ ,Sound.Pulse.Mainloop
+ ,Sound.Pulse.Mainloop.Simple
+ ,Data.Time
+ ,Sound.Pulse.Sinkinfo
+ ,Sound.Pulse.ChannelPosition
+ ,Sound.Pulse.SampleSpec
+ ,Sound.Pulse.Subscribe
+ ,Sound.Pulse.Operation
+ ,Sound.Pulse.Serverinfo
+ ,Sound.Pulse.Volume
+
+
+
+ -- Modules included in this library but not exported.
+ other-modules: Data.Time.Internal
+ ,Sound.Pulse.Userdata
+ ,Sound.Pulse.Def
+
+
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- Other library packages from which modules are imported.
+ build-depends: base >=4.6 && <4.10
+ ,unix
+ ,stm
+ ,containers
+
+ -- Directories containing source files.
+ hs-source-dirs: src
+
+ -- Base language which the package is written in.
+ default-language: Haskell2010
+
+ ghc-options: -Wall
diff --git a/src/Data/Time.hsc b/src/Data/Time.hsc
new file mode 100644
--- /dev/null
+++ b/src/Data/Time.hsc
@@ -0,0 +1,115 @@
+{-
+ Copyright 2016 Markus Ongyerth
+
+ This file is part of pulseaudio-hs.
+
+ Monky is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Lesser General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ Monky is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public License
+ along with pulseaudio-hs. If not, see .
+-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-|
+Module : Data.Time
+Description : provides the time type used by this package and a few functions on it
+Maintianer : ongy
+Stability : experimental
+
+-- Portability : Linux (Not quite sure if headers are specific, might be POSIX)
+
+Pulseaudio uses struct timeval for time. Since the time package on hackage does not
+export the internal functions, this module exports a type and functions for that
+type.
+-}
+module Data.Time
+ ( PATime
+ , getTime
+ , addSeconds
+ , addNSeconds
+ , addTimes
+ , getDiff
+ , timeToUS
+ , timeFromUS
+ , dummyTime
+
+ )
+where
+
+
+-- PATime is defined in here, for better hiding :)
+import Data.Time.Internal
+import Data.Word (Word)
+
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.Types
+import Foreign.Marshal.Alloc
+
+#include
+
+foreign import ccall unsafe "clock_gettime" clock_gettime :: CInt -> Ptr PATime -> IO CInt
+
+
+-- We don't take an clockid argument for now, this is PA use, not general time
+-- library
+-- |Get the current system time in real time (wallclock)
+getTime :: IO PATime
+getTime = alloca $ \ptr -> do
+ ret <- clock_gettime #{const CLOCK_REALTIME} ptr
+ if ret /= 0
+ then error "This should not happen, PAs getTime failed"
+ else peek ptr
+
+-- |Add seconds to a 'PATime'
+addSeconds :: Integral a => a -> PATime -> PATime
+addSeconds x (PATime s n) = (PATime (s + fromIntegral x) n)
+
+-- |Add nanoseconds to a 'PATime'
+addNSeconds :: Integral a => a -> PATime -> PATime
+addNSeconds x (PATime s n) =
+ let new = n + fromIntegral x
+ cap = 1000 * 1000 * 1000
+ over = if new > cap
+ then 1
+ else 0
+ capped = new `mod` cap
+ in PATime (s + over) capped
+
+-- |Add two 'PATime's together
+addTimes :: PATime -> PATime -> PATime
+addTimes (PATime s n) = addSeconds s . addNSeconds n
+
+-- |Get the difference between to times.
+getDiff :: PATime -> PATime -> PATime
+getDiff l@(PATime ls ln) r@(PATime rs rn) = if l < r
+ then error "PAs getDiff only works if the first argument is greater"
+ else let new = ln -rn
+ cap = 1000 * 1000 * 1000
+ over = if new < 0
+ then (-1)
+ else 0
+ capped = new `mod` cap
+ in PATime (ls - rs + over) capped
+
+-- |Convert from Microseconds to 'PATime'
+timeFromUS :: Word -> PATime
+timeFromUS x = let cap = 1000 * 1000 in
+ PATime (x `div` cap) $ fromIntegral (x `mod` cap * 1000)
+
+-- |Convert a 'PATime' to Microseconds
+timeToUS :: PATime -> Word
+timeToUS (PATime s ns) =
+ s * 1000 * 1000 + fromIntegral ns `div` 1000
+
+-- |A dummy time value, do not use to calculate, only if guaranteed to be
+-- ignored
+dummyTime :: PATime
+dummyTime = PATime 0 0
diff --git a/src/Data/Time/Internal.hsc b/src/Data/Time/Internal.hsc
new file mode 100644
--- /dev/null
+++ b/src/Data/Time/Internal.hsc
@@ -0,0 +1,81 @@
+{-
+ Copyright 2016 Markus Ongyerth
+
+ This file is part of pulseaudio-hs.
+
+ Monky is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Lesser General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ Monky is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public License
+ along with pulseaudio-hs. If not, see .
+-}
+{-# LANGUAGE ForeignFunctionInterface, CPP #-}
+{-|
+Module : Data.Time.Internal
+Description : Internal handling of time, and conversion between struct timeval and struct timespec
+Maintianer : ongy
+Stability : experimental
+-}
+module Data.Time.Internal
+ ( PAITime
+ , PATime(..)
+
+ , toPAI
+ , fromPAI
+ )
+where
+
+#if __GLASGOW_HASKELL__ < 800
+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
+#endif
+#include
+#include
+
+import Data.Word (Word)
+import Control.Applicative ((<$>), (<*>))
+import Foreign.Storable
+import Foreign.C.Types
+
+-- Seconds and nanoseconds, compare with struct timespec (clock-gettime)
+-- I'll make this Word Word, a few bytes more don't hurt that much
+-- |The time used by the library level api
+data PATime = PATime Word CLong deriving (Show, Eq, Ord)
+
+instance Storable PATime where
+ sizeOf _ = #{size struct timespec}
+ alignment _ = #{alignment struct timespec}
+ peek p = PATime
+ <$> #{peek struct timespec, tv_sec} p
+ <*> #{peek struct timespec, tv_nsec} p
+ poke p (PATime sec nsec) = do
+ #{poke struct timespec, tv_sec} p sec
+ #{poke struct timespec, tv_nsec} p nsec
+
+
+-- |Internal time struct used to convert to pulseaudio compatible format
+data PAITime = PAITime Word CLong deriving (Show, Eq, Ord)
+
+instance Storable PAITime where
+ sizeOf _ = #{size struct timeval}
+ alignment _ = #{alignment struct timeval}
+ peek p = PAITime
+ <$> #{peek struct timeval, tv_sec} p
+ <*> #{peek struct timeval, tv_usec} p
+ poke p (PAITime sec usec) = do
+ #{poke struct timeval, tv_sec} p sec
+ #{poke struct timeval, tv_usec} p usec
+
+-- |Convert from 'PATime' to 'PAITime' before passing to pulse
+toPAI :: PATime -> PAITime
+toPAI (PATime s ns) = PAITime s (ns `div` 1000)
+
+-- |Convert from 'PAITime' to 'PATime' after getting value form pulse
+fromPAI :: PAITime -> PATime
+fromPAI (PAITime s ns) = PATime s (ns * 1000)
diff --git a/src/Sound/Pulse/ChannelPosition.hsc b/src/Sound/Pulse/ChannelPosition.hsc
new file mode 100644
--- /dev/null
+++ b/src/Sound/Pulse/ChannelPosition.hsc
@@ -0,0 +1,57 @@
+{-
+ Copyright 2016 Markus Ongyerth
+
+ This file is part of pulseaudio-hs.
+
+ Monky is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Lesser General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ Monky is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public License
+ along with pulseaudio-hs. If not, see .
+-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RecordWildCards #-}
+{-|
+Module : sound.Pulse.ChannelPosition
+Description : Provides types for PA_CHANNEL_POSITION and pa_channel_map.
+Maintianer : ongy
+Stability : experimental
+-}
+module Sound.Pulse.ChannelPosition
+ ( ChannelPosition(..)
+ , ChannelMap(..)
+ )
+where
+#if __GLASGOW_HASKELL__ < 800
+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
+#endif
+#include
+
+import Data.List (genericLength)
+import Data.Word (Word8, Word)
+import Foreign.Ptr (plusPtr) -- #{ptr ...} needs this
+import Foreign.Storable (Storable(..))
+
+import Sound.Pulse.Def (ChannelPosition(..), channelPositionFromInt, channelPositionToInt)
+
+-- |The Type for ChannelMaps
+newtype ChannelMap = ChannelMap [ChannelPosition] deriving (Eq, Show)
+
+instance Storable ChannelMap where
+ sizeOf _ = #{size struct pa_channel_map}
+ alignment _ = #{alignment struct pa_channel_map}
+ peek p = do
+ size :: Word8 <- #{peek struct pa_channel_map, channels} p
+ ints <- mapM (peekElemOff (#{ptr struct pa_channel_map, map} p) . fromIntegral ) [0..size - 1]
+ return . ChannelMap $ map channelPositionFromInt ints
+ poke p (ChannelMap pos) = do
+ #{poke struct pa_channel_map, channels} p $ (genericLength pos :: Word8)
+ let indexd = zip [0..] (map channelPositionToInt pos)
+ mapM_ (uncurry (pokeElemOff (#{ptr struct pa_channel_map, map} p))) indexd
diff --git a/src/Sound/Pulse/Context.hs b/src/Sound/Pulse/Context.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/Pulse/Context.hs
@@ -0,0 +1,146 @@
+{-
+ Copyright 2016 Markus Ongyerth
+
+ This file is part of pulseaudio-hs.
+
+ Monky is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Lesser General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ Monky is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public License
+ along with pulseaudio-hs. If not, see .
+-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-|
+Module : Sound.Pulse.Context
+Description : provices the Context type and related functions
+Maintianer : ongy
+Stability : experimental
+
+The 'Context' is the main object for the pulseaudio api. Most functions that
+communicate with the server, are defined on the 'Context'.
+-}
+module Sound.Pulse.Context
+ ( Context
+ , ContextFlags(..)
+ , ContextState(..)
+ , ContextSuccessCB
+
+ , getContext
+ , connectContext
+ , setStateCallback
+ , getContextServer
+ , getContextState
+ , getContextErr
+ , getContextErrStr
+ , wrapSuccess
+ )
+where
+
+import Control.Applicative ((<$>))
+import Control.Monad ((<=<))
+import Foreign.C.String
+import Foreign.C.Types
+import Foreign.Marshal.Utils
+import Foreign.Ptr
+
+import Sound.Pulse.Def (ContextState(..), contextStateFromInt, ContextFlags(..), contextFlagssToInt)
+import Sound.Pulse.Mainloop
+import Sound.Pulse.Userdata
+
+-- |Typesafety internal type
+data CInternal
+-- |Type we will be using for pa_context
+type Context = Ptr CInternal
+
+-- TODO: This here
+data PASpawnApi
+
+-- |Callback type for functions that only report success
+type ContextSuccessCB = Context -> CInt -> Ptr Userdata -> IO ()
+foreign import ccall "wrapper" mkCSuccess :: ContextSuccessCB -> IO (FunPtr ContextSuccessCB)
+
+-- |Wrapp a function callback for 'ContextSuccessCB'
+wrapSuccess
+ :: (Bool -> IO ())
+ -> IO (FunPtr ContextSuccessCB)
+-- TODO: should this auto-cleanup itself?
+wrapSuccess fun = mkCSuccess $ \_ b _ -> fun (b /= 0)
+
+foreign import ccall "pa_context_new" pa_context_new :: Ptr a -> CString -> IO Context
+
+foreign import ccall "pa_context_connect" pa_context_connect :: Context -> CString -> CInt -> Ptr PASpawnApi -> IO CInt
+
+type ContextNotify a = Context -> Ptr a -> IO ()
+foreign import ccall "wrapper" mkCNotify :: ContextNotify a -> IO (FunPtr (ContextNotify a))
+
+foreign import ccall "pa_context_set_state_callback" pa_context_set_state_callback :: Context -> FunPtr (ContextNotify a) -> Ptr a -> IO ()
+foreign import ccall "pa_context_get_server" pa_context_get_server :: Context -> IO CString
+
+foreign import ccall "pa_context_get_state" pa_context_get_state :: Context -> IO CInt
+foreign import ccall "pa_context_errno" pa_context_errno :: Context -> IO CInt
+
+foreign import ccall "pa_strerror" pa_strerror :: CInt-> CString
+
+-- |Create a pulseaudio context
+getContext
+ :: PAMainloop a
+ => a -- ^The mainloop implementation
+ -> String -- ^The application name
+ -> IO Context
+getContext impl name = do
+ ptr <- new =<< getMainloopApi impl
+ withCString name (pa_context_new ptr)
+
+-- |Connect a Context to a pulseaudio server.
+connectContext
+ :: Context -- ^The context
+ -> Maybe String -- ^The server to connect to. If this is Nothing, connect to the default server.
+ -> [ContextFlags] -- ^Flags to control the startup behaviour of the server.
+ -- -> SpawnApi! -- TODO
+ -> IO ()
+connectContext cxt serv flags = do
+ let wrapper = maybe ($ nullPtr) (withCString) serv
+ ret <- wrapper (\ptr -> pa_context_connect cxt ptr (contextFlagssToInt flags) nullPtr)
+ if ret /= 0
+ then error ("Failed to connect to server :( " ++ show ret)
+ else return ()
+
+-- |This callback is leaked! if it's reset
+-- IMO the handler should stay forever aswell (even if just for loggin), so don't worry about it.
+-- This should only be called once per application run though, so it will be a
+-- known issue for know.
+setStateCallback
+ :: Context
+ -> IO ()
+ -> IO ()
+setStateCallback cxt fun = do
+ funP <- mkCNotify (\_ _ -> fun)
+ pa_context_set_state_callback cxt funP nullPtr
+
+-- |Get the Servername from a (connected) 'Context'.
+getContextServer :: Context -> IO (Maybe String)
+getContextServer cxt = do
+ cstr <- pa_context_get_server cxt
+ if cstr == nullPtr
+ then return Nothing
+ else Just <$> peekCString cstr
+
+-- |Get the current state from a 'Context'.
+getContextState :: Context -> IO ContextState
+getContextState = fmap contextStateFromInt . pa_context_get_state
+
+-- |Get the last error from a 'Context'.
+getContextErr :: Context -> IO Int
+getContextErr = fmap fromIntegral . pa_context_errno
+
+-- |Get the last error from a 'Context' in a human readable 'String'.
+getContextErrStr :: Context -> IO String
+getContextErrStr = peekCString . pa_strerror . fromIntegral <=< getContextErr
diff --git a/src/Sound/Pulse/Def.hsc b/src/Sound/Pulse/Def.hsc
new file mode 100644
--- /dev/null
+++ b/src/Sound/Pulse/Def.hsc
@@ -0,0 +1,736 @@
+{-# OPTIONS -fno-warn-overlapping-patterns #-}
+{-# OPTIONS_HADDOCK hide #-}
+module Sound.Pulse.Def
+where
+
+#include
+#include
+#include
+import Data.Bits (Bits(..))
+import Foreign.C.Types (CInt)
+
+foldFlag :: (a -> CInt) -> [a] -> CInt
+foldFlag fun = foldr ((.|.) . fun) 0
+
+data SubscriptionEventFacility
+ = SubscriptionEventSink
+ | SubscriptionEventSource
+ | SubscriptionEventSinkInput
+ | SubscriptionEventSourceOutput
+ | SubscriptionEventModule
+ | SubscriptionEventClient
+ | SubscriptionEventSampleCache
+ | SubscriptionEventServer
+ | SubscriptionEventAutoload
+ | SubscriptionEventCard
+ | SubscriptionEventFacilityMask
+ deriving (Eq, Show)
+
+subscriptionEventFacilityToInt :: SubscriptionEventFacility -> CInt
+subscriptionEventFacilityToInt SubscriptionEventSink = #{const PA_SUBSCRIPTION_EVENT_SINK}
+subscriptionEventFacilityToInt SubscriptionEventSource = #{const PA_SUBSCRIPTION_EVENT_SOURCE}
+subscriptionEventFacilityToInt SubscriptionEventSinkInput = #{const PA_SUBSCRIPTION_EVENT_SINK_INPUT}
+subscriptionEventFacilityToInt SubscriptionEventSourceOutput = #{const PA_SUBSCRIPTION_EVENT_SOURCE_OUTPUT}
+subscriptionEventFacilityToInt SubscriptionEventModule = #{const PA_SUBSCRIPTION_EVENT_MODULE}
+subscriptionEventFacilityToInt SubscriptionEventClient = #{const PA_SUBSCRIPTION_EVENT_CLIENT}
+subscriptionEventFacilityToInt SubscriptionEventSampleCache = #{const PA_SUBSCRIPTION_EVENT_SAMPLE_CACHE}
+subscriptionEventFacilityToInt SubscriptionEventServer = #{const PA_SUBSCRIPTION_EVENT_SERVER}
+subscriptionEventFacilityToInt SubscriptionEventAutoload = #{const PA_SUBSCRIPTION_EVENT_AUTOLOAD}
+subscriptionEventFacilityToInt SubscriptionEventCard = #{const PA_SUBSCRIPTION_EVENT_CARD}
+subscriptionEventFacilityToInt SubscriptionEventFacilityMask = #{const PA_SUBSCRIPTION_EVENT_FACILITY_MASK}
+
+subscriptionEventFacilityFromInt :: CInt -> SubscriptionEventFacility
+subscriptionEventFacilityFromInt (#{const PA_SUBSCRIPTION_EVENT_SINK}) = SubscriptionEventSink
+subscriptionEventFacilityFromInt (#{const PA_SUBSCRIPTION_EVENT_SOURCE}) = SubscriptionEventSource
+subscriptionEventFacilityFromInt (#{const PA_SUBSCRIPTION_EVENT_SINK_INPUT}) = SubscriptionEventSinkInput
+subscriptionEventFacilityFromInt (#{const PA_SUBSCRIPTION_EVENT_SOURCE_OUTPUT}) = SubscriptionEventSourceOutput
+subscriptionEventFacilityFromInt (#{const PA_SUBSCRIPTION_EVENT_MODULE}) = SubscriptionEventModule
+subscriptionEventFacilityFromInt (#{const PA_SUBSCRIPTION_EVENT_CLIENT}) = SubscriptionEventClient
+subscriptionEventFacilityFromInt (#{const PA_SUBSCRIPTION_EVENT_SAMPLE_CACHE}) = SubscriptionEventSampleCache
+subscriptionEventFacilityFromInt (#{const PA_SUBSCRIPTION_EVENT_SERVER}) = SubscriptionEventServer
+subscriptionEventFacilityFromInt (#{const PA_SUBSCRIPTION_EVENT_AUTOLOAD}) = SubscriptionEventAutoload
+subscriptionEventFacilityFromInt (#{const PA_SUBSCRIPTION_EVENT_CARD}) = SubscriptionEventCard
+subscriptionEventFacilityFromInt (#{const PA_SUBSCRIPTION_EVENT_FACILITY_MASK}) = SubscriptionEventFacilityMask
+subscriptionEventFacilityFromInt x = error ("PA unexped value @subscriptionEventFacilityFromInt:" ++ show x)
+data SubscriptionEventType
+ = SubscriptionEventNew
+ | SubscriptionEventChange
+ | SubscriptionEventRemove
+ | SubscriptionEventTypeMask
+ deriving (Eq, Show)
+
+subscriptionEventTypeToInt :: SubscriptionEventType -> CInt
+subscriptionEventTypeToInt SubscriptionEventNew = #{const PA_SUBSCRIPTION_EVENT_NEW}
+subscriptionEventTypeToInt SubscriptionEventChange = #{const PA_SUBSCRIPTION_EVENT_CHANGE}
+subscriptionEventTypeToInt SubscriptionEventRemove = #{const PA_SUBSCRIPTION_EVENT_REMOVE}
+subscriptionEventTypeToInt SubscriptionEventTypeMask = #{const PA_SUBSCRIPTION_EVENT_TYPE_MASK}
+
+subscriptionEventTypeFromInt :: CInt -> SubscriptionEventType
+subscriptionEventTypeFromInt (#{const PA_SUBSCRIPTION_EVENT_NEW}) = SubscriptionEventNew
+subscriptionEventTypeFromInt (#{const PA_SUBSCRIPTION_EVENT_CHANGE}) = SubscriptionEventChange
+subscriptionEventTypeFromInt (#{const PA_SUBSCRIPTION_EVENT_REMOVE}) = SubscriptionEventRemove
+subscriptionEventTypeFromInt (#{const PA_SUBSCRIPTION_EVENT_TYPE_MASK}) = SubscriptionEventTypeMask
+subscriptionEventTypeFromInt x = error ("PA unexped value @subscriptionEventTypeFromInt:" ++ show x)
+data ContextState
+ = ContextUnconnected
+ | ContextConnecting
+ | ContextAuthorizing
+ | ContextSettingName
+ | ContextReady
+ | ContextFailed
+ | ContextTerminated
+ deriving (Eq, Show)
+
+contextStateToInt :: ContextState -> CInt
+contextStateToInt ContextUnconnected = #{const PA_CONTEXT_UNCONNECTED}
+contextStateToInt ContextConnecting = #{const PA_CONTEXT_CONNECTING}
+contextStateToInt ContextAuthorizing = #{const PA_CONTEXT_AUTHORIZING}
+contextStateToInt ContextSettingName = #{const PA_CONTEXT_SETTING_NAME}
+contextStateToInt ContextReady = #{const PA_CONTEXT_READY}
+contextStateToInt ContextFailed = #{const PA_CONTEXT_FAILED}
+contextStateToInt ContextTerminated = #{const PA_CONTEXT_TERMINATED}
+
+contextStateFromInt :: CInt -> ContextState
+contextStateFromInt (#{const PA_CONTEXT_UNCONNECTED}) = ContextUnconnected
+contextStateFromInt (#{const PA_CONTEXT_CONNECTING}) = ContextConnecting
+contextStateFromInt (#{const PA_CONTEXT_AUTHORIZING}) = ContextAuthorizing
+contextStateFromInt (#{const PA_CONTEXT_SETTING_NAME}) = ContextSettingName
+contextStateFromInt (#{const PA_CONTEXT_READY}) = ContextReady
+contextStateFromInt (#{const PA_CONTEXT_FAILED}) = ContextFailed
+contextStateFromInt (#{const PA_CONTEXT_TERMINATED}) = ContextTerminated
+contextStateFromInt x = error ("PA unexped value @contextStateFromInt:" ++ show x)
+data StreamState
+ = StreamUnconnected
+ | StreamCreating
+ | StreamReady
+ | StreamFailed
+ | StreamTerminated
+ deriving (Eq, Show)
+
+streamStateToInt :: StreamState -> CInt
+streamStateToInt StreamUnconnected = #{const PA_STREAM_UNCONNECTED}
+streamStateToInt StreamCreating = #{const PA_STREAM_CREATING}
+streamStateToInt StreamReady = #{const PA_STREAM_READY}
+streamStateToInt StreamFailed = #{const PA_STREAM_FAILED}
+streamStateToInt StreamTerminated = #{const PA_STREAM_TERMINATED}
+
+streamStateFromInt :: CInt -> StreamState
+streamStateFromInt (#{const PA_STREAM_UNCONNECTED}) = StreamUnconnected
+streamStateFromInt (#{const PA_STREAM_CREATING}) = StreamCreating
+streamStateFromInt (#{const PA_STREAM_READY}) = StreamReady
+streamStateFromInt (#{const PA_STREAM_FAILED}) = StreamFailed
+streamStateFromInt (#{const PA_STREAM_TERMINATED}) = StreamTerminated
+streamStateFromInt x = error ("PA unexped value @streamStateFromInt:" ++ show x)
+data OperationState
+ = OperationRunning
+ | OperationDone
+ | OperationCancelled
+ deriving (Eq, Show)
+
+operationStateToInt :: OperationState -> CInt
+operationStateToInt OperationRunning = #{const PA_OPERATION_RUNNING}
+operationStateToInt OperationDone = #{const PA_OPERATION_DONE}
+operationStateToInt OperationCancelled = #{const PA_OPERATION_CANCELLED}
+
+operationStateFromInt :: CInt -> OperationState
+operationStateFromInt (#{const PA_OPERATION_RUNNING}) = OperationRunning
+operationStateFromInt (#{const PA_OPERATION_DONE}) = OperationDone
+operationStateFromInt (#{const PA_OPERATION_CANCELLED}) = OperationCancelled
+operationStateFromInt x = error ("PA unexped value @operationStateFromInt:" ++ show x)
+data Direction
+ = DirectionOutput
+ | DirectionInput
+ deriving (Eq, Show)
+
+directionToInt :: Direction -> CInt
+directionToInt DirectionOutput = #{const PA_DIRECTION_OUTPUT}
+directionToInt DirectionInput = #{const PA_DIRECTION_INPUT}
+
+directionFromInt :: CInt -> Direction
+directionFromInt (#{const PA_DIRECTION_OUTPUT}) = DirectionOutput
+directionFromInt (#{const PA_DIRECTION_INPUT}) = DirectionInput
+directionFromInt x = error ("PA unexped value @directionFromInt:" ++ show x)
+data ErrorCode
+ = Ok
+ | ErrAccess
+ | ErrCommand
+ | ErrInvalid
+ | ErrExist
+ | ErrNoentity
+ | ErrConnectionrefused
+ | ErrProtocol
+ | ErrTimeout
+ | ErrAuthkey
+ | ErrInternal
+ | ErrConnectionterminated
+ | ErrKilled
+ | ErrInvalidserver
+ | ErrModinitfailed
+ | ErrBadstate
+ | ErrNodata
+ | ErrVersion
+ | ErrToolarge
+ | ErrNotsupported
+ | ErrUnknown
+ | ErrNoextension
+ | ErrObsolete
+ | ErrNotimplemented
+ | ErrForked
+ | ErrIo
+ | ErrBusy
+ | ErrMax
+ deriving (Eq, Show)
+
+errorCodeToInt :: ErrorCode -> CInt
+errorCodeToInt Ok = #{const PA_OK}
+errorCodeToInt ErrAccess = #{const PA_ERR_ACCESS}
+errorCodeToInt ErrCommand = #{const PA_ERR_COMMAND}
+errorCodeToInt ErrInvalid = #{const PA_ERR_INVALID}
+errorCodeToInt ErrExist = #{const PA_ERR_EXIST}
+errorCodeToInt ErrNoentity = #{const PA_ERR_NOENTITY}
+errorCodeToInt ErrConnectionrefused = #{const PA_ERR_CONNECTIONREFUSED}
+errorCodeToInt ErrProtocol = #{const PA_ERR_PROTOCOL}
+errorCodeToInt ErrTimeout = #{const PA_ERR_TIMEOUT}
+errorCodeToInt ErrAuthkey = #{const PA_ERR_AUTHKEY}
+errorCodeToInt ErrInternal = #{const PA_ERR_INTERNAL}
+errorCodeToInt ErrConnectionterminated = #{const PA_ERR_CONNECTIONTERMINATED}
+errorCodeToInt ErrKilled = #{const PA_ERR_KILLED}
+errorCodeToInt ErrInvalidserver = #{const PA_ERR_INVALIDSERVER}
+errorCodeToInt ErrModinitfailed = #{const PA_ERR_MODINITFAILED}
+errorCodeToInt ErrBadstate = #{const PA_ERR_BADSTATE}
+errorCodeToInt ErrNodata = #{const PA_ERR_NODATA}
+errorCodeToInt ErrVersion = #{const PA_ERR_VERSION}
+errorCodeToInt ErrToolarge = #{const PA_ERR_TOOLARGE}
+errorCodeToInt ErrNotsupported = #{const PA_ERR_NOTSUPPORTED}
+errorCodeToInt ErrUnknown = #{const PA_ERR_UNKNOWN}
+errorCodeToInt ErrNoextension = #{const PA_ERR_NOEXTENSION}
+errorCodeToInt ErrObsolete = #{const PA_ERR_OBSOLETE}
+errorCodeToInt ErrNotimplemented = #{const PA_ERR_NOTIMPLEMENTED}
+errorCodeToInt ErrForked = #{const PA_ERR_FORKED}
+errorCodeToInt ErrIo = #{const PA_ERR_IO}
+errorCodeToInt ErrBusy = #{const PA_ERR_BUSY}
+errorCodeToInt ErrMax = #{const PA_ERR_MAX}
+
+errorCodeFromInt :: CInt -> ErrorCode
+errorCodeFromInt (#{const PA_OK}) = Ok
+errorCodeFromInt (#{const PA_ERR_ACCESS}) = ErrAccess
+errorCodeFromInt (#{const PA_ERR_COMMAND}) = ErrCommand
+errorCodeFromInt (#{const PA_ERR_INVALID}) = ErrInvalid
+errorCodeFromInt (#{const PA_ERR_EXIST}) = ErrExist
+errorCodeFromInt (#{const PA_ERR_NOENTITY}) = ErrNoentity
+errorCodeFromInt (#{const PA_ERR_CONNECTIONREFUSED}) = ErrConnectionrefused
+errorCodeFromInt (#{const PA_ERR_PROTOCOL}) = ErrProtocol
+errorCodeFromInt (#{const PA_ERR_TIMEOUT}) = ErrTimeout
+errorCodeFromInt (#{const PA_ERR_AUTHKEY}) = ErrAuthkey
+errorCodeFromInt (#{const PA_ERR_INTERNAL}) = ErrInternal
+errorCodeFromInt (#{const PA_ERR_CONNECTIONTERMINATED}) = ErrConnectionterminated
+errorCodeFromInt (#{const PA_ERR_KILLED}) = ErrKilled
+errorCodeFromInt (#{const PA_ERR_INVALIDSERVER}) = ErrInvalidserver
+errorCodeFromInt (#{const PA_ERR_MODINITFAILED}) = ErrModinitfailed
+errorCodeFromInt (#{const PA_ERR_BADSTATE}) = ErrBadstate
+errorCodeFromInt (#{const PA_ERR_NODATA}) = ErrNodata
+errorCodeFromInt (#{const PA_ERR_VERSION}) = ErrVersion
+errorCodeFromInt (#{const PA_ERR_TOOLARGE}) = ErrToolarge
+errorCodeFromInt (#{const PA_ERR_NOTSUPPORTED}) = ErrNotsupported
+errorCodeFromInt (#{const PA_ERR_UNKNOWN}) = ErrUnknown
+errorCodeFromInt (#{const PA_ERR_NOEXTENSION}) = ErrNoextension
+errorCodeFromInt (#{const PA_ERR_OBSOLETE}) = ErrObsolete
+errorCodeFromInt (#{const PA_ERR_NOTIMPLEMENTED}) = ErrNotimplemented
+errorCodeFromInt (#{const PA_ERR_FORKED}) = ErrForked
+errorCodeFromInt (#{const PA_ERR_IO}) = ErrIo
+errorCodeFromInt (#{const PA_ERR_BUSY}) = ErrBusy
+errorCodeFromInt (#{const PA_ERR_MAX}) = ErrMax
+errorCodeFromInt x = error ("PA unexped value @errorCodeFromInt:" ++ show x)
+data SeekMode
+ = SeekRelative
+ | SeekAbsolute
+ | SeekRelativeOnRead
+ | SeekRelativeEnd
+ deriving (Eq, Show)
+
+seekModeToInt :: SeekMode -> CInt
+seekModeToInt SeekRelative = #{const PA_SEEK_RELATIVE}
+seekModeToInt SeekAbsolute = #{const PA_SEEK_ABSOLUTE}
+seekModeToInt SeekRelativeOnRead = #{const PA_SEEK_RELATIVE_ON_READ}
+seekModeToInt SeekRelativeEnd = #{const PA_SEEK_RELATIVE_END}
+
+seekModeFromInt :: CInt -> SeekMode
+seekModeFromInt (#{const PA_SEEK_RELATIVE}) = SeekRelative
+seekModeFromInt (#{const PA_SEEK_ABSOLUTE}) = SeekAbsolute
+seekModeFromInt (#{const PA_SEEK_RELATIVE_ON_READ}) = SeekRelativeOnRead
+seekModeFromInt (#{const PA_SEEK_RELATIVE_END}) = SeekRelativeEnd
+seekModeFromInt x = error ("PA unexped value @seekModeFromInt:" ++ show x)
+data SinkState
+ = SinkInvalidState
+ | SinkRunning
+ | SinkIdle
+ | SinkSuspended
+ | SinkInit
+ | SinkUnlinked
+ deriving (Eq, Show)
+
+sinkStateToInt :: SinkState -> CInt
+sinkStateToInt SinkInvalidState = #{const PA_SINK_INVALID_STATE}
+sinkStateToInt SinkRunning = #{const PA_SINK_RUNNING}
+sinkStateToInt SinkIdle = #{const PA_SINK_IDLE}
+sinkStateToInt SinkSuspended = #{const PA_SINK_SUSPENDED}
+sinkStateToInt SinkInit = #{const PA_SINK_INIT}
+sinkStateToInt SinkUnlinked = #{const PA_SINK_UNLINKED}
+
+sinkStateFromInt :: CInt -> SinkState
+sinkStateFromInt (#{const PA_SINK_INVALID_STATE}) = SinkInvalidState
+sinkStateFromInt (#{const PA_SINK_RUNNING}) = SinkRunning
+sinkStateFromInt (#{const PA_SINK_IDLE}) = SinkIdle
+sinkStateFromInt (#{const PA_SINK_SUSPENDED}) = SinkSuspended
+sinkStateFromInt (#{const PA_SINK_INIT}) = SinkInit
+sinkStateFromInt (#{const PA_SINK_UNLINKED}) = SinkUnlinked
+sinkStateFromInt x = error ("PA unexped value @sinkStateFromInt:" ++ show x)
+data SourceState
+ = SourceInvalidState
+ | SourceRunning
+ | SourceIdle
+ | SourceSuspended
+ | SourceInit
+ | SourceUnlinked
+ deriving (Eq, Show)
+
+sourceStateToInt :: SourceState -> CInt
+sourceStateToInt SourceInvalidState = #{const PA_SOURCE_INVALID_STATE}
+sourceStateToInt SourceRunning = #{const PA_SOURCE_RUNNING}
+sourceStateToInt SourceIdle = #{const PA_SOURCE_IDLE}
+sourceStateToInt SourceSuspended = #{const PA_SOURCE_SUSPENDED}
+sourceStateToInt SourceInit = #{const PA_SOURCE_INIT}
+sourceStateToInt SourceUnlinked = #{const PA_SOURCE_UNLINKED}
+
+sourceStateFromInt :: CInt -> SourceState
+sourceStateFromInt (#{const PA_SOURCE_INVALID_STATE}) = SourceInvalidState
+sourceStateFromInt (#{const PA_SOURCE_RUNNING}) = SourceRunning
+sourceStateFromInt (#{const PA_SOURCE_IDLE}) = SourceIdle
+sourceStateFromInt (#{const PA_SOURCE_SUSPENDED}) = SourceSuspended
+sourceStateFromInt (#{const PA_SOURCE_INIT}) = SourceInit
+sourceStateFromInt (#{const PA_SOURCE_UNLINKED}) = SourceUnlinked
+sourceStateFromInt x = error ("PA unexped value @sourceStateFromInt:" ++ show x)
+data PortAvailable
+ = PortAvailableUnknown
+ | PortAvailableNo
+ | PortAvailableYes
+ deriving (Eq, Show)
+
+portAvailableToInt :: PortAvailable -> CInt
+portAvailableToInt PortAvailableUnknown = #{const PA_PORT_AVAILABLE_UNKNOWN}
+portAvailableToInt PortAvailableNo = #{const PA_PORT_AVAILABLE_NO}
+portAvailableToInt PortAvailableYes = #{const PA_PORT_AVAILABLE_YES}
+
+portAvailableFromInt :: CInt -> PortAvailable
+portAvailableFromInt (#{const PA_PORT_AVAILABLE_UNKNOWN}) = PortAvailableUnknown
+portAvailableFromInt (#{const PA_PORT_AVAILABLE_NO}) = PortAvailableNo
+portAvailableFromInt (#{const PA_PORT_AVAILABLE_YES}) = PortAvailableYes
+portAvailableFromInt x = error ("PA unexped value @portAvailableFromInt:" ++ show x)
+data ChannelPosition
+ = ChannelPositionInvalid
+ | ChannelPositionMono
+ | ChannelPositionFrontLeft
+ | ChannelPositionFrontRight
+ | ChannelPositionFrontCenter
+ | ChannelPositionLeft
+ | ChannelPositionRight
+ | ChannelPositionCenter
+ | ChannelPositionRearCenter
+ | ChannelPositionRearLeft
+ | ChannelPositionRearRight
+ | ChannelPositionLfe
+ | ChannelPositionSubwoofer
+ | ChannelPositionFrontLeftOfCenter
+ | ChannelPositionFrontRightOfCenter
+ | ChannelPositionSideLeft
+ | ChannelPositionSideRight
+ | ChannelPositionAux0
+ | ChannelPositionAux1
+ | ChannelPositionAux2
+ | ChannelPositionAux3
+ | ChannelPositionAux4
+ | ChannelPositionAux5
+ | ChannelPositionAux6
+ | ChannelPositionAux7
+ | ChannelPositionAux8
+ | ChannelPositionAux9
+ | ChannelPositionAux10
+ | ChannelPositionAux11
+ | ChannelPositionAux12
+ | ChannelPositionAux13
+ | ChannelPositionAux14
+ | ChannelPositionAux15
+ | ChannelPositionAux16
+ | ChannelPositionAux17
+ | ChannelPositionAux18
+ | ChannelPositionAux19
+ | ChannelPositionAux20
+ | ChannelPositionAux21
+ | ChannelPositionAux22
+ | ChannelPositionAux23
+ | ChannelPositionAux24
+ | ChannelPositionAux25
+ | ChannelPositionAux26
+ | ChannelPositionAux27
+ | ChannelPositionAux28
+ | ChannelPositionAux29
+ | ChannelPositionAux30
+ | ChannelPositionAux31
+ | ChannelPositionTopCenter
+ | ChannelPositionTopFrontLeft
+ | ChannelPositionTopFrontRight
+ | ChannelPositionTopFrontCenter
+ | ChannelPositionTopRearLeft
+ | ChannelPositionTopRearRight
+ | ChannelPositionTopRearCenter
+ | ChannelPositionMax
+ deriving (Eq, Show)
+
+channelPositionToInt :: ChannelPosition -> CInt
+channelPositionToInt ChannelPositionInvalid = #{const PA_CHANNEL_POSITION_INVALID}
+channelPositionToInt ChannelPositionMono = #{const PA_CHANNEL_POSITION_MONO}
+channelPositionToInt ChannelPositionFrontLeft = #{const PA_CHANNEL_POSITION_FRONT_LEFT}
+channelPositionToInt ChannelPositionFrontRight = #{const PA_CHANNEL_POSITION_FRONT_RIGHT}
+channelPositionToInt ChannelPositionFrontCenter = #{const PA_CHANNEL_POSITION_FRONT_CENTER}
+channelPositionToInt ChannelPositionLeft = #{const PA_CHANNEL_POSITION_LEFT}
+channelPositionToInt ChannelPositionRight = #{const PA_CHANNEL_POSITION_RIGHT}
+channelPositionToInt ChannelPositionCenter = #{const PA_CHANNEL_POSITION_CENTER}
+channelPositionToInt ChannelPositionRearCenter = #{const PA_CHANNEL_POSITION_REAR_CENTER}
+channelPositionToInt ChannelPositionRearLeft = #{const PA_CHANNEL_POSITION_REAR_LEFT}
+channelPositionToInt ChannelPositionRearRight = #{const PA_CHANNEL_POSITION_REAR_RIGHT}
+channelPositionToInt ChannelPositionLfe = #{const PA_CHANNEL_POSITION_LFE}
+channelPositionToInt ChannelPositionSubwoofer = #{const PA_CHANNEL_POSITION_SUBWOOFER}
+channelPositionToInt ChannelPositionFrontLeftOfCenter = #{const PA_CHANNEL_POSITION_FRONT_LEFT_OF_CENTER}
+channelPositionToInt ChannelPositionFrontRightOfCenter = #{const PA_CHANNEL_POSITION_FRONT_RIGHT_OF_CENTER}
+channelPositionToInt ChannelPositionSideLeft = #{const PA_CHANNEL_POSITION_SIDE_LEFT}
+channelPositionToInt ChannelPositionSideRight = #{const PA_CHANNEL_POSITION_SIDE_RIGHT}
+channelPositionToInt ChannelPositionAux0 = #{const PA_CHANNEL_POSITION_AUX0}
+channelPositionToInt ChannelPositionAux1 = #{const PA_CHANNEL_POSITION_AUX1}
+channelPositionToInt ChannelPositionAux2 = #{const PA_CHANNEL_POSITION_AUX2}
+channelPositionToInt ChannelPositionAux3 = #{const PA_CHANNEL_POSITION_AUX3}
+channelPositionToInt ChannelPositionAux4 = #{const PA_CHANNEL_POSITION_AUX4}
+channelPositionToInt ChannelPositionAux5 = #{const PA_CHANNEL_POSITION_AUX5}
+channelPositionToInt ChannelPositionAux6 = #{const PA_CHANNEL_POSITION_AUX6}
+channelPositionToInt ChannelPositionAux7 = #{const PA_CHANNEL_POSITION_AUX7}
+channelPositionToInt ChannelPositionAux8 = #{const PA_CHANNEL_POSITION_AUX8}
+channelPositionToInt ChannelPositionAux9 = #{const PA_CHANNEL_POSITION_AUX9}
+channelPositionToInt ChannelPositionAux10 = #{const PA_CHANNEL_POSITION_AUX10}
+channelPositionToInt ChannelPositionAux11 = #{const PA_CHANNEL_POSITION_AUX11}
+channelPositionToInt ChannelPositionAux12 = #{const PA_CHANNEL_POSITION_AUX12}
+channelPositionToInt ChannelPositionAux13 = #{const PA_CHANNEL_POSITION_AUX13}
+channelPositionToInt ChannelPositionAux14 = #{const PA_CHANNEL_POSITION_AUX14}
+channelPositionToInt ChannelPositionAux15 = #{const PA_CHANNEL_POSITION_AUX15}
+channelPositionToInt ChannelPositionAux16 = #{const PA_CHANNEL_POSITION_AUX16}
+channelPositionToInt ChannelPositionAux17 = #{const PA_CHANNEL_POSITION_AUX17}
+channelPositionToInt ChannelPositionAux18 = #{const PA_CHANNEL_POSITION_AUX18}
+channelPositionToInt ChannelPositionAux19 = #{const PA_CHANNEL_POSITION_AUX19}
+channelPositionToInt ChannelPositionAux20 = #{const PA_CHANNEL_POSITION_AUX20}
+channelPositionToInt ChannelPositionAux21 = #{const PA_CHANNEL_POSITION_AUX21}
+channelPositionToInt ChannelPositionAux22 = #{const PA_CHANNEL_POSITION_AUX22}
+channelPositionToInt ChannelPositionAux23 = #{const PA_CHANNEL_POSITION_AUX23}
+channelPositionToInt ChannelPositionAux24 = #{const PA_CHANNEL_POSITION_AUX24}
+channelPositionToInt ChannelPositionAux25 = #{const PA_CHANNEL_POSITION_AUX25}
+channelPositionToInt ChannelPositionAux26 = #{const PA_CHANNEL_POSITION_AUX26}
+channelPositionToInt ChannelPositionAux27 = #{const PA_CHANNEL_POSITION_AUX27}
+channelPositionToInt ChannelPositionAux28 = #{const PA_CHANNEL_POSITION_AUX28}
+channelPositionToInt ChannelPositionAux29 = #{const PA_CHANNEL_POSITION_AUX29}
+channelPositionToInt ChannelPositionAux30 = #{const PA_CHANNEL_POSITION_AUX30}
+channelPositionToInt ChannelPositionAux31 = #{const PA_CHANNEL_POSITION_AUX31}
+channelPositionToInt ChannelPositionTopCenter = #{const PA_CHANNEL_POSITION_TOP_CENTER}
+channelPositionToInt ChannelPositionTopFrontLeft = #{const PA_CHANNEL_POSITION_TOP_FRONT_LEFT}
+channelPositionToInt ChannelPositionTopFrontRight = #{const PA_CHANNEL_POSITION_TOP_FRONT_RIGHT}
+channelPositionToInt ChannelPositionTopFrontCenter = #{const PA_CHANNEL_POSITION_TOP_FRONT_CENTER}
+channelPositionToInt ChannelPositionTopRearLeft = #{const PA_CHANNEL_POSITION_TOP_REAR_LEFT}
+channelPositionToInt ChannelPositionTopRearRight = #{const PA_CHANNEL_POSITION_TOP_REAR_RIGHT}
+channelPositionToInt ChannelPositionTopRearCenter = #{const PA_CHANNEL_POSITION_TOP_REAR_CENTER}
+channelPositionToInt ChannelPositionMax = #{const PA_CHANNEL_POSITION_MAX}
+
+channelPositionFromInt :: CInt -> ChannelPosition
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_INVALID}) = ChannelPositionInvalid
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_MONO}) = ChannelPositionMono
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_FRONT_LEFT}) = ChannelPositionFrontLeft
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_FRONT_RIGHT}) = ChannelPositionFrontRight
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_FRONT_CENTER}) = ChannelPositionFrontCenter
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_LEFT}) = ChannelPositionLeft
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_RIGHT}) = ChannelPositionRight
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_CENTER}) = ChannelPositionCenter
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_REAR_CENTER}) = ChannelPositionRearCenter
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_REAR_LEFT}) = ChannelPositionRearLeft
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_REAR_RIGHT}) = ChannelPositionRearRight
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_LFE}) = ChannelPositionLfe
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_SUBWOOFER}) = ChannelPositionSubwoofer
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_FRONT_LEFT_OF_CENTER}) = ChannelPositionFrontLeftOfCenter
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_FRONT_RIGHT_OF_CENTER}) = ChannelPositionFrontRightOfCenter
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_SIDE_LEFT}) = ChannelPositionSideLeft
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_SIDE_RIGHT}) = ChannelPositionSideRight
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX0}) = ChannelPositionAux0
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX1}) = ChannelPositionAux1
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX2}) = ChannelPositionAux2
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX3}) = ChannelPositionAux3
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX4}) = ChannelPositionAux4
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX5}) = ChannelPositionAux5
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX6}) = ChannelPositionAux6
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX7}) = ChannelPositionAux7
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX8}) = ChannelPositionAux8
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX9}) = ChannelPositionAux9
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX10}) = ChannelPositionAux10
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX11}) = ChannelPositionAux11
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX12}) = ChannelPositionAux12
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX13}) = ChannelPositionAux13
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX14}) = ChannelPositionAux14
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX15}) = ChannelPositionAux15
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX16}) = ChannelPositionAux16
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX17}) = ChannelPositionAux17
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX18}) = ChannelPositionAux18
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX19}) = ChannelPositionAux19
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX20}) = ChannelPositionAux20
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX21}) = ChannelPositionAux21
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX22}) = ChannelPositionAux22
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX23}) = ChannelPositionAux23
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX24}) = ChannelPositionAux24
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX25}) = ChannelPositionAux25
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX26}) = ChannelPositionAux26
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX27}) = ChannelPositionAux27
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX28}) = ChannelPositionAux28
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX29}) = ChannelPositionAux29
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX30}) = ChannelPositionAux30
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_AUX31}) = ChannelPositionAux31
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_TOP_CENTER}) = ChannelPositionTopCenter
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_TOP_FRONT_LEFT}) = ChannelPositionTopFrontLeft
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_TOP_FRONT_RIGHT}) = ChannelPositionTopFrontRight
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_TOP_FRONT_CENTER}) = ChannelPositionTopFrontCenter
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_TOP_REAR_LEFT}) = ChannelPositionTopRearLeft
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_TOP_REAR_RIGHT}) = ChannelPositionTopRearRight
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_TOP_REAR_CENTER}) = ChannelPositionTopRearCenter
+channelPositionFromInt (#{const PA_CHANNEL_POSITION_MAX}) = ChannelPositionMax
+channelPositionFromInt x = error ("PA unexped value @channelPositionFromInt:" ++ show x)
+data ChannelMapDef
+ = ChannelMapAiff
+ | ChannelMapAlsa
+ | ChannelMapAux
+ | ChannelMapWaveex
+ | ChannelMapOss
+ | ChannelMapDefMax
+ | ChannelMapDefault
+ deriving (Eq, Show)
+
+channelMapDefToInt :: ChannelMapDef -> CInt
+channelMapDefToInt ChannelMapAiff = #{const PA_CHANNEL_MAP_AIFF}
+channelMapDefToInt ChannelMapAlsa = #{const PA_CHANNEL_MAP_ALSA}
+channelMapDefToInt ChannelMapAux = #{const PA_CHANNEL_MAP_AUX}
+channelMapDefToInt ChannelMapWaveex = #{const PA_CHANNEL_MAP_WAVEEX}
+channelMapDefToInt ChannelMapOss = #{const PA_CHANNEL_MAP_OSS}
+channelMapDefToInt ChannelMapDefMax = #{const PA_CHANNEL_MAP_DEF_MAX}
+channelMapDefToInt ChannelMapDefault = #{const PA_CHANNEL_MAP_DEFAULT}
+
+channelMapDefFromInt :: CInt -> ChannelMapDef
+channelMapDefFromInt (#{const PA_CHANNEL_MAP_AIFF}) = ChannelMapAiff
+channelMapDefFromInt (#{const PA_CHANNEL_MAP_ALSA}) = ChannelMapAlsa
+channelMapDefFromInt (#{const PA_CHANNEL_MAP_AUX}) = ChannelMapAux
+channelMapDefFromInt (#{const PA_CHANNEL_MAP_WAVEEX}) = ChannelMapWaveex
+channelMapDefFromInt (#{const PA_CHANNEL_MAP_OSS}) = ChannelMapOss
+channelMapDefFromInt (#{const PA_CHANNEL_MAP_DEF_MAX}) = ChannelMapDefMax
+channelMapDefFromInt (#{const PA_CHANNEL_MAP_DEFAULT}) = ChannelMapDefault
+channelMapDefFromInt x = error ("PA unexped value @channelMapDefFromInt:" ++ show x)
+data SampleFormat
+ = SampleU8
+ | SampleAlaw
+ | SampleUlaw
+ | SampleS16le
+ | SampleS16be
+ | SampleFloat32le
+ | SampleFloat32be
+ | SampleS32le
+ | SampleS32be
+ | SampleS24le
+ | SampleS24be
+ | SampleS2432le
+ | SampleS2432be
+ | SampleMax
+ | SampleInvalid
+ deriving (Eq, Show)
+
+sampleFormatToInt :: SampleFormat -> CInt
+sampleFormatToInt SampleU8 = #{const PA_SAMPLE_U8}
+sampleFormatToInt SampleAlaw = #{const PA_SAMPLE_ALAW}
+sampleFormatToInt SampleUlaw = #{const PA_SAMPLE_ULAW}
+sampleFormatToInt SampleS16le = #{const PA_SAMPLE_S16LE}
+sampleFormatToInt SampleS16be = #{const PA_SAMPLE_S16BE}
+sampleFormatToInt SampleFloat32le = #{const PA_SAMPLE_FLOAT32LE}
+sampleFormatToInt SampleFloat32be = #{const PA_SAMPLE_FLOAT32BE}
+sampleFormatToInt SampleS32le = #{const PA_SAMPLE_S32LE}
+sampleFormatToInt SampleS32be = #{const PA_SAMPLE_S32BE}
+sampleFormatToInt SampleS24le = #{const PA_SAMPLE_S24LE}
+sampleFormatToInt SampleS24be = #{const PA_SAMPLE_S24BE}
+sampleFormatToInt SampleS2432le = #{const PA_SAMPLE_S24_32LE}
+sampleFormatToInt SampleS2432be = #{const PA_SAMPLE_S24_32BE}
+sampleFormatToInt SampleMax = #{const PA_SAMPLE_MAX}
+sampleFormatToInt SampleInvalid = #{const PA_SAMPLE_INVALID}
+
+sampleFormatFromInt :: CInt -> SampleFormat
+sampleFormatFromInt (#{const PA_SAMPLE_U8}) = SampleU8
+sampleFormatFromInt (#{const PA_SAMPLE_ALAW}) = SampleAlaw
+sampleFormatFromInt (#{const PA_SAMPLE_ULAW}) = SampleUlaw
+sampleFormatFromInt (#{const PA_SAMPLE_S16LE}) = SampleS16le
+sampleFormatFromInt (#{const PA_SAMPLE_S16BE}) = SampleS16be
+sampleFormatFromInt (#{const PA_SAMPLE_FLOAT32LE}) = SampleFloat32le
+sampleFormatFromInt (#{const PA_SAMPLE_FLOAT32BE}) = SampleFloat32be
+sampleFormatFromInt (#{const PA_SAMPLE_S32LE}) = SampleS32le
+sampleFormatFromInt (#{const PA_SAMPLE_S32BE}) = SampleS32be
+sampleFormatFromInt (#{const PA_SAMPLE_S24LE}) = SampleS24le
+sampleFormatFromInt (#{const PA_SAMPLE_S24BE}) = SampleS24be
+sampleFormatFromInt (#{const PA_SAMPLE_S24_32LE}) = SampleS2432le
+sampleFormatFromInt (#{const PA_SAMPLE_S24_32BE}) = SampleS2432be
+sampleFormatFromInt (#{const PA_SAMPLE_MAX}) = SampleMax
+sampleFormatFromInt (#{const PA_SAMPLE_INVALID}) = SampleInvalid
+sampleFormatFromInt x = error ("PA unexped value @sampleFormatFromInt:" ++ show x)
+data ContextFlags
+ = ContextNoflags
+ | ContextNoautospawn
+ | ContextNofail
+ deriving (Eq, Show)
+
+contextFlagsToInt :: ContextFlags -> CInt
+contextFlagsToInt ContextNoflags = #{const PA_CONTEXT_NOFLAGS}
+contextFlagsToInt ContextNoautospawn = #{const PA_CONTEXT_NOAUTOSPAWN}
+contextFlagsToInt ContextNofail = #{const PA_CONTEXT_NOFAIL}
+
+contextFlagssToInt :: [ContextFlags] -> CInt
+contextFlagssToInt = foldFlag contextFlagsToInt
+
+contextFlagssFromInt :: CInt -> [ContextFlags]
+contextFlagssFromInt i =
+ let
+ t0 = if (i .&. #{const PA_CONTEXT_NOFLAGS} /= 0) then (ContextNoflags:) else id
+ t1 = if (i .&. #{const PA_CONTEXT_NOAUTOSPAWN} /= 0) then (ContextNoautospawn:) else id
+ t2 = if (i .&. #{const PA_CONTEXT_NOFAIL} /= 0) then (ContextNofail:) else id
+ in t0 . t1 . t2 . id $ []
+data SubscriptionMask
+ = SubscriptionMaskNull
+ | SubscriptionMaskSink
+ | SubscriptionMaskSource
+ | SubscriptionMaskSinkInput
+ | SubscriptionMaskSourceOutput
+ | SubscriptionMaskModule
+ | SubscriptionMaskClient
+ | SubscriptionMaskSampleCache
+ | SubscriptionMaskServer
+ | SubscriptionMaskAutoload
+ | SubscriptionMaskCard
+ | SubscriptionMaskAll
+ deriving (Eq, Show)
+
+subscriptionMaskToInt :: SubscriptionMask -> CInt
+subscriptionMaskToInt SubscriptionMaskNull = #{const PA_SUBSCRIPTION_MASK_NULL}
+subscriptionMaskToInt SubscriptionMaskSink = #{const PA_SUBSCRIPTION_MASK_SINK}
+subscriptionMaskToInt SubscriptionMaskSource = #{const PA_SUBSCRIPTION_MASK_SOURCE}
+subscriptionMaskToInt SubscriptionMaskSinkInput = #{const PA_SUBSCRIPTION_MASK_SINK_INPUT}
+subscriptionMaskToInt SubscriptionMaskSourceOutput = #{const PA_SUBSCRIPTION_MASK_SOURCE_OUTPUT}
+subscriptionMaskToInt SubscriptionMaskModule = #{const PA_SUBSCRIPTION_MASK_MODULE}
+subscriptionMaskToInt SubscriptionMaskClient = #{const PA_SUBSCRIPTION_MASK_CLIENT}
+subscriptionMaskToInt SubscriptionMaskSampleCache = #{const PA_SUBSCRIPTION_MASK_SAMPLE_CACHE}
+subscriptionMaskToInt SubscriptionMaskServer = #{const PA_SUBSCRIPTION_MASK_SERVER}
+subscriptionMaskToInt SubscriptionMaskAutoload = #{const PA_SUBSCRIPTION_MASK_AUTOLOAD}
+subscriptionMaskToInt SubscriptionMaskCard = #{const PA_SUBSCRIPTION_MASK_CARD}
+subscriptionMaskToInt SubscriptionMaskAll = #{const PA_SUBSCRIPTION_MASK_ALL}
+
+subscriptionMasksToInt :: [SubscriptionMask] -> CInt
+subscriptionMasksToInt = foldFlag subscriptionMaskToInt
+
+subscriptionMasksFromInt :: CInt -> [SubscriptionMask]
+subscriptionMasksFromInt i =
+ let
+ t0 = if (i .&. #{const PA_SUBSCRIPTION_MASK_NULL} /= 0) then (SubscriptionMaskNull:) else id
+ t1 = if (i .&. #{const PA_SUBSCRIPTION_MASK_SINK} /= 0) then (SubscriptionMaskSink:) else id
+ t2 = if (i .&. #{const PA_SUBSCRIPTION_MASK_SOURCE} /= 0) then (SubscriptionMaskSource:) else id
+ t3 = if (i .&. #{const PA_SUBSCRIPTION_MASK_SINK_INPUT} /= 0) then (SubscriptionMaskSinkInput:) else id
+ t4 = if (i .&. #{const PA_SUBSCRIPTION_MASK_SOURCE_OUTPUT} /= 0) then (SubscriptionMaskSourceOutput:) else id
+ t5 = if (i .&. #{const PA_SUBSCRIPTION_MASK_MODULE} /= 0) then (SubscriptionMaskModule:) else id
+ t6 = if (i .&. #{const PA_SUBSCRIPTION_MASK_CLIENT} /= 0) then (SubscriptionMaskClient:) else id
+ t7 = if (i .&. #{const PA_SUBSCRIPTION_MASK_SAMPLE_CACHE} /= 0) then (SubscriptionMaskSampleCache:) else id
+ t8 = if (i .&. #{const PA_SUBSCRIPTION_MASK_SERVER} /= 0) then (SubscriptionMaskServer:) else id
+ t9 = if (i .&. #{const PA_SUBSCRIPTION_MASK_AUTOLOAD} /= 0) then (SubscriptionMaskAutoload:) else id
+ t10 = if (i .&. #{const PA_SUBSCRIPTION_MASK_CARD} /= 0) then (SubscriptionMaskCard:) else id
+ t11 = if (i .&. #{const PA_SUBSCRIPTION_MASK_ALL} /= 0) then (SubscriptionMaskAll:) else id
+ in t0 . t1 . t2 . t3 . t4 . t5 . t6 . t7 . t8 . t9 . t10 . t11 . id $ []
+data SinkFlags
+ = SinkNoflags
+ | SinkHwVolumeCtrl
+ | SinkLatency
+ | SinkHardware
+ | SinkNetwork
+ | SinkHwMuteCtrl
+ | SinkDecibelVolume
+ | SinkFlatVolume
+ | SinkDynamicLatency
+ | SinkSetFormats
+ deriving (Eq, Show)
+
+sinkFlagsToInt :: SinkFlags -> CInt
+sinkFlagsToInt SinkNoflags = #{const PA_SINK_NOFLAGS}
+sinkFlagsToInt SinkHwVolumeCtrl = #{const PA_SINK_HW_VOLUME_CTRL}
+sinkFlagsToInt SinkLatency = #{const PA_SINK_LATENCY}
+sinkFlagsToInt SinkHardware = #{const PA_SINK_HARDWARE}
+sinkFlagsToInt SinkNetwork = #{const PA_SINK_NETWORK}
+sinkFlagsToInt SinkHwMuteCtrl = #{const PA_SINK_HW_MUTE_CTRL}
+sinkFlagsToInt SinkDecibelVolume = #{const PA_SINK_DECIBEL_VOLUME}
+sinkFlagsToInt SinkFlatVolume = #{const PA_SINK_FLAT_VOLUME}
+sinkFlagsToInt SinkDynamicLatency = #{const PA_SINK_DYNAMIC_LATENCY}
+sinkFlagsToInt SinkSetFormats = #{const PA_SINK_SET_FORMATS}
+
+sinkFlagssToInt :: [SinkFlags] -> CInt
+sinkFlagssToInt = foldFlag sinkFlagsToInt
+
+sinkFlagssFromInt :: CInt -> [SinkFlags]
+sinkFlagssFromInt i =
+ let
+ t0 = if (i .&. #{const PA_SINK_NOFLAGS} /= 0) then (SinkNoflags:) else id
+ t1 = if (i .&. #{const PA_SINK_HW_VOLUME_CTRL} /= 0) then (SinkHwVolumeCtrl:) else id
+ t2 = if (i .&. #{const PA_SINK_LATENCY} /= 0) then (SinkLatency:) else id
+ t3 = if (i .&. #{const PA_SINK_HARDWARE} /= 0) then (SinkHardware:) else id
+ t4 = if (i .&. #{const PA_SINK_NETWORK} /= 0) then (SinkNetwork:) else id
+ t5 = if (i .&. #{const PA_SINK_HW_MUTE_CTRL} /= 0) then (SinkHwMuteCtrl:) else id
+ t6 = if (i .&. #{const PA_SINK_DECIBEL_VOLUME} /= 0) then (SinkDecibelVolume:) else id
+ t7 = if (i .&. #{const PA_SINK_FLAT_VOLUME} /= 0) then (SinkFlatVolume:) else id
+ t8 = if (i .&. #{const PA_SINK_DYNAMIC_LATENCY} /= 0) then (SinkDynamicLatency:) else id
+ t9 = if (i .&. #{const PA_SINK_SET_FORMATS} /= 0) then (SinkSetFormats:) else id
+ in t0 . t1 . t2 . t3 . t4 . t5 . t6 . t7 . t8 . t9 . id $ []
+data SourceFlags
+ = SourceNoflags
+ | SourceHwVolumeCtrl
+ | SourceLatency
+ | SourceHardware
+ | SourceNetwork
+ | SourceHwMuteCtrl
+ | SourceDecibelVolume
+ | SourceDynamicLatency
+ | SourceFlatVolume
+ deriving (Eq, Show)
+
+sourceFlagsToInt :: SourceFlags -> CInt
+sourceFlagsToInt SourceNoflags = #{const PA_SOURCE_NOFLAGS}
+sourceFlagsToInt SourceHwVolumeCtrl = #{const PA_SOURCE_HW_VOLUME_CTRL}
+sourceFlagsToInt SourceLatency = #{const PA_SOURCE_LATENCY}
+sourceFlagsToInt SourceHardware = #{const PA_SOURCE_HARDWARE}
+sourceFlagsToInt SourceNetwork = #{const PA_SOURCE_NETWORK}
+sourceFlagsToInt SourceHwMuteCtrl = #{const PA_SOURCE_HW_MUTE_CTRL}
+sourceFlagsToInt SourceDecibelVolume = #{const PA_SOURCE_DECIBEL_VOLUME}
+sourceFlagsToInt SourceDynamicLatency = #{const PA_SOURCE_DYNAMIC_LATENCY}
+sourceFlagsToInt SourceFlatVolume = #{const PA_SOURCE_FLAT_VOLUME}
+
+sourceFlagssToInt :: [SourceFlags] -> CInt
+sourceFlagssToInt = foldFlag sourceFlagsToInt
+
+sourceFlagssFromInt :: CInt -> [SourceFlags]
+sourceFlagssFromInt i =
+ let
+ t0 = if (i .&. #{const PA_SOURCE_NOFLAGS} /= 0) then (SourceNoflags:) else id
+ t1 = if (i .&. #{const PA_SOURCE_HW_VOLUME_CTRL} /= 0) then (SourceHwVolumeCtrl:) else id
+ t2 = if (i .&. #{const PA_SOURCE_LATENCY} /= 0) then (SourceLatency:) else id
+ t3 = if (i .&. #{const PA_SOURCE_HARDWARE} /= 0) then (SourceHardware:) else id
+ t4 = if (i .&. #{const PA_SOURCE_NETWORK} /= 0) then (SourceNetwork:) else id
+ t5 = if (i .&. #{const PA_SOURCE_HW_MUTE_CTRL} /= 0) then (SourceHwMuteCtrl:) else id
+ t6 = if (i .&. #{const PA_SOURCE_DECIBEL_VOLUME} /= 0) then (SourceDecibelVolume:) else id
+ t7 = if (i .&. #{const PA_SOURCE_DYNAMIC_LATENCY} /= 0) then (SourceDynamicLatency:) else id
+ t8 = if (i .&. #{const PA_SOURCE_FLAT_VOLUME} /= 0) then (SourceFlatVolume:) else id
+ in t0 . t1 . t2 . t3 . t4 . t5 . t6 . t7 . t8 . id $ []
diff --git a/src/Sound/Pulse/Mainloop.hsc b/src/Sound/Pulse/Mainloop.hsc
new file mode 100644
--- /dev/null
+++ b/src/Sound/Pulse/Mainloop.hsc
@@ -0,0 +1,361 @@
+{-
+ Copyright 2016 Markus Ongyerth
+
+ This file is part of pulseaudio-hs.
+
+ Monky is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Lesser General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ Monky is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public License
+ along with pulseaudio-hs. If not, see .
+-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE RecordWildCards #-}
+{-|
+Module : Sound.Pulse.Mainloop
+Description : Provides a class and wrapper type for Mainloop abstraction
+Maintianer : ongy
+Stability : experimental
+
+This module provides Haskell abstractions over the pulse mainloop-api .
+
+There is also a simple implementation for this in 'Sound.Pulse.Mainloop.Simple'.
+-}
+module Sound.Pulse.Mainloop
+ ( PAMainloop(..)
+ , PAIOEventFlags(..)
+ , PAMainloopApi
+ , getMainloopApi
+
+ )
+where
+
+import Sound.Pulse.Userdata
+
+#if __GLASGOW_HASKELL__ < 800
+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
+#endif
+#include
+
+import Control.Applicative ((<$>), (<*>))
+import Foreign.Marshal.Utils (with)
+import Foreign.Storable
+import Foreign.StablePtr
+import Foreign.Ptr
+import Foreign.C.Types
+import System.Posix.Types (Fd(..))
+
+import Data.Bits ((.&.), (.|.))
+
+import Control.Concurrent.MVar
+
+import Data.Time
+import Data.Time.Internal
+
+-- |Events that 'PAIOEvent's may wait for.
+-- At my current level of testing, it looks like libpulse only uses Input (and
+-- I guess output when writing to the server)
+data PAIOEventFlags
+ = PAIOEventNull -- ^No Event (this is for compatibility, should never show up)
+ | PAIOEventInput -- ^Fd went ready for reading
+ | PAIOEventOutput -- ^Fd went ready for writing
+ | PAIOEventHangup -- ^Fd got a hangup (see poll documentation)
+ | PAIOEventError -- ^Fd got an error (see poll documentation)
+ deriving (Eq, Show)
+
+-- |Internal function for conversion
+ioEventToCInt :: PAIOEventFlags -> CInt
+ioEventToCInt PAIOEventNull = #{const PA_IO_EVENT_NULL}
+ioEventToCInt PAIOEventInput = #{const PA_IO_EVENT_INPUT}
+ioEventToCInt PAIOEventOutput = #{const PA_IO_EVENT_OUTPUT}
+ioEventToCInt PAIOEventHangup = #{const PA_IO_EVENT_HANGUP}
+ioEventToCInt PAIOEventError = #{const PA_IO_EVENT_ERROR}
+
+-- |Internal function for conversion
+ioEventsToCInt :: [PAIOEventFlags] -> CInt
+ioEventsToCInt xs = foldr (\x y -> ioEventToCInt x .|. y) 0 xs
+
+-- |Internal function for conversion
+ioEventsFromCInt :: CInt -> [PAIOEventFlags]
+ioEventsFromCInt val =
+ let enull = potAdd PAIOEventNull []
+ input = potAdd PAIOEventInput enull
+ output = potAdd PAIOEventOutput input
+ hangup = potAdd PAIOEventHangup output
+ err = potAdd PAIOEventError hangup
+ in err
+ where potAdd :: PAIOEventFlags -> ([PAIOEventFlags] -> [PAIOEventFlags])
+ potAdd con = if (val .&. ioEventToCInt con) /= 0 then (con:) else id
+
+{- | The main class for a pulseaudio mainloop abstraction. -}
+class PAMainloop a where
+ -- |Pulseaudio IO event. Will have to wait for an Fd to become ready
+ -- (w.r.t. to flags)
+ data PAIOEvent a :: *
+ -- |Pulseaudio Time event. Should fire at a specified time.
+ data PATimeEvent a :: *
+ -- |Pulseaudio Defer event. Should be handled before other events. May
+ -- be disabled.
+ data PADeferEvent a :: *
+
+ -- |Create a new 'PAIOEvent' and set it to listen for specified events.
+ ioNew :: a -> Fd -> [PAIOEventFlags] -> ([PAIOEventFlags] -> IO ()) -> IO (PAIOEvent a)
+ -- |Modify the events an IOEvent is waiting on.
+ ioEnable :: (PAIOEvent a) -> [PAIOEventFlags] -> IO ()
+ -- |Delete an IOEvent.
+ ioFree :: (PAIOEvent a) -> IO ()
+ -- |Set the destroy handler of an IOEvent. The handler should be called,
+ -- when the event is deleted.
+ ioSetDestroy :: (PAIOEvent a) -> IO () -> IO ()
+
+ -- |Create a new 'PATimeEvent'. This should fire at the given time.
+ timeNew :: a -> PATime -> (PATime -> IO ()) -> IO (PATimeEvent a)
+ -- |Set a new time when the 'PATimeEvent' should fire. This may require
+ -- requeing.
+ timeRestart :: PATimeEvent a -> PATime -> IO ()
+ -- |Delete a 'PATimeEvent'.
+ timeFree :: PATimeEvent a -> IO ()
+ -- |Set the destroy handler.
+ timeSetDestroy :: PATimeEvent a -> IO () -> IO ()
+
+ -- |Create a new 'PADefereEvent'. This should be fired before any other
+ -- events.
+ deferNew :: a -> IO () -> IO (PADeferEvent a)
+ -- |Enable or disable a 'PADefereEvent'.
+ deferEnable :: PADeferEvent a -> Bool -> IO ()
+ -- |Delete the event.
+ deferFree :: PADeferEvent a -> IO ()
+ -- |Set the destroy handler for the event.
+ deferSetDestroy :: PADeferEvent a -> IO () -> IO ()
+
+ -- |Quit the mainloop and return the given int.
+ quitLoop :: a -> Int -> IO ()
+
+-- |Internal wrapper type for PAIOEvent
+data PAIOEventW a = PAIOEventW
+ {- ioRealHandle :: -} (PAIOEvent a)
+ {- ioWrappedData :: -} (Ptr Userdata)
+ {- ioWrappedApi :: -} (Ptr (PAMainloopApi a))
+
+-- |"Record-name"
+ioRealHandle :: PAIOEventW a -> PAIOEvent a
+ioRealHandle (PAIOEventW x _ _) = x
+
+-- |Internal wrapper type for PATimeEvent
+data PATimeEventW a = PATimeEventW
+ {- timeRealHandle :: -} (PATimeEvent a)
+ {- timeWrappedData :: -} (Ptr Userdata)
+ {- timeWrappedApi :: -} (Ptr (PAMainloopApi a))
+
+-- |"Record-name"
+timeRealHandle :: PATimeEventW a -> PATimeEvent a
+timeRealHandle (PATimeEventW x _ _) = x
+
+-- |Internal wrapper type for PADeferEvent
+data PADeferEventW a = PADeferEventW
+ {- deferRealHandle :: -} (PADeferEvent a)
+ {- deferWrappedData :: -} (Ptr Userdata)
+ {- deferWrappedApi :: -} (Ptr (PAMainloopApi a))
+
+-- |"Record-name"
+deferRealHandle :: PADeferEventW a -> PADeferEvent a
+deferRealHandle (PADeferEventW x _ _) = x
+
+{- IO Events -}
+type IOEvCB a = Ptr (PAMainloopApi a) -> StablePtr (PAIOEventW a) -> CInt -> CInt -> Ptr Userdata -> IO ()
+foreign import ccall "dynamic" mkIOEvCB :: FunPtr (IOEvCB a) -> (IOEvCB a)
+
+type IONew a = Ptr (PAMainloopApi a) -> CInt -> CInt -> FunPtr (IOEvCB a) -> Ptr Userdata -> IO (StablePtr (PAIOEventW a))
+foreign import ccall "wrapper" mkIONew :: IONew a -> IO (FunPtr (IONew a))
+
+type IOEnable a = StablePtr (PAIOEventW a) -> CInt -> IO ()
+foreign import ccall "wrapper" mkIOEnable :: IOEnable a -> IO (FunPtr (IOEnable a))
+
+type IOFree a = StablePtr (PAIOEventW a) -> IO ()
+foreign import ccall "wrapper" mkIOFree :: IOFree a -> IO (FunPtr (IOFree a))
+
+type IODestroy a = Ptr (PAMainloopApi a) -> StablePtr (PAIOEventW a) -> Ptr Userdata -> IO ()
+foreign import ccall "dynamic" mkIODestroy :: FunPtr (IODestroy a) -> (IODestroy a)
+
+type IOSetDestroy a = StablePtr (PAIOEventW a) -> FunPtr (IODestroy a) -> IO ()
+foreign import ccall "wrapper" mkIOSetDestroy :: IOSetDestroy a -> IO (FunPtr (IOSetDestroy a))
+
+{- Time Events -}
+type TimeEvCB a = Ptr (PAMainloopApi a) -> StablePtr (PATimeEventW a) -> Ptr PAITime -> Ptr Userdata -> IO ()
+foreign import ccall "dynamic" mkTimeEvCB :: FunPtr (TimeEvCB a) -> (TimeEvCB a)
+
+type TimeNew a = Ptr (PAMainloopApi a) -> Ptr PAITime -> FunPtr (TimeEvCB a) -> Ptr Userdata -> IO (StablePtr (PATimeEventW a))
+foreign import ccall "wrapper" mkTimeNew :: TimeNew a -> IO (FunPtr (TimeNew a))
+
+type TimeRestart a = StablePtr (PATimeEventW a) -> Ptr PAITime -> IO ()
+foreign import ccall "wrapper" mkTimeRestart :: TimeRestart a -> IO (FunPtr (TimeRestart a))
+
+type TimeFree a = StablePtr (PATimeEventW a) -> IO ()
+foreign import ccall "wrapper" mkTimeFree :: TimeFree a -> IO (FunPtr (TimeFree a))
+
+type TimeDestroy a = Ptr (PAMainloopApi a) -> StablePtr (PATimeEventW a) -> Ptr Userdata -> IO ()
+foreign import ccall "dynamic" mkTimeDestroy :: FunPtr (TimeDestroy a) -> (TimeDestroy a)
+
+type TimeSetDestroy a = StablePtr (PATimeEventW a) -> FunPtr (TimeDestroy a) -> IO ()
+foreign import ccall "wrapper" mkTimeSetDestroy :: TimeSetDestroy a -> IO (FunPtr (TimeSetDestroy a))
+
+{- Defer Events -}
+type DeferEvCB a = Ptr (PAMainloopApi a) -> StablePtr (PADeferEventW a) -> Ptr Userdata -> IO ()
+foreign import ccall "dynamic" mkDeferEvCB :: FunPtr (DeferEvCB a) -> DeferEvCB a
+
+type DeferNew a = Ptr (PAMainloopApi a) -> FunPtr (DeferEvCB a) -> Ptr Userdata -> IO (StablePtr (PADeferEventW a))
+foreign import ccall "wrapper" mkDeferNew :: DeferNew a -> IO (FunPtr (DeferNew a))
+
+type DeferEnable a = StablePtr (PADeferEventW a) -> CInt -> IO ()
+foreign import ccall "wrapper" mkDeferEnable :: DeferEnable a -> IO (FunPtr (DeferEnable a))
+
+type DeferFree a = StablePtr (PADeferEventW a) -> IO ()
+foreign import ccall "wrapper" mkDeferFree :: DeferFree a -> IO (FunPtr (DeferFree a))
+
+type DeferDestroy a = Ptr (PAMainloopApi a) -> StablePtr (PADeferEventW a) -> Ptr Userdata -> IO ()
+foreign import ccall "dynamic" mkDeferDestroy :: FunPtr (DeferDestroy a) -> (DeferDestroy a)
+
+type DeferSetDestroy a = StablePtr (PADeferEventW a) -> FunPtr (DeferDestroy a) -> IO ()
+foreign import ccall "wrapper" mkDeferSetDestroy :: DeferSetDestroy a -> IO (FunPtr (DeferSetDestroy a))
+
+type Quit a = Ptr (PAMainloopApi a) -> CInt -> IO ()
+foreign import ccall "wrapper" mkQuit :: Quit a -> IO (FunPtr (Quit a))
+
+-- |The type used to encapsule a 'PAMainloop' in a C compatible struct of
+-- 'FunPtr's.
+data PAMainloopApi a = PAMainloopApi
+ { userdata :: StablePtr a
+
+ , io_new :: FunPtr (IONew a)
+ , io_enable :: FunPtr (IOEnable a)
+ , io_free :: FunPtr (IOFree a)
+ , io_set_destroy :: FunPtr (IOSetDestroy a)
+
+ , time_new :: FunPtr (TimeNew a)
+ , time_restart :: FunPtr (TimeRestart a)
+ , time_free :: FunPtr (TimeFree a)
+ , time_set_destroy :: FunPtr (TimeSetDestroy a)
+
+ , defer_new :: FunPtr (DeferNew a)
+ , defer_enable :: FunPtr (DeferEnable a)
+ , defer_free :: FunPtr (DeferFree a)
+ , defer_set_destroy :: FunPtr (DeferSetDestroy a)
+
+ , quit :: FunPtr (Quit a)
+ }
+
+instance Storable (PAMainloopApi a) where
+ sizeOf _ = #{size pa_mainloop_api}
+ alignment _ = #{alignment pa_mainloop_api}
+ peek p = PAMainloopApi
+ <$> #{peek pa_mainloop_api, userdata} p
+ <*> #{peek pa_mainloop_api, io_new} p
+ <*> #{peek pa_mainloop_api, io_enable} p
+ <*> #{peek pa_mainloop_api, io_free} p
+ <*> #{peek pa_mainloop_api, io_set_destroy} p
+ <*> #{peek pa_mainloop_api, time_new} p
+ <*> #{peek pa_mainloop_api, time_restart} p
+ <*> #{peek pa_mainloop_api, time_free} p
+ <*> #{peek pa_mainloop_api, time_set_destroy} p
+ <*> #{peek pa_mainloop_api, defer_new} p
+ <*> #{peek pa_mainloop_api, defer_enable} p
+ <*> #{peek pa_mainloop_api, defer_free} p
+ <*> #{peek pa_mainloop_api, defer_set_destroy} p
+ <*> #{peek pa_mainloop_api, quit} p
+ poke p (PAMainloopApi {..}) = do
+ #{poke pa_mainloop_api, userdata} p userdata
+ #{poke pa_mainloop_api, io_new} p io_new
+ #{poke pa_mainloop_api, io_enable} p io_enable
+ #{poke pa_mainloop_api, io_free} p io_free
+ #{poke pa_mainloop_api, io_set_destroy} p io_set_destroy
+ #{poke pa_mainloop_api, time_new} p time_new
+ #{poke pa_mainloop_api, time_restart} p time_restart
+ #{poke pa_mainloop_api, time_free} p time_free
+ #{poke pa_mainloop_api, time_set_destroy} p time_set_destroy
+ #{poke pa_mainloop_api, defer_new} p defer_new
+ #{poke pa_mainloop_api, defer_enable} p defer_enable
+ #{poke pa_mainloop_api, defer_free} p defer_free
+ #{poke pa_mainloop_api, defer_set_destroy} p defer_set_destroy
+ #{poke pa_mainloop_api, quit} p quit
+
+-- |Get the Mainloop back from a 'PAMainloopApi' without marshalling all of it.
+getMainloopImpl :: Ptr (PAMainloopApi a) -> IO a
+getMainloopImpl p =
+ deRefStablePtr =<< (peek . #{ptr pa_mainloop_api, userdata} $ p)
+
+-- |Warning! This leaks a bit of memory when it's Garbage collected, because
+-- the FunPtrs created for the PulseApi cannot be collected at that point.
+-- Currently there is no way to properly free them, but this should only be
+-- called once per application, so this will be a known Bug for now.
+getMainloopApi :: PAMainloop a => a -> IO (PAMainloopApi a)
+getMainloopApi api = do
+ io_enable <- mkIOEnable $ \ptr flags -> do
+ evt <- deRefStablePtr ptr
+ ioEnable (ioRealHandle evt) (ioEventsFromCInt flags)
+ io_new <- mkIONew $ \a fd flags fptr usr -> do
+ -- This is stupid :(
+ let fun = mkIOEvCB fptr
+ impl <- getMainloopImpl a
+ mvar <- newEmptyMVar
+ ret <- ioNew impl (Fd fd) (ioEventsFromCInt flags) $ \iflags -> do
+ evtp <- readMVar mvar
+ fun a evtp fd (ioEventsToCInt iflags) usr
+ rpt <- newStablePtr $ PAIOEventW ret usr a
+ putMVar mvar rpt
+ return rpt
+ io_free <- mkIOFree ((=<<) (ioFree . ioRealHandle) . deRefStablePtr)
+ io_set_destroy <- mkIOSetDestroy $ \ptr fptr -> do
+ let fun = mkIODestroy fptr
+ (PAIOEventW evt usr a) <- deRefStablePtr ptr
+ ioSetDestroy evt $ fun a ptr usr
+
+ time_new <- mkTimeNew $ \a timep fptr usr -> do
+ let fun = mkTimeEvCB fptr
+ impl <- getMainloopImpl a
+ mvar <- newEmptyMVar
+ time <- peek timep
+ ret <- timeNew impl (fromPAI time) $ \itime -> do
+ evt <- readMVar mvar
+ with (toPAI itime) $ flip (fun a evt) usr
+ rpt <- newStablePtr $ PATimeEventW ret usr a
+ putMVar mvar rpt
+ return rpt
+ time_restart <- mkTimeRestart $ \ptr timep -> do
+ time <- peek timep
+ flip timeRestart (fromPAI time) . timeRealHandle =<< deRefStablePtr ptr
+ time_free <- mkTimeFree ((=<<) (timeFree . timeRealHandle) . deRefStablePtr)
+ time_set_destroy <- mkTimeSetDestroy $ \ptr fptr -> do
+ let fun = mkTimeDestroy fptr
+ (PATimeEventW evt usr a) <- deRefStablePtr ptr
+ timeSetDestroy evt $ fun a ptr usr
+
+ defer_new <- mkDeferNew $ \a fptr usr -> do
+ let fun = mkDeferEvCB fptr
+ impl <- getMainloopImpl a
+ mvar <- newEmptyMVar
+ ret <- deferNew impl $ (flip (fun a) usr =<< readMVar mvar)
+ rpt <- newStablePtr $ PADeferEventW ret usr a
+ putMVar mvar rpt
+ return rpt
+ defer_enable <- mkDeferEnable $ \ptr switch -> do
+ flip deferEnable (switch /= 0) . deferRealHandle =<< deRefStablePtr ptr
+ defer_free <- mkDeferFree ((=<<) (deferFree . deferRealHandle) . deRefStablePtr)
+ defer_set_destroy <- mkDeferSetDestroy $ \ptr fptr -> do
+ let fun = mkDeferDestroy fptr
+ (PADeferEventW evt usr a) <- deRefStablePtr ptr
+ deferSetDestroy evt $ fun a ptr usr
+
+ quit <- mkQuit $ \ptr val -> do
+ impl <- getMainloopImpl ptr
+ quitLoop impl (fromIntegral val)
+ userdata <- newStablePtr api
+ return $ PAMainloopApi {..}
diff --git a/src/Sound/Pulse/Mainloop/Simple.hs b/src/Sound/Pulse/Mainloop/Simple.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/Pulse/Mainloop/Simple.hs
@@ -0,0 +1,372 @@
+{-
+ Copyright 2016 Markus Ongyerth
+
+ This file is part of pulseaudio-hs.
+
+ Monky is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Lesser General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ Monky is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public License
+ along with pulseaudio-hs. If not, see .
+-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE CPP #-}
+{-|
+Module : Sound.Pulse.Mainloop.Simple
+Description : provides a simple (buggy?) implementation of the pulse mainloop.
+Maintianer : ongy
+Stability : experimental
+
+This implementation lacks support for anything but IOInput and IOOutput!.
+
+The main appeal of this is, that it runs in the Haskell RTS system and does not
+block the RTS in any way.
+If the 'doLoop' function is called in an 'forkIO', all functions will "just work",
+and may be wrapped into a synchronous api wrapper.
+
+If the callback style application flow should be used, this will dispatch all
+callbacks in the same (Haskell)-thread.
+
+Most function *should* be thread safe (adding multiple events etc.) but there are
+no checks done for incompatible things happening (modifying and removing the same event).
+-}
+module Sound.Pulse.Mainloop.Simple
+ ( MainloopImpl
+ , getMainloopImpl
+ , doIteration
+ , doLoop
+ )
+where
+
+import Data.Word (Word)
+import Control.Applicative ((<$>), (<*>))
+import System.Timeout (timeout)
+import Data.Maybe (listToMaybe, fromJust, isJust)
+import Control.Applicative
+import Control.Arrow ((&&&))
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Monad (void, join, when, filterM)
+import Data.IORef
+import Data.List (insertBy, delete, deleteBy)
+import Data.Ord (comparing)
+import System.Posix.IO (createPipe, fdWrite, fdRead)
+import System.Posix.Types (Fd(..))
+
+import Sound.Pulse.Mainloop
+import Data.Time
+
+-- so ghc 7.6 doesn't have threadWait(Read/Write)STM yet....
+#if MIN_VERSION_base(4,7,0)
+#else
+import Control.Concurrent.STM.TVar
+threadWaitReadSTM :: Fd -> IO (STM (), IO ())
+threadWaitReadSTM fd = do
+ m <- newTVarIO False
+ _ <- forkIO $ do
+ threadWaitRead fd
+ atomically $ writeTVar m True
+ let waitAction = do b <- readTVar m
+ if b then return () else retry
+ let killAction = return ()
+ return (waitAction, killAction)
+
+-- | Returns an STM action that can be used to wait until data
+-- can be written to a file descriptor. The second returned value
+-- is an IO action that can be used to deregister interest
+-- in the file descriptor.
+threadWaitWriteSTM :: Fd -> IO (STM (), IO ())
+threadWaitWriteSTM fd = do
+ m <- newTVarIO False
+ _ <- forkIO $ do
+ threadWaitWrite fd
+ atomically $ writeTVar m True
+ let waitAction = do b <- readTVar m
+ if b then return () else retry
+ let killAction = return ()
+ return (waitAction, killAction)
+#endif
+
+-- Has to keep state internally because of StablePtrs being passed around
+-- |The 'PAIOEvent' type for this implementation
+data IOEvent = IOEvent
+ { ioCallback :: [PAIOEventFlags] -> IO ()
+ , ioFd :: Fd
+ , ioImpl :: MainloopImpl
+ , ioID :: Word
+ , ioEvents :: IORef ([PAIOEventFlags])
+ , ioDestroy :: IORef (IO ())
+ }
+
+instance Eq IOEvent where
+ x == y = ioID x == ioID y
+
+-- |The 'PATimeEvent' type for this implementation
+data TimeEvent = TimeEvent
+ { timeCallback :: PATime -> IO ()
+ , timeImpl :: MainloopImpl
+ , timeID :: Word
+ , timeDeadline :: IORef(PATime) -- Can be updated -.-
+ , timeDestroy :: IORef(IO ())
+ }
+
+instance Eq TimeEvent where
+ x == y = timeID x == timeID y
+
+-- |The 'PADeferEvent' type for this implementation
+data DeferEvent = DeferEvent
+ { deferCallback :: IO ()
+ , deferImpl :: MainloopImpl
+ , deferID :: Word
+ , deferEnabled :: IORef (Bool)
+ , deferDestroy :: IORef (IO ())
+ }
+
+instance Eq DeferEvent where
+ x == y = deferID x == deferID y
+
+-- |Implementation type, keeping state about existing events.
+data MainloopImpl = MainloopImpl
+ -- Lists for events
+ { implIOEvents :: IORef [IOEvent]
+ , implTimeEvents :: IORef [(PATime, TimeEvent)] -- ^The first entry will be the first one to expire (or has already expired)
+ , implTimeDisable :: IORef [TimeEvent] -- ^The first entry will be the first one to expire (or has already expired)
+ , implDeferEvents :: IORef [DeferEvent]
+
+ -- Counters for event ID
+ , implIOCount :: IORef Word
+ , implTimeCount :: IORef Word
+ , implDeferCount :: IORef Word
+
+ -- If set to Just x, return x
+ , implRunning :: IORef (Maybe Int)
+ , implPipe :: (Fd, Fd)
+ }
+
+-- We already checked if we want to read when we are here
+waitReadEvent :: IOEvent -> IO (STM (PAIOEventFlags, IOEvent))
+waitReadEvent evt = do
+ (wait, _) <- threadWaitReadSTM $ ioFd evt
+ return $ do
+ wait
+ return (PAIOEventInput, evt)
+
+-- We already checked if we want to write when we are here
+waitWriteEvent :: IOEvent -> IO (STM (PAIOEventFlags, IOEvent))
+waitWriteEvent evt = do
+ (wait, _) <- threadWaitWriteSTM $ ioFd evt
+ return $ do
+ wait
+ return (PAIOEventOutput, evt)
+
+-- |Split up the IOEvents into different event types.
+splitEvents :: [IOEvent] -> IO ([IOEvent], [IOEvent])
+splitEvents [] = return ([], [])
+splitEvents (x:xs) = do
+ (tr, tw) <- splitEvents xs
+ events <- readIORef $ ioEvents x
+ let cr = if PAIOEventInput `elem` events then (x:) else id
+ let cw = if PAIOEventOutput `elem` events then (x:) else id
+ when (PAIOEventHangup `elem` events) (fail "PASimple does not support Hangup")
+ when (PAIOEventError `elem` events) (fail "PASimple does not support Error")
+ return (cr tr, cw tw)
+
+-- |Create the STM event we want to wait on, to get the next event possible.
+waitEvents :: MainloopImpl -> IO (STM (PAIOEventFlags, IOEvent))
+waitEvents impl = do
+ (readEvt, writeEvt) <- splitEvents =<< readIORef (implIOEvents impl)
+ readEvts <- mapM waitReadEvent readEvt
+ writeEvts <- mapM waitWriteEvent writeEvt
+ let readSTM = foldr (<|>) retry readEvts
+ let writeSTM = foldr (<|>) retry writeEvts
+ return (readSTM <|> writeSTM)
+ -- if null readEvts
+ -- then retry
+ -- else foldr1 (<|>) readEvts
+ -- if null writeEvts
+ -- then retry
+ -- else foldr1 (<|>) writeEvts
+ -- We prefere reading over writing with this!
+
+-- |Do one iteration of waiting for and dispatching events.
+doRun :: MainloopImpl -> IO ()
+doRun impl = do
+ (pipeWait, _) <- threadWaitReadSTM . fst . implPipe $ impl
+ wait <- waitEvents impl
+ nextT <- fmap snd . listToMaybe <$> readIORef (implTimeEvents impl)
+ -- let nextT = Nothing
+ capp <- case nextT of
+ Nothing -> return (fmap Just)
+ Just x -> do
+ now <- getTime
+ evt <- readIORef $ timeDeadline x
+ -- putStrLn ("Waiting for: " ++ show (timeToUS (getDiff evt now)))
+ return . timeout $ if now > evt
+ then 0
+ else fromIntegral (timeToUS (getDiff evt now))
+ ret <- capp (atomically ((Right <$> wait) <|> (Left <$> pipeWait)))
+ case ret of
+ -- if it is nothing we know that we have a timeout
+ Nothing -> do
+ let evt = fromJust nextT
+ time <- readIORef $ timeDeadline evt
+ atomModifyIORef (implTimeEvents impl) tail
+ atomModifyIORef (implTimeDisable impl) (evt:)
+ timeCallback evt time
+ -- Just Right -> We got an IO Event
+ Just (Right (flag, evt)) -> do
+ ioCallback evt [flag]
+ -- Just Left -> We got woken up (read on pipe)
+ -- We have to throw away what we wrote to wake up, so read
+ Just (Left _) -> do
+ _ <- fdRead (fst . implPipe $ impl) 512
+ return ()
+
+-- |Do one iteration of events. This may be dispatchin defered events,
+-- a timer, an io event, or simply a wakeup.
+-- Event callback will be called in the same thread as this!
+doIteration :: MainloopImpl -> IO ()
+doIteration impl = do
+ defers <- readIORef $ implDeferEvents impl
+ actives <- filterM (readIORef . deferEnabled) defers
+ if null actives
+ then doRun impl
+ else do
+ mapM_ deferCallback actives
+
+-- |Loop in the pulse main loop until eternety
+doLoop :: MainloopImpl -> IO ()
+doLoop impl = do
+ doIteration impl
+ cont <- readIORef $ implRunning impl
+ if isJust cont
+ then putStrLn ("Ending Simpleloop: " ++ show cont)
+ else doLoop impl
+
+
+-- |Create a new 'MainloopImpl' with initial state
+getMainloopImpl :: IO MainloopImpl
+getMainloopImpl = MainloopImpl
+ <$> newIORef []
+ <*> newIORef []
+ <*> newIORef []
+ <*> newIORef []
+
+ <*> newIORef 0
+ <*> newIORef 0
+ <*> newIORef 0
+
+ <*> newIORef Nothing
+ <*> createPipe
+ -- <*> do
+ -- (r, w) <- createPipe
+ -- rh <- fdToHandle r
+ -- wh <- fdToHandle w
+ -- return (rh, wh)
+
+
+atomModifyIORef :: IORef a -> (a -> a) -> IO ()
+atomModifyIORef ref fun = void $ atomicModifyIORef ref (fun &&& id)
+
+removeTimeEvent :: TimeEvent -> IO ()
+removeTimeEvent evt =
+ atomModifyIORef (implTimeEvents . timeImpl $ evt) (deleteBy (\x y -> snd x == snd y) (dummyTime, evt))
+
+wakeImpl :: MainloopImpl -> IO ()
+wakeImpl = void . flip fdWrite "wakeup" . snd . implPipe
+
+instance PAMainloop MainloopImpl where
+ -- newtype wrappers, only needed because of the type system limitations
+ newtype PAIOEvent MainloopImpl = PAIOEvent IOEvent
+ newtype PATimeEvent MainloopImpl = PATimeEvent TimeEvent
+ newtype PADeferEvent MainloopImpl = PADeferEvent DeferEvent
+
+ ioNew :: MainloopImpl -> Fd -> [PAIOEventFlags] -> ([PAIOEventFlags] -> IO ()) -> IO (PAIOEvent MainloopImpl)
+ ioNew impl fd flags callback = do
+ count <- atomicModifyIORef (implIOCount impl) ((+1) &&& id)
+ -- putStrLn ("new IOEvent: " ++ show count)
+ evt <- IOEvent callback fd impl count <$> newIORef flags <*> newIORef (return ())
+ atomModifyIORef (implIOEvents impl) (evt:)
+ wakeImpl impl
+ return $ PAIOEvent evt
+
+ ioEnable :: (PAIOEvent MainloopImpl) -> [PAIOEventFlags] -> IO ()
+ ioEnable (PAIOEvent x) flags = do
+ atomicWriteIORef (ioEvents x) flags
+ wakeImpl $ ioImpl x
+
+ ioFree :: (PAIOEvent MainloopImpl) -> IO ()
+ ioFree (PAIOEvent x) = do
+ -- putStrLn "removing IOEvent"
+ atomModifyIORef (implIOEvents . ioImpl $ x) (delete x)
+ join . readIORef . ioDestroy $ x
+ wakeImpl $ ioImpl x
+
+ ioSetDestroy :: (PAIOEvent MainloopImpl) -> IO () -> IO ()
+ ioSetDestroy (PAIOEvent x) = atomicWriteIORef (ioDestroy x)
+
+
+ timeNew :: MainloopImpl -> PATime -> (PATime -> IO ()) -> IO (PATimeEvent MainloopImpl)
+ timeNew impl time callback = do
+ -- putStrLn ("new TimeEvent: " ++ show time)
+ count <- atomicModifyIORef (implTimeCount impl) ((+1) &&& id)
+ evt <- TimeEvent callback impl count <$> newIORef time <*> newIORef (return ())
+ atomModifyIORef (implTimeEvents impl) (insertBy (comparing fst) (time, evt))
+ wakeImpl impl
+ return $ PATimeEvent evt
+
+ timeRestart :: PATimeEvent MainloopImpl -> PATime -> IO ()
+ timeRestart (PATimeEvent evt) time = do
+ -- putStrLn ("restarting Timer" ++ show time)
+ removeTimeEvent evt
+ writeIORef (timeDeadline evt) time
+ atomModifyIORef (implTimeEvents $ timeImpl evt) (insertBy (comparing fst) (time, evt) . (filter ((/= evt) . snd)))
+ atomModifyIORef (implTimeDisable $ timeImpl evt) (filter (/=evt))
+ wakeImpl $ timeImpl evt
+
+ timeFree :: PATimeEvent MainloopImpl -> IO ()
+ timeFree (PATimeEvent x) = do
+ -- putStrLn "removing Timer"
+ removeTimeEvent x
+ atomicWriteIORef (timeDeadline x) dummyTime
+ join . readIORef . timeDestroy $ x
+ wakeImpl $ timeImpl x
+
+ timeSetDestroy :: PATimeEvent MainloopImpl -> IO () -> IO ()
+ timeSetDestroy (PATimeEvent x) = atomicWriteIORef (timeDestroy x)
+
+
+ deferNew :: MainloopImpl -> IO () -> IO (PADeferEvent MainloopImpl)
+ deferNew impl callback = do
+ -- putStrLn "new DeferEvent"
+ count <- atomicModifyIORef (implDeferCount impl) ((+1) &&& id)
+ evt <- DeferEvent callback impl count <$> newIORef True <*> newIORef (return ())
+ atomModifyIORef (implDeferEvents impl) (evt:)
+ wakeImpl impl
+ return $ PADeferEvent evt
+
+ deferEnable :: PADeferEvent MainloopImpl -> Bool -> IO ()
+ deferEnable (PADeferEvent x) = atomicWriteIORef (deferEnabled x)
+
+ deferFree :: PADeferEvent MainloopImpl -> IO ()
+ deferFree (PADeferEvent x) = do
+ -- putStrLn "removing DeferEvent"
+ atomModifyIORef (implDeferEvents . deferImpl $ x) (delete x)
+ join . readIORef . deferDestroy $ x
+ -- wakeImpl impl -- not here, when removed it doesn't matter and we
+ -- shouldn't block while a defere event exists
+
+ deferSetDestroy :: PADeferEvent MainloopImpl -> IO () -> IO ()
+ deferSetDestroy (PADeferEvent x) = atomicWriteIORef (deferDestroy x)
+
+ quitLoop :: MainloopImpl -> Int -> IO ()
+ quitLoop impl = atomicWriteIORef (implRunning impl) . Just
+
diff --git a/src/Sound/Pulse/Operation.hs b/src/Sound/Pulse/Operation.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/Pulse/Operation.hs
@@ -0,0 +1,83 @@
+{-
+ Copyright 2016 Markus Ongyerth
+
+ This file is part of pulseaudio-hs.
+
+ Monky is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Lesser General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ Monky is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public License
+ along with pulseaudio-hs. If not, see .
+-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-|
+Module : Sound.Pulse.Operation
+Description : provides wrappers for pa_operation
+Maintianer : ongy
+Stability : experimental
+-}
+module Sound.Pulse.Operation
+ ( Operation
+ , UOperation
+
+ , ptrToOperation
+ , operationCancel
+ , operationGetState
+ , operationSetCallback
+ )
+where
+
+import Control.Applicative ((<$>))
+import Sound.Pulse.Def (OperationState(..), operationStateFromInt)
+import Sound.Pulse.Userdata
+import Foreign.C.Types (CInt(..))
+import Foreign.Ptr
+import Foreign.ForeignPtr
+
+-- |Internal Operation type, used for type safety
+data IOperation
+-- |Unsafe Operation. Should be return value of foreign import calls
+data UOperation
+
+-- |"High"-level operation type, this should be the return type for exported
+-- |functions
+data Operation = Operation (ForeignPtr IOperation)
+
+type OperationNotifyCB = Ptr IOperation -> Ptr Userdata -> IO ()
+foreign import ccall "wrapper" mkOperationNCB :: OperationNotifyCB -> IO (FunPtr OperationNotifyCB)
+
+foreign import ccall "pa_operation_cancel" pa_operation_cancel :: Ptr IOperation -> IO ()
+foreign import ccall "pa_operation_set_state_callback" pa_operation_set_state_callback :: Ptr IOperation -> FunPtr OperationNotifyCB -> Ptr Userdata -> IO ()
+foreign import ccall "pa_operation_get_state" pa_operation_get_state :: Ptr IOperation -> IO CInt
+foreign import ccall "&pa_operation_unref" pa_operation_unref :: FunPtr (Ptr IOperation -> IO ())
+
+-- |Cancel an operation. The server may still do it, but the client will not be
+-- |notified
+operationCancel :: Operation -> IO ()
+operationCancel (Operation i) = withForeignPtr i pa_operation_cancel
+
+-- |This currently leaks the function, after the operation went out of scope
+-- |I'm not quite sure when this will be called either way.
+operationSetCallback :: Operation -> IO () -> IO ()
+operationSetCallback (Operation i) fun = do
+ funP <- mkOperationNCB $ \_ _ -> fun
+ withForeignPtr i $ \x -> pa_operation_set_state_callback x funP nullPtr
+
+-- |Get the State of the operation
+operationGetState :: Operation -> IO OperationState
+operationGetState (Operation i) = operationStateFromInt <$> withForeignPtr i pa_operation_get_state
+
+-- |Convert a Unsafe Operation to a safe one. This should be called by wrappers
+-- |to FFI imports.
+-- |Also call this when not returning the value, since it registers the unref
+-- |function for the operation.
+ptrToOperation :: Ptr UOperation -> IO Operation
+ptrToOperation = fmap Operation . newForeignPtr pa_operation_unref . castPtr
diff --git a/src/Sound/Pulse/SampleSpec.hsc b/src/Sound/Pulse/SampleSpec.hsc
new file mode 100644
--- /dev/null
+++ b/src/Sound/Pulse/SampleSpec.hsc
@@ -0,0 +1,60 @@
+{-
+ Copyright 2016 Markus Ongyerth
+
+ This file is part of pulseaudio-hs.
+
+ Monky is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Lesser General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ Monky is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public License
+ along with pulseaudio-hs. If not, see .
+-}
+{-# LANGUAGE RecordWildCards #-}
+{-|
+Module : Sound.Pulse.SampleSpec
+Description : provides the time type used for pa_sample_spec.
+Maintianer : ongy
+Stability : experimental
+-}
+module Sound.Pulse.SampleSpec
+ ( SampleFormat(..)
+ , SampleSpec(..)
+ )
+where
+
+#if __GLASGOW_HASKELL__ < 800
+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
+#endif
+#include
+
+import Control.Applicative ((<$>), (<*>))
+import Sound.Pulse.Def (SampleFormat(..), sampleFormatFromInt, sampleFormatToInt)
+import Foreign.Storable (Storable(..))
+
+import Data.Word (Word32, Word8, Word)
+
+-- |The pa_sample_spec type for Haskell.
+data SampleSpec = SampleSpec
+ { ssFormat :: SampleFormat
+ , ssRate :: Word32
+ , ssChannels :: Word8
+ } deriving (Eq, Show)
+
+instance Storable SampleSpec where
+ sizeOf _ = #{size struct pa_sample_spec}
+ alignment _ = #{alignment struct pa_sample_spec}
+ peek p = SampleSpec
+ <$> (sampleFormatFromInt <$> #{peek struct pa_sample_spec, format} p)
+ <*> #{peek struct pa_sample_spec, rate} p
+ <*> #{peek struct pa_sample_spec, channels} p
+ poke p (SampleSpec {..}) = do
+ #{poke struct pa_sample_spec, format} p $ sampleFormatToInt ssFormat
+ #{poke struct pa_sample_spec, rate} p ssRate
+ #{poke struct pa_sample_spec, channels} p ssChannels
diff --git a/src/Sound/Pulse/Serverinfo.hsc b/src/Sound/Pulse/Serverinfo.hsc
new file mode 100644
--- /dev/null
+++ b/src/Sound/Pulse/Serverinfo.hsc
@@ -0,0 +1,93 @@
+{-
+ Copyright 2016 Markus Ongyerth
+
+ This file is part of pulseaudio-hs.
+
+ Monky is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Lesser General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ Monky is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public License
+ along with pulseaudio-hs. If not, see .
+-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-|
+Module : Sound.Pulse.Serverinfo
+Description : provides the time type used for pa_server_info.
+Maintianer : ongy
+Stability : experimental
+-}
+module Sound.Pulse.Serverinfo
+ ( ServerInfo(..)
+ , getServerInfo
+ )
+where
+
+#if __GLASGOW_HASKELL__ < 800
+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
+#endif
+#include
+
+import Control.Applicative ((<$>), (<*>))
+import Data.Word (Word32, Word)
+import Sound.Pulse.SampleSpec
+import Sound.Pulse.ChannelPosition
+import Sound.Pulse.Context
+import Sound.Pulse.Userdata
+import Sound.Pulse.Operation
+
+import Foreign.Storable
+import Foreign.Ptr
+import Foreign.C.String
+
+-- |The type used for pa_server_info
+data ServerInfo = ServerInfo
+ { userName :: String
+ , hostName :: String
+ , serverVersion :: String
+ , serverName :: String
+ , sampleSpec :: SampleSpec
+ , defaultSinkName :: String
+ , defaultSourceName :: String
+ , cookie :: Word32
+ , channelMap :: ChannelMap
+ } deriving (Eq, Show)
+
+instance Storable ServerInfo where
+ sizeOf _ = #{size struct pa_server_info}
+ alignment _ = #{alignment struct pa_server_info}
+ peek p = ServerInfo
+ <$> (peekCString =<< #{peek struct pa_server_info, user_name} p)
+ <*> (peekCString =<< #{peek struct pa_server_info, host_name} p)
+ <*> (peekCString =<< #{peek struct pa_server_info, server_version} p)
+ <*> (peekCString =<< #{peek struct pa_server_info, server_name} p)
+ <*> #{peek struct pa_server_info, sample_spec} p
+ <*> (peekCString =<< #{peek struct pa_server_info, default_sink_name} p)
+ <*> (peekCString =<< #{peek struct pa_server_info, default_source_name} p)
+ <*> #{peek struct pa_server_info, cookie} p
+ <*> #{peek struct pa_server_info, channel_map} p
+
+ poke _ _ = error "PA: no poke for ServerInfo yet" -- TODO
+
+type ServerInfoCB = Context -> Ptr ServerInfo -> Ptr Userdata -> IO ()
+foreign import ccall "wrapper" mkServerInfoCB :: ServerInfoCB -> IO (FunPtr ServerInfoCB)
+
+foreign import ccall "pa_context_get_server_info" pa_context_get_server_info :: Context -> FunPtr ServerInfoCB -> Ptr Userdata -> IO (Ptr UOperation)
+
+-- |Get the server info.
+getServerInfo
+ :: Context -- ^Context for the server connection
+ -> (ServerInfo -> IO ())
+ -> IO ()
+getServerInfo cxt fun = do
+ funP <- mkServerInfoCB $ \_ ptr fP -> do
+ fun =<< peek ptr
+ freeHaskellFunPtr (castPtrToFunPtr fP)
+ _ <- ptrToOperation =<< pa_context_get_server_info cxt funP (castFunPtrToPtr funP)
+ return ()
diff --git a/src/Sound/Pulse/Sinkinfo.hsc b/src/Sound/Pulse/Sinkinfo.hsc
new file mode 100644
--- /dev/null
+++ b/src/Sound/Pulse/Sinkinfo.hsc
@@ -0,0 +1,171 @@
+{-
+ Copyright 2016 Markus Ongyerth
+
+ This file is part of pulseaudio-hs.
+
+ Monky is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Lesser General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ Monky is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public License
+ along with pulseaudio-hs. If not, see .
+-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RecordWildCards #-}
+{-|
+Module : Sound.Pulse.Sinkinfo
+Description : provides the time type used for pa_sink_info.
+Maintianer : ongy
+Stability : experimental
+-}
+module Sound.Pulse.Sinkinfo
+ ( SinkFlags(..)
+ , SinkState(..)
+ , Sinkinfo(..)
+
+ , getContextSinks
+ , getContextSinkByName
+ , getContextSinkByIndex
+ )
+where
+
+#if __GLASGOW_HASKELL__ < 800
+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
+#endif
+#include
+
+import Control.Applicative ((<$>), (<*>))
+import Sound.Pulse.Volume
+import Sound.Pulse.Operation
+import Sound.Pulse.Userdata
+import Data.Word (Word32, Word8, Word)
+
+import Foreign.Ptr (Ptr, FunPtr, freeHaskellFunPtr, castFunPtrToPtr, castPtrToFunPtr)
+import Foreign.C.Types (CInt(..), CUInt(..))
+import Foreign.C.String (peekCString, withCString, CString)
+import Foreign.Storable (Storable(..))
+
+import Sound.Pulse.Context (Context)
+import Sound.Pulse.ChannelPosition
+import Sound.Pulse.SampleSpec
+
+import Sound.Pulse.Def (SinkFlags(..), sinkFlagssFromInt, SinkState(..), sinkStateFromInt)
+
+data PropList -- TODO :)
+
+data FormatInfo -- TODO
+data SinkPortInfo -- TODO
+
+-- |Type used for pa_sink_info
+data Sinkinfo = Sinkinfo
+ { siName :: String
+ , siIndex :: Word32
+ , siDescription :: String
+ , siSampleSpec :: SampleSpec
+ , siChannelMap :: ChannelMap
+ , siOwnerModule :: Word32
+ , siVolume :: CVolume
+ , siMute :: Bool
+ , siMonitorSource :: Word32
+ , siMonitorSourceName :: String
+ , siLatency :: Word
+ , siDriver :: String
+ , siFlags :: [SinkFlags]
+ , siProplist :: Ptr PropList
+ , siConfiguredLatency :: Word
+ , siBaseVolume :: Volume
+ , siState :: SinkState
+ , siVolumeSteps :: Word32
+ , siCard :: Word32
+ , siPorts :: [Ptr SinkPortInfo]
+ , siActivePort :: Ptr SinkPortInfo
+ , siFormats :: [Ptr FormatInfo]
+ } deriving (Eq, Show)
+
+instance Storable Sinkinfo where
+ sizeOf _ = #{size struct pa_sink_info}
+ alignment _ = #{alignment struct pa_sink_info}
+ peek p = Sinkinfo
+ <$> (peekCString =<< #{peek struct pa_sink_info, name} p)
+ <*> #{peek struct pa_sink_info, index} p
+ <*> (peekCString =<< #{peek struct pa_sink_info, description} p)
+ <*> #{peek struct pa_sink_info, sample_spec} p
+ <*> #{peek struct pa_sink_info, channel_map} p
+ <*> #{peek struct pa_sink_info, owner_module} p
+ <*> #{peek struct pa_sink_info, volume} p
+ <*> ((/= (0 :: CInt)) <$> (#{peek struct pa_sink_info, mute} p))
+ <*> #{peek struct pa_sink_info, monitor_source} p
+ <*> (peekCString =<< #{peek struct pa_sink_info, monitor_source_name} p)
+ <*> #{peek struct pa_sink_info, latency} p
+ <*> (peekCString =<< #{peek struct pa_sink_info, driver} p)
+ <*> (sinkFlagssFromInt <$> (#{peek struct pa_sink_info, mute} p))
+ <*> #{peek struct pa_sink_info, proplist} p
+ <*> #{peek struct pa_sink_info, configured_latency} p
+ <*> #{peek struct pa_sink_info, base_volume} p
+ <*> (sinkStateFromInt <$> (#{peek struct pa_sink_info, mute} p))
+ <*> #{peek struct pa_sink_info, n_volume_steps} p
+ <*> #{peek struct pa_sink_info, card} p
+ <*> do
+ size :: Word8 <- #{peek struct pa_sink_info, n_ports} p
+ ptr <- #{peek struct pa_sink_info, ports} p
+ mapM (peekElemOff ptr . fromIntegral) [0.. size - 1]
+ <*> #{peek struct pa_sink_info, active_port} p
+ <*> do
+ size :: Word8 <- #{peek struct pa_sink_info, n_formats} p
+ ptr :: Ptr (Ptr FormatInfo) <- #{peek struct pa_sink_info, formats} p
+ mapM (peekElemOff ptr . fromIntegral) [0.. size - 1]
+ poke _ (Sinkinfo {..}) = error "PA: Currently no sinkinfo poke"
+
+type SinkinfoCB = Context -> Ptr Sinkinfo -> CInt -> Ptr Userdata -> IO ()
+foreign import ccall "wrapper" mkSinkinfoCB :: SinkinfoCB -> IO (FunPtr SinkinfoCB)
+
+foreign import ccall "pa_context_get_sink_info_list" pa_context_get_sink_info_list :: Context -> FunPtr SinkinfoCB -> Ptr Userdata -> IO (Ptr UOperation)
+
+foreign import ccall "pa_context_get_sink_info_by_name" pa_context_get_sink_info_by_name :: Context -> CString -> FunPtr SinkinfoCB -> Ptr Userdata -> IO (Ptr UOperation)
+
+foreign import ccall "pa_context_get_sink_info_by_index" pa_context_get_sink_info_by_index :: Context -> CUInt -> FunPtr SinkinfoCB -> Ptr Userdata -> IO (Ptr UOperation)
+
+mkCallback :: (Sinkinfo -> IO ()) -> IO () -> IO (FunPtr SinkinfoCB)
+mkCallback fun endf = mkSinkinfoCB $
+ \_ ptr end fP -> if end == 0
+ then fun =<< peek ptr
+ else do
+ endf -- Call the user end function
+ -- free the FunPtr defiend here
+ freeHaskellFunPtr (castPtrToFunPtr fP)
+
+-- |Get all sinks from a context.
+getContextSinks
+ :: Context -- ^The context
+ -> (Sinkinfo -> IO ()) -- ^List callback. Will be called once per list entry
+ -> IO () -- ^End callback. Will be called once after all list entries
+ -> IO Operation
+getContextSinks cxt fun endf = do
+ funP <- mkCallback fun endf
+ ptrToOperation =<< pa_context_get_sink_info_list cxt funP (castFunPtrToPtr funP)
+
+-- |Get a sink by name
+getContextSinkByName
+ :: Context
+ -> String
+ -> (Sinkinfo -> IO ())
+ -> IO Operation
+getContextSinkByName cxt name fun = do
+ funP <- mkCallback fun (return ())
+ ptrToOperation =<< withCString name (\ptr -> pa_context_get_sink_info_by_name cxt ptr funP (castFunPtrToPtr funP))
+
+-- |Get a sink by index
+getContextSinkByIndex
+ :: Context
+ -> Word32
+ -> (Sinkinfo -> IO ())
+ -> IO Operation
+getContextSinkByIndex cxt idx fun = do
+ funP <- mkCallback fun (return ())
+ ptrToOperation =<< pa_context_get_sink_info_by_index cxt (fromIntegral idx) funP (castFunPtrToPtr funP)
diff --git a/src/Sound/Pulse/Subscribe.hs b/src/Sound/Pulse/Subscribe.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/Pulse/Subscribe.hs
@@ -0,0 +1,84 @@
+{-
+ Copyright 2016 Markus Ongyerth
+
+ This file is part of pulseaudio-hs.
+
+ Monky is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Lesser General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ Monky is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public License
+ along with pulseaudio-hs. If not, see .
+-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-|
+Module : Sound.Pulse.Subscribe
+Description : provides wrappers for subscription.
+Maintianer : ongy
+Stability : experimental
+-}
+module Sound.Pulse.Subscribe
+ ( SubscriptionEventFacility(..)
+ , SubscriptionEventType(..)
+ , SubscriptionMask(..)
+
+ , subscribeEvents
+ )
+where
+
+import Sound.Pulse.Operation
+import Data.Word (Word32, Word)
+import Data.Bits ((.&.))
+import Foreign.Ptr
+import Foreign.C.Types
+import Sound.Pulse.Context
+import Sound.Pulse.Userdata
+import Sound.Pulse.Def (SubscriptionEventFacility(..), SubscriptionEventType(..), subscriptionEventFacilityFromInt, subscriptionEventFacilityToInt, subscriptionEventTypeFromInt, subscriptionEventTypeToInt, SubscriptionMask(..), subscriptionMasksToInt)
+
+subscriptionEventFromInt :: CInt -> (SubscriptionEventFacility, SubscriptionEventType)
+subscriptionEventFromInt i =
+ ( subscriptionEventFacilityFromInt (i .&. (subscriptionEventFacilityToInt SubscriptionEventFacilityMask))
+ , subscriptionEventTypeFromInt (i .&. (subscriptionEventTypeToInt SubscriptionEventTypeMask) )
+ )
+
+type SubscribeCB = Context -> CInt -> CUInt -> Ptr Userdata -> IO ()
+foreign import ccall "wrapper" mkSubscribeCB :: SubscribeCB -> IO (FunPtr SubscribeCB)
+
+foreign import ccall "pa_context_set_subscribe_callback" pa_context_set_subscribe_callback
+ :: Context
+ -> FunPtr SubscribeCB
+ -> Ptr Userdata
+ -> IO ()
+
+foreign import ccall "pa_context_subscribe" pa_context_subscribe
+ :: Context
+ -> CInt
+ -> FunPtr ContextSuccessCB
+ -> Ptr Userdata
+ -> IO (Ptr UOperation)
+
+-- |Currently the function given here is leaked! even if it's reset later on
+-- This is currently unavoidable, since we don't know when the last event
+-- occured.
+-- This should only be called once per application run, so it will be a known
+-- issue for now.
+subscribeEvents
+ :: Context -- ^The Context to subscribe on
+ -> [SubscriptionMask] -- ^The events that should be reported
+ -> ((SubscriptionEventFacility, SubscriptionEventType)
+ -> Word32
+ -> IO ()
+ ) -- ^Callback function that will be called on every event received.
+ -> IO Operation
+subscribeEvents cxt mask fun = do
+ funP <- mkSubscribeCB $ \_ ival idx _ ->
+ fun (subscriptionEventFromInt ival) (fromIntegral idx)
+ pa_context_set_subscribe_callback cxt funP nullPtr
+ sucP <- wrapSuccess (\b -> putStrLn ("Subscription success: " ++ show b))
+ ptrToOperation =<< pa_context_subscribe cxt (subscriptionMasksToInt mask) sucP nullPtr
diff --git a/src/Sound/Pulse/Userdata.hs b/src/Sound/Pulse/Userdata.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/Pulse/Userdata.hs
@@ -0,0 +1,36 @@
+{-
+ Copyright 2016 Markus Ongyerth
+
+ This file is part of pulseaudio-hs.
+
+ Monky is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Lesser General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ Monky is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public License
+ along with pulseaudio-hs. If not, see .
+-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-|
+Module : Sound.Pulse.Userdata
+Description : provides a unifed Userdata type for this package.
+Maintianer : ongy
+Stability : experimental
+-}
+module Sound.Pulse.Userdata
+ ( Userdata
+ )
+where
+
+-- |This is the common Userdata type for pointers to userdata.
+-- Userdata may either be something given to us by the pulse api
+-- or a value passed from us to the pulse api.
+-- Currently the only value passed to the pulse api, is the function pointer
+-- for the defined function, so it can cleanup (freeHaskellFunPtr) itself.
+data Userdata
diff --git a/src/Sound/Pulse/Volume.hsc b/src/Sound/Pulse/Volume.hsc
new file mode 100644
--- /dev/null
+++ b/src/Sound/Pulse/Volume.hsc
@@ -0,0 +1,72 @@
+{-
+ Copyright 2016 Markus Ongyerth
+
+ This file is part of pulseaudio-hs.
+
+ Monky is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Lesser General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ Monky is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public License
+ along with pulseaudio-hs. If not, see .
+-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-|
+Module : Sound.Pulse.volume
+Description : provides the types for volume
+Maintianer : ongy
+Stability : experimental
+-}
+module Sound.Pulse.Volume
+ ( Volume
+ , CVolume(..)
+
+ , volumeToLinear
+ , cVolumeToLinear
+ )
+where
+
+#if __GLASGOW_HASKELL__ < 800
+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
+#endif
+#include
+
+import Data.Word (Word32, Word8, Word)
+import Data.List (genericLength)
+import Foreign.Storable (Storable(..))
+import Foreign.Ptr (plusPtr)
+
+-- |type for pa_volume_t
+type Volume = Word32
+
+-- |type for pa_cvolume. This contains a 'Volume' for each channel.
+newtype CVolume = CVolume [Volume] deriving (Eq, Show)
+
+instance Storable CVolume where
+ sizeOf _ = #{size struct pa_cvolume}
+ alignment _ = #{alignment struct pa_cvolume}
+ peek p = do
+ size :: Word8 <- #{peek struct pa_cvolume, channels} p
+ ints <- mapM (peekElemOff (#{ptr struct pa_cvolume, values} p) . fromIntegral) [0 .. size - 1]
+ return $ CVolume ints
+ poke p (CVolume vols) = do
+ #{poke struct pa_cvolume, channels} p $ (genericLength vols :: Word8)
+ let indexed = zip [0..] vols
+ mapM_ (uncurry (pokeElemOff (#{ptr struct pa_cvolume, values} p))) indexed
+
+
+foreign import ccall "pa_sw_volume_to_linear" pa_sw_volume_to_linear :: Word32 -> Double
+
+-- |Convert a single 'Volume' to a linear scale
+volumeToLinear :: Word32 -> Double
+volumeToLinear = pa_sw_volume_to_linear
+
+-- |Convert a 'CVolume' to a list of linearly scaled values.
+cVolumeToLinear :: CVolume -> [Double]
+cVolumeToLinear (CVolume vols) = map volumeToLinear vols