Sound/EsounD/Controller.hs

   1 {-# LANGUAGE
   2     FlexibleContexts
   3   , FlexibleInstances
   4   , KindSignatures
   5   , MultiParamTypeClasses
   6   , UnicodeSyntax
   7   , ScopedTypeVariables
   8   #-}
   9 -- | EsounD controlling handles.
  10 module Sound.EsounD.Controller
  11     ( Controller
  12     , openController
  13
  14     , lock
  15     , unlock
  16     )
  17     where
  18 import Bindings.EsounD
  19 import Control.Exception.Peel
  20 import Control.Monad.IO.Class
  21 import Control.Monad.IO.Peel
  22 import Control.Monad.Trans.Region
  23 import Control.Monad.Trans.Region.OnExit
  24 import Control.Monad.Unicode
  25 import Foreign.C.Types
  26 import Network
  27 import Sound.EsounD.Internals
  28 import System.IO.SaferFileHandles.Unsafe
  29 import System.Posix.Types
  30 import Text.Printf
  31
  32 -- ^ An opaque ESD handle for controlling ESD.
  33 data Controller (r ∷ ★ → ★)
  34     = Controller {
  35         coSocket ∷ !Fd
  36       , coCloseH ∷ !(FinalizerHandle r)
  37       }
  38
  39 instance Dup Controller where
  40     dup co = do ch' ← dup (coCloseH co)
  41                 return co { coCloseH = ch' }
  42
  43 -- | Open an ESD handle for controlling ESD.
  44 openController ∷ MonadPeelIO pr
  45                ⇒ Maybe HostName -- ^ host to connect to.
  46                → RegionT s pr (Controller (RegionT s pr))
  47 openController host
  48     = block $
  49       do s  ← liftIO openSocket
  50          ch ← onExit $ sanitizeIOError $ closeSocket' s
  51          return Controller {
  52                       coSocket = s
  53                     , coCloseH = ch
  54                     }
  55     where
  56       openSocket ∷ IO Fd
  57       openSocket = withCStrOrNull host $ \hostPtr →
  58                        c'esd_open_sound hostPtr
  59                        ≫= wrapSocket'
  60
  61       wrapSocket' ∷ Monad m ⇒ CInt → m Fd
  62       wrapSocket' (-1) = fail ( printf "esd_open_sound(%s) returned an error"
  63                                        (show host)
  64                               )
  65       wrapSocket' fd   = return $ Fd fd
  66
  67       closeSocket' ∷ Fd → IO ()
  68       closeSocket' fd
  69           = do _ ← c'esd_close $ fdToCInt fd
  70                return ()
  71
  72 fdToCInt ∷ Fd → CInt
  73 fdToCInt (Fd fd) = fromIntegral fd
  74
  75 -- | Lock the ESD so that it won't accept connections from remote
  76 -- hosts.
  77 lock ∷ ( AncestorRegion pr cr
  78         , MonadIO cr
  79         )
  80      ⇒ Controller pr
  81      → cr ()
  82 lock co
  83     = liftIO $
  84       sanitizeIOError $
  85       c'esd_lock (fdToCInt $ coSocket co)
  86           ≫= failOnError "esd_lock(fd) returned an error"
  87
  88 -- | Unlock the ESD so that it will accept connections from remote
  89 -- hosts.
  90 unlock ∷ ( AncestorRegion pr cr
  91           , MonadIO cr
  92           )
  93        ⇒ Controller pr
  94        → cr ()
  95 unlock co
  96     = liftIO $
  97       sanitizeIOError $
  98       c'esd_unlock (fdToCInt $ coSocket co)
  99           ≫= failOnError "esd_unlock(fd) returned an error"