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