esound-1: Replace use of MonadPeelIO with MonadControlIO

[EsounD.git] / Sound / EsounD / Controller.hs

diff --git a/Sound/EsounD/Controller.hs b/Sound/EsounD/Controller.hs
index c9b064982bb6712861c572c0a9d98927b1c171d0..c3818561e826cf6125d5296cbb85107319e6b1c0 100644 (file)
--- a/Sound/EsounD/Controller.hs
+++ b/Sound/EsounD/Controller.hs
@@ -42,9 +42,9 @@ module Sound.EsounD.Controller
     )
     where
 import Bindings.EsounD
-import Control.Exception.Peel
+import Control.Exception.Control
 import Control.Monad.IO.Class
-import Control.Monad.IO.Peel
+import Control.Monad.IO.Control
 import Control.Monad.Trans.Region
 import Control.Monad.Trans.Region.OnExit
 import Control.Monad.Unicode
@@ -75,13 +75,13 @@ instance Dup Controller where
                 return co { coCloseH = ch' }
 
 -- | Open an ESD handle for controlling ESD.
-openController ∷ MonadPeelIO pr
+openController ∷ MonadControlIO pr
                ⇒ Maybe HostName -- ^ host to connect to.
                → RegionT s pr (Controller (RegionT s pr))
 openController host
-    = block $
+    = mask_ $
       do s  ← liftIO openSocket
-         ch ← onExit $ sanitizeIOError $ closeSocket' s
+         ch ← onExit $ closeSocket' s
          return Controller {
                       coSocket = s
                     , coCloseH = ch
@@ -115,7 +115,6 @@ lock ∷ ( AncestorRegion pr cr
      → cr ()
 lock co
     = liftIO $
-      sanitizeIOError $
       c'esd_lock (fdToCInt $ coSocket co)
           ≫= failOnError "esd_lock(fd) returned an error" (≤ 0)
           ≫  return ()
@@ -129,7 +128,6 @@ unlock ∷ ( AncestorRegion pr cr
        → cr ()
 unlock co
     = liftIO $
-      sanitizeIOError $
       c'esd_unlock (fdToCInt $ coSocket co)
           ≫= failOnError "esd_unlock(fd) returned an error" (≤ 0)
           ≫  return ()
@@ -143,7 +141,6 @@ standby ∷ ( AncestorRegion pr cr
         → cr ()
 standby co
     = liftIO $
-      sanitizeIOError $
       c'esd_standby (fdToCInt $ coSocket co)
           ≫= failOnError "esd_standby(fd) returned an error" (≤ 0)
           ≫  return ()
@@ -157,7 +154,6 @@ resume ∷ ( AncestorRegion pr cr
        → cr ()
 resume co
     = liftIO $
-      sanitizeIOError $
       c'esd_resume (fdToCInt $ coSocket co)
           ≫= failOnError "esd_resume(fd) returned an error" (≤ 0)
           ≫  return ()
@@ -180,7 +176,7 @@ instance Dup Sample where
 
 class (Frame fr, Channels ch) ⇒ SampleSource fr ch dvec where
     -- | Cache a sample in the server.
-    cacheSample ∷ (MonadPeelIO pr)
+    cacheSample ∷ (MonadControlIO pr)
                 ⇒ Controller (RegionT s pr)
                 → Maybe String  -- ^ name used to identify this sample to
                 → Int           -- ^ sample rate
@@ -189,7 +185,7 @@ class (Frame fr, Channels ch) ⇒ SampleSource fr ch dvec where
 
 instance Frame fr ⇒ SampleSource fr Mono (L.Vector fr) where
     cacheSample co name rate v
-        = block $
+        = mask_ $
           do sa ← createSample
                    co
                    name
@@ -208,7 +204,7 @@ instance Frame fr ⇒ SampleSource fr Mono (L.Vector fr) where
 
 instance Frame fr ⇒ SampleSource fr Stereo (L.Vector fr, L.Vector fr) where
     cacheSample co name rate (l, r)
-        = block $
+        = mask_ $
           do sa ← createSample
                    co
                    name
@@ -228,7 +224,7 @@ instance Frame fr ⇒ SampleSource fr Stereo (L.Vector fr, L.Vector fr) where
 createSample ∷ ∀fr ch s pr.
                 ( Frame fr
                 , Channels ch
-                , MonadPeelIO pr
+                , MonadControlIO pr
                 )
              ⇒ Controller (RegionT s pr)
              → Maybe String
@@ -238,9 +234,9 @@ createSample ∷ ∀fr ch s pr.
              → Int
              → RegionT s pr (Sample (RegionT s pr))
 createSample co name rate _ _ len
-    = block $
+    = mask_ $
       do sid ← liftIO newCache
-         ch  ← onExit $ sanitizeIOError $ deleteCache sid
+         ch  ← onExit $ deleteCache sid
          return Sample {
                       saID     = sid
                     , saCtrl   = co
@@ -290,7 +286,6 @@ playSample ∷ ( AncestorRegion pr cr
            → cr ()
 playSample sa
     = liftIO $
-      sanitizeIOError $
       c'esd_sample_play (fdToCInt $ coSocket $ saCtrl sa) (saID sa)
           ≫= failOnError ( printf "esd_sample_play(%s, %s) returned an error"
                                    (show $ coSocket $ saCtrl sa)
@@ -306,7 +301,6 @@ loopSample ∷ ( AncestorRegion pr cr
            → cr ()
 loopSample sa
     = liftIO $
-      sanitizeIOError $
       c'esd_sample_loop (fdToCInt $ coSocket $ saCtrl sa) (saID sa)
           ≫= failOnError ( printf "esd_sample_loop(%s, %s) returned an error"
                                    (show $ coSocket $ saCtrl sa)
@@ -322,7 +316,6 @@ stopSample ∷ ( AncestorRegion pr cr
            → cr ()
 stopSample sa
     = liftIO $
-      sanitizeIOError $
       c'esd_sample_stop (fdToCInt $ coSocket $ saCtrl sa) (saID sa)
           ≫= failOnError ( printf "esd_sample_stop(%s, %s) returned an error"
                                    (show $ coSocket $ saCtrl sa)
@@ -338,7 +331,6 @@ killSample ∷ ( AncestorRegion pr cr
            → cr ()
 killSample sa
     = liftIO $
-      sanitizeIOError $
       c'esd_sample_kill (fdToCInt $ coSocket $ saCtrl sa) (saID sa)
           ≫= failOnError ( printf "esd_sample_kill(%s, %s) returned an error"
                                    (show $ coSocket $ saCtrl sa)
@@ -398,7 +390,6 @@ getServerInfo ∷ ( AncestorRegion pr cr
               → cr ServerInfo
 getServerInfo co
     = liftIO $
-      sanitizeIOError $
       bracket retrieve dispose extractServerInfo
     where
       retrieve ∷ IO (Ptr C'esd_server_info)
@@ -539,7 +530,6 @@ getAllInfo ∷ ( AncestorRegion pr cr
            → cr AllInfo
 getAllInfo co
     = liftIO $
-      sanitizeIOError $
       bracket retrieve dispose extractAllInfo
     where
       retrieve ∷ IO (Ptr C'esd_info)
@@ -560,7 +550,6 @@ setStreamPan ∷ ( AncestorRegion pr cr
              → cr ()
 setStreamPan co sid l r
     = liftIO $
-      sanitizeIOError $
       c'esd_set_stream_pan (fdToCInt $ coSocket co)
                            (fromIntegral sid)
                            (floor $ l ⋅ c'ESD_VOLUME_BASE)
@@ -584,7 +573,6 @@ setDefaultSamplePan ∷ ( AncestorRegion pr cr
                     → cr ()
 setDefaultSamplePan co sid l r
     = liftIO $
-      sanitizeIOError $
       c'esd_set_default_sample_pan (fdToCInt $ coSocket co)
                                    (fromIntegral sid)
                                    (floor $ l ⋅ c'ESD_VOLUME_BASE)
@@ -619,7 +607,6 @@ getServerState ∷ ( AncestorRegion pr cr
                → cr ServerState
 getServerState co
     = liftIO $
-      sanitizeIOError $
       fmap extractServerState $
       c'esd_get_standby_mode (fdToCInt $ coSocket co)
           ≫= failOnError "esd_get_standby_mode(fd) returned an error" (≡ c'ESM_ERROR)