From 808cc2f4700bc0b2f77cee443dd237d415b4d5d7 Mon Sep 17 00:00:00 2001 From: PHO Date: Sun, 2 Jan 2011 10:12:12 +0900 Subject: [PATCH] Controller (partway) --- EsounD.cabal | 1 + Sound/EsounD/Controller.hs | 99 ++++++++++++++++++++++++++++++++++++++ Sound/EsounD/Internals.hs | 8 ++- 3 files changed, 107 insertions(+), 1 deletion(-) create mode 100644 Sound/EsounD/Controller.hs diff --git a/EsounD.cabal b/EsounD.cabal index aec3495..422b805 100644 --- a/EsounD.cabal +++ b/EsounD.cabal @@ -39,6 +39,7 @@ Library Exposed-Modules: Sound.EsounD + Sound.EsounD.Controller Sound.EsounD.Filter Sound.EsounD.Monitor Sound.EsounD.Player diff --git a/Sound/EsounD/Controller.hs b/Sound/EsounD/Controller.hs new file mode 100644 index 0000000..1353d06 --- /dev/null +++ b/Sound/EsounD/Controller.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE + FlexibleContexts + , FlexibleInstances + , KindSignatures + , MultiParamTypeClasses + , UnicodeSyntax + , ScopedTypeVariables + #-} +-- | EsounD controlling handles. +module Sound.EsounD.Controller + ( Controller + , openController + + , lock + , unlock + ) + where +import Bindings.EsounD +import Control.Exception.Peel +import Control.Monad.IO.Class +import Control.Monad.IO.Peel +import Control.Monad.Trans.Region +import Control.Monad.Trans.Region.OnExit +import Control.Monad.Unicode +import Foreign.C.Types +import Network +import Sound.EsounD.Internals +import System.IO.SaferFileHandles.Unsafe +import System.Posix.Types +import Text.Printf + +-- ^ An opaque ESD handle for controlling ESD. +data Controller (r ∷ ★ → ★) + = Controller { + coSocket ∷ !Fd + , coCloseH ∷ !(FinalizerHandle r) + } + +instance Dup Controller where + dup co = do ch' ← dup (coCloseH co) + return co { coCloseH = ch' } + +-- | Open an ESD handle for controlling ESD. +openController ∷ MonadPeelIO pr + ⇒ Maybe HostName -- ^ host to connect to. + → RegionT s pr (Controller (RegionT s pr)) +openController host + = block $ + do s ← liftIO openSocket + ch ← onExit $ sanitizeIOError $ closeSocket' s + return Controller { + coSocket = s + , coCloseH = ch + } + where + openSocket ∷ IO Fd + openSocket = withCStrOrNull host $ \hostPtr → + c'esd_open_sound hostPtr + ≫= wrapSocket' + + wrapSocket' ∷ Monad m ⇒ CInt → m Fd + wrapSocket' (-1) = fail ( printf "esd_open_sound(%s) returned an error" + (show host) + ) + wrapSocket' fd = return $ Fd fd + + closeSocket' ∷ Fd → IO () + closeSocket' fd + = do _ ← c'esd_close $ fdToCInt fd + return () + +fdToCInt ∷ Fd → CInt +fdToCInt (Fd fd) = fromIntegral fd + +-- | Lock the ESD so that it won't accept connections from remote +-- hosts. +lock ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ Controller pr + → cr () +lock co + = liftIO $ + sanitizeIOError $ + c'esd_lock (fdToCInt $ coSocket co) + ≫= failOnError "esd_lock(fd) returned an error" + +-- | Unlock the ESD so that it will accept connections from remote +-- hosts. +unlock ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ Controller pr + → cr () +unlock co + = liftIO $ + sanitizeIOError $ + c'esd_unlock (fdToCInt $ coSocket co) + ≫= failOnError "esd_unlock(fd) returned an error" diff --git a/Sound/EsounD/Internals.hs b/Sound/EsounD/Internals.hs index 60cf4b9..f4b067f 100644 --- a/Sound/EsounD/Internals.hs +++ b/Sound/EsounD/Internals.hs @@ -14,10 +14,10 @@ module Sound.EsounD.Internals , deinterleave , toLSV - , wrapSocket , closeSocket , withCStrOrNull + , failOnError ) where import Bindings.EsounD @@ -28,6 +28,7 @@ import Foreign.C.String import Foreign.C.Types import Foreign.Ptr import Foreign.Storable +import Prelude.Unicode import System.IO import System.Posix.IO import System.Posix.Types @@ -97,3 +98,8 @@ closeSocket h = do (Fd fd) ← handleToFd h withCStrOrNull ∷ Maybe String → (CString → IO a) → IO a withCStrOrNull Nothing f = f nullPtr withCStrOrNull (Just s) f = withCString s f + +failOnError ∷ Monad m ⇒ String → CInt → m () +failOnError msg rv + | rv ≤ 0 = fail msg + | otherwise = return () -- 2.40.0