4 , MultiParamTypeClasses
7 module Sound.EsounD.Internals
23 import Bindings.EsounD
25 import Data.StorableVector as S
26 import Data.StorableVector.Lazy as L
27 import Foreign.C.String
28 import Foreign.C.Types
30 import Foreign.Storable
32 import System.Posix.IO
33 import System.Posix.Types
35 class Storable fr ⇒ Frame fr where
36 frameFmt ∷ fr → C'esd_format_t
39 instance Frame Int8 where
40 frameFmt _ = c'ESD_BITS8
43 instance Frame Int16 where
44 frameFmt _ = c'ESD_BITS16
47 class Channels ch where
48 channelFmt ∷ ch → C'esd_format_t
49 numChannels ∷ ch → Int
54 instance Channels Mono where
55 channelFmt _ = c'ESD_MONO
61 instance Channels Stereo where
62 channelFmt _ = c'ESD_STEREO
65 {-# INLINE interleave #-}
66 interleave ∷ Storable α ⇒ L.Vector α → L.Vector α → L.Vector α
68 -- THINKME: consider using storablevector-streamfusion
69 = let Just (lFr, l') = L.viewL l
70 Just (rFr, r') = L.viewL r
71 lr' = interleave l' r'
73 L.cons lFr (L.cons rFr lr')
75 {-# INLINE deinterleave #-}
76 deinterleave ∷ Storable α ⇒ L.Vector α → (L.Vector α, L.Vector α)
78 -- THINKME: consider using storablevector-streamfusion
79 = let (lr, v') = L.splitAt 2 v
84 let Just (lFr, r) = L.viewL lr
85 Just (rFr, _) = L.viewL r
86 (l', r') = deinterleave v'
88 (L.cons lFr l', L.cons rFr r')
91 toLSV ∷ Storable α ⇒ S.Vector α → L.Vector α
92 toLSV v = L.fromChunks [v]
94 wrapSocket ∷ String → CInt → IO Handle
95 wrapSocket e (-1) = fail e
96 wrapSocket _ fd = fdToHandle (Fd fd)
98 closeSocket ∷ Handle → IO ()
99 closeSocket h = do (Fd fd) ← handleToFd h
100 _ ← c'esd_close (fromIntegral fd)
103 withCStrOrNull ∷ Maybe String → (CString → IO a) → IO a
104 withCStrOrNull Nothing f = f nullPtr
105 withCStrOrNull (Just s) f = withCString s f
107 failOnError ∷ Monad m ⇒ String → (α → Bool) → α → m α
108 failOnError msg isErr rv
109 | isErr rv = fail msg
110 | otherwise = return rv