pulseaudio (empty) → 0.0.1.0
raw patch · 19 files changed
+2825/−0 lines, 19 filesdep +basedep +containersdep +pulseaudiosetup-changed
Dependencies added: base, containers, pulseaudio, stm, unix
Files
- ChangeLog.md +5/−0
- LICENSE +165/−0
- Setup.hs +2/−0
- bin/Test.hs +52/−0
- pulseaudio.cabal +134/−0
- src/Data/Time.hsc +115/−0
- src/Data/Time/Internal.hsc +81/−0
- src/Sound/Pulse/ChannelPosition.hsc +57/−0
- src/Sound/Pulse/Context.hs +146/−0
- src/Sound/Pulse/Def.hsc +736/−0
- src/Sound/Pulse/Mainloop.hsc +361/−0
- src/Sound/Pulse/Mainloop/Simple.hs +372/−0
- src/Sound/Pulse/Operation.hs +83/−0
- src/Sound/Pulse/SampleSpec.hsc +60/−0
- src/Sound/Pulse/Serverinfo.hsc +93/−0
- src/Sound/Pulse/Sinkinfo.hsc +171/−0
- src/Sound/Pulse/Subscribe.hs +84/−0
- src/Sound/Pulse/Userdata.hs +36/−0
- src/Sound/Pulse/Volume.hsc +72/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for pulseaudio++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,165 @@+ GNU LESSER GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bin/Test.hs view
@@ -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
+ pulseaudio.cabal view
@@ -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
+ src/Data/Time.hsc view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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 <time.h>++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
+ src/Data/Time/Internal.hsc view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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 <time.h>+#include <sys/time.h>++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)
+ src/Sound/Pulse/ChannelPosition.hsc view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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 <pulse/channelmap.h>++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
+ src/Sound/Pulse/Context.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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
+ src/Sound/Pulse/Def.hsc view
@@ -0,0 +1,736 @@+{-# OPTIONS -fno-warn-overlapping-patterns #-}+{-# OPTIONS_HADDOCK hide #-}+module Sound.Pulse.Def+where++#include <pulse/def.h>+#include <pulse/channelmap.h>+#include <pulse/sample.h>+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 $ []
+ src/Sound/Pulse/Mainloop.hsc view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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 <https://freedesktop.org/software/pulseaudio/doxygen/mainloop-api_8h.html>.++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 <pulse/mainloop-api.h>++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 {..}
+ src/Sound/Pulse/Mainloop/Simple.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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+
+ src/Sound/Pulse/Operation.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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
+ src/Sound/Pulse/SampleSpec.hsc view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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 <pulse/sample.h>++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
+ src/Sound/Pulse/Serverinfo.hsc view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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 <pulse/introspect.h>++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 ()
+ src/Sound/Pulse/Sinkinfo.hsc view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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 <pulse/introspect.h>++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)
+ src/Sound/Pulse/Subscribe.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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
+ src/Sound/Pulse/Userdata.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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
+ src/Sound/Pulse/Volume.hsc view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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 <pulse/introspect.h>++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