Sound/EsounD/Internals.hs

   1 {-# LANGUAGE
   2     EmptyDataDecls
   3   , FlexibleInstances
   4   , MultiParamTypeClasses
   5   , UnicodeSyntax
   6   #-}
   7 module Sound.EsounD.Internals
   8     ( Frame(..)
   9
  10     , Channels(..)
  11     , Mono
  12     , Stereo
  13     , interleave
  14
  15     , wrapSocket
  16     , closeSocket
  17     , withCStrOrNull
  18     )
  19     where
  20 import Bindings.EsounD
  21 import Data.Int
  22 import Data.StorableVector.Lazy as L
  23 import Foreign.C.String
  24 import Foreign.C.Types
  25 import Foreign.Ptr
  26 import Foreign.Storable
  27 import System.IO
  28 import System.Posix.IO
  29 import System.Posix.Types
  30
  31 class Storable fr ⇒ Frame fr where
  32     frameFmt ∷ fr → C'esd_format_t
  33
  34 instance Frame Int8 where
  35     frameFmt _ = c'ESD_BITS8
  36
  37 instance Frame Int16 where
  38     frameFmt _ = c'ESD_BITS16
  39
  40 class Channels ch where
  41     channelFmt ∷ ch → C'esd_format_t
  42
  43 -- Mono
  44 data Mono
  45
  46 instance Channels Mono where
  47     channelFmt _ = c'ESD_MONO
  48
  49 -- Stereo
  50 data Stereo
  51
  52 instance Channels Stereo where
  53     channelFmt _ = c'ESD_STEREO
  54
  55 {-# INLINE interleave #-}
  56 interleave ∷ Frame fr ⇒ L.Vector fr → L.Vector fr → L.Vector fr
  57 interleave l r
  58     -- THINKME: consider using storablevector-streamfusion
  59     = let Just (lFr, l') = L.viewL l
  60           Just (rFr, r') = L.viewL r
  61           lr' = interleave l' r'
  62       in
  63         L.cons lFr (L.cons rFr lr')
  64
  65 -- Utility functions
  66 wrapSocket ∷ String → CInt → IO Handle
  67 wrapSocket e (-1) = fail e
  68 wrapSocket _ fd   = fdToHandle (Fd fd)
  69
  70 closeSocket ∷ Handle → IO ()
  71 closeSocket h = do (Fd fd) ← handleToFd h
  72                    _       ← c'esd_close (fromIntegral fd)
  73                    return ()
  74
  75 withCStrOrNull ∷ Maybe String → (CString → IO a) → IO a
  76 withCStrOrNull Nothing  f = f nullPtr
  77 withCStrOrNull (Just s) f = withCString s f