From 2c9350d4762d69bbfcdc58212e27506c3d4f7494 Mon Sep 17 00:00:00 2001
From: PHO <pho@cielonegro.org>
Date: Sat, 1 Jan 2011 04:01:14 +0900
Subject: [PATCH] Writable class

---
 EsounD.cabal                 | 14 ++------------
 Sound/EsounD/Internals.hs    | 15 +++++++++------
 Sound/EsounD/Player.hs       | 16 ++++++++++++++--
 Sound/EsounD/Streams.hs      | 17 +++++++++++++++++
 examples/EsdPlayerExample.hs |  7 ++++++-
 5 files changed, 48 insertions(+), 21 deletions(-)
 create mode 100644 Sound/EsounD/Streams.hs

diff --git a/EsounD.cabal b/EsounD.cabal
index 6add96a..783ef47 100644
--- a/EsounD.cabal
+++ b/EsounD.cabal
@@ -29,6 +29,7 @@ Library
         base                      == 4.*,
         base-unicode-symbols      == 0.2.*,
         bindings-EsounD           == 0.1.*,
+        monad-peel                == 0.1.*,
         network                   == 2.3.*,
         regions                   == 0.8.*,
         safer-file-handles        == 0.9.*,
@@ -39,17 +40,12 @@ Library
     Exposed-Modules:
         Sound.EsounD
         Sound.EsounD.Player
+        Sound.EsounD.Streams
         Sound.EsounD.Types
 
     Other-Modules:
         Sound.EsounD.Internals
 
-    Extensions:
-        EmptyDataDecls
-        KindSignatures
-        ScopedTypeVariables
-        UnicodeSyntax
-
     GHC-Options:
         -Wall
 
@@ -65,11 +61,5 @@ Executable hs-esd-player-example
 
    Main-Is: EsdPlayerExample.hs
 
-   Extensions:
-        EmptyDataDecls
-        KindSignatures
-        ScopedTypeVariables
-        UnicodeSyntax
-
    GHC-Options:
         -Wall
diff --git a/Sound/EsounD/Internals.hs b/Sound/EsounD/Internals.hs
index f75f99a..4f57a3b 100644
--- a/Sound/EsounD/Internals.hs
+++ b/Sound/EsounD/Internals.hs
@@ -1,3 +1,7 @@
+{-# LANGUAGE
+    EmptyDataDecls
+  , UnicodeSyntax
+  #-}
 module Sound.EsounD.Internals
     ( Frame(..)
 
@@ -10,17 +14,17 @@ module Sound.EsounD.Internals
     , withCStrOrNull
     )
     where
-
 import Bindings.EsounD
 import Data.Int
 import Foreign.C.String
 import Foreign.C.Types
 import Foreign.Ptr
+import Foreign.Storable
 import System.IO
 import System.Posix.IO
 import System.Posix.Types
 
-class Frame fr where
+class Storable fr ⇒ Frame fr where
     frameFmt ∷ fr → C'esd_format_t
 
 instance Frame Int8 where
@@ -40,16 +44,15 @@ data Stereo
 instance Channels Stereo where
     channelFmt _ = c'ESD_STEREO
 
-
-wrapSocket :: String -> CInt → IO Handle
+wrapSocket ∷ String → CInt → IO Handle
 wrapSocket e (-1) = fail e
 wrapSocket _ fd   = fdToHandle (Fd fd)
 
-closeSocket :: Handle → IO ()
+closeSocket ∷ Handle → IO ()
 closeSocket h = do (Fd fd) ← handleToFd h
                    _       ← c'esd_close (fromIntegral fd)
                    return ()
 
-withCStrOrNull :: Maybe String → (CString → IO a) → IO a
+withCStrOrNull ∷ Maybe String → (CString → IO a) → IO a
 withCStrOrNull Nothing  f = f nullPtr
 withCStrOrNull (Just s) f = withCString s f
diff --git a/Sound/EsounD/Player.hs b/Sound/EsounD/Player.hs
index b60eda0..0525a7b 100644
--- a/Sound/EsounD/Player.hs
+++ b/Sound/EsounD/Player.hs
@@ -1,26 +1,34 @@
+{-# LANGUAGE
+    FlexibleInstances
+  , KindSignatures
+  , MultiParamTypeClasses
+  , UnicodeSyntax
+  , ScopedTypeVariables
+  #-}
 -- | EsounD player streams.
 module Sound.EsounD.Player
     ( Player
     , openPlayer
     )
     where
-
 import Bindings.EsounD
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Region
 import Control.Monad.Trans.Region.OnExit
 import Control.Monad.Unicode
 import Data.Bits
+import Data.StorableVector.Lazy as Lazy
 import Foreign.C.String
 import Network
 import Prelude.Unicode
+import Sound.EsounD.Streams 
 import Sound.EsounD.Internals
 import System.IO
 import System.IO.SaferFileHandles.Unsafe
 
 
 -- ^ An opaque ESD handle for playing a stream.
-data Player fr ch (r ∷ * → *)
+data Player fr ch (r ∷ ★ → ★)
     = Player {
         plRate   ∷ !Int
       -- THINKME: We really want to use RegionalFileHandle but we
@@ -34,6 +42,10 @@ instance Dup (Player fr ch) where
     dup pl = do ch' ← dup (plCloseH pl)
                 return pl { plCloseH = ch' }
 
+instance Frame fr ⇒ Writable (Player fr Mono) (Lazy.Vector fr) where
+    write pl v
+        = liftIO $ sanitizeIOError $ Lazy.hPut (plHandle pl) v
+
 -- | Open an ESD handle for playing a stream.
 openPlayer ∷ ∀fr ch s pr.
                ( Frame fr
diff --git a/Sound/EsounD/Streams.hs b/Sound/EsounD/Streams.hs
new file mode 100644
index 0000000..2be218e
--- /dev/null
+++ b/Sound/EsounD/Streams.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE
+    UnicodeSyntax
+  , MultiParamTypeClasses
+  #-}
+-- | EsounD stream I/O
+module Sound.EsounD.Streams
+    ( Writable(..) 
+    )
+    where
+import Control.Monad.IO.Class 
+import Control.Monad.Trans.Region
+
+class Writable ws v where
+    write ∷ ( AncestorRegion pr cr
+             , MonadIO cr
+             )
+          ⇒ ws (RegionT s pr) → v → cr ()
diff --git a/examples/EsdPlayerExample.hs b/examples/EsdPlayerExample.hs
index 7de9ba9..1d3ec4f 100644
--- a/examples/EsdPlayerExample.hs
+++ b/examples/EsdPlayerExample.hs
@@ -1,9 +1,14 @@
+{-# LANGUAGE
+    UnicodeSyntax
+  #-}
 module Main where
 import Control.Monad.Trans.Region
 import Sound.EsounD.Player 
 
 main ∷ IO ()
+main = return ()
+{-
 main = runRegionT $
        do pl ← openPlayer 44100 "localhost" Nothing 
           fail "FIXME"
-
+-}
-- 
2.40.0