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     , deinterleave
  15
  16     , wrapSocket
  17     , closeSocket
  18     , withCStrOrNull
  19     )
  20     where
  21 import Bindings.EsounD
  22 import Data.Int
  23 import Data.StorableVector.Lazy as L
  24 import Foreign.C.String
  25 import Foreign.C.Types
  26 import Foreign.Ptr
  27 import Foreign.Storable
  28 import System.IO
  29 import System.Posix.IO
  30 import System.Posix.Types
  31
  32 class Storable fr ⇒ Frame fr where
  33     frameFmt ∷ fr → C'esd_format_t
  34
  35 instance Frame Int8 where
  36     frameFmt _ = c'ESD_BITS8
  37
  38 instance Frame Int16 where
  39     frameFmt _ = c'ESD_BITS16
  40
  41 class Channels ch where
  42     channelFmt ∷ ch → C'esd_format_t
  43
  44 -- Mono
  45 data Mono
  46
  47 instance Channels Mono where
  48     channelFmt _ = c'ESD_MONO
  49
  50 -- Stereo
  51 data Stereo
  52
  53 instance Channels Stereo where
  54     channelFmt _ = c'ESD_STEREO
  55
  56 {-# INLINE interleave #-}
  57 interleave ∷ Storable α ⇒ L.Vector α → L.Vector α → L.Vector α
  58 interleave l r
  59     -- THINKME: consider using storablevector-streamfusion
  60     = let Just (lFr, l') = L.viewL l
  61           Just (rFr, r') = L.viewL r
  62           lr' = interleave l' r'
  63       in
  64         L.cons lFr (L.cons rFr lr')
  65
  66 {-# INLINE deinterleave #-}
  67 deinterleave ∷ Storable α ⇒ L.Vector α → (L.Vector α, L.Vector α)
  68 deinterleave v
  69     -- THINKME: consider using storablevector-streamfusion
  70     = let (lr, v') = L.splitAt 2 v
  71       in
  72         if L.null lr then
  73             (L.empty, L.empty)
  74         else
  75             let Just (lFr, r) = L.viewL lr
  76                 Just (rFr, _) = L.viewL r
  77                 (l', r') = deinterleave v'
  78             in
  79               (L.cons lFr l', L.cons rFr r')
  80
  81 -- Utility functions
  82 wrapSocket ∷ String → CInt → IO Handle
  83 wrapSocket e (-1) = fail e
  84 wrapSocket _ fd   = fdToHandle (Fd fd)
  85
  86 closeSocket ∷ Handle → IO ()
  87 closeSocket h = do (Fd fd) ← handleToFd h
  88                    _       ← c'esd_close (fromIntegral fd)
  89                    return ()
  90
  91 withCStrOrNull ∷ Maybe String → (CString → IO a) → IO a
  92 withCStrOrNull Nothing  f = f nullPtr
  93 withCStrOrNull (Just s) f = withCString s f