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
  38 instance Frame Int8 where
  39     frameFmt _ = c'ESD_BITS8
  40
  41 instance Frame Int16 where
  42     frameFmt _ = c'ESD_BITS16
  43
  44 class Channels ch where
  45     channelFmt ∷ ch → C'esd_format_t
  46
  47 -- Mono
  48 data Mono
  49
  50 instance Channels Mono where
  51     channelFmt _ = c'ESD_MONO
  52
  53 -- Stereo
  54 data Stereo
  55
  56 instance Channels Stereo where
  57     channelFmt _ = c'ESD_STEREO
  58
  59 {-# INLINE interleave #-}
  60 interleave ∷ Storable α ⇒ L.Vector α → L.Vector α → L.Vector α
  61 interleave l r
  62     -- THINKME: consider using storablevector-streamfusion
  63     = let Just (lFr, l') = L.viewL l
  64           Just (rFr, r') = L.viewL r
  65           lr' = interleave l' r'
  66       in
  67         L.cons lFr (L.cons rFr lr')
  68
  69 {-# INLINE deinterleave #-}
  70 deinterleave ∷ Storable α ⇒ L.Vector α → (L.Vector α, L.Vector α)
  71 deinterleave v
  72     -- THINKME: consider using storablevector-streamfusion
  73     = let (lr, v') = L.splitAt 2 v
  74       in
  75         if L.null lr then
  76             (L.empty, L.empty)
  77         else
  78             let Just (lFr, r) = L.viewL lr
  79                 Just (rFr, _) = L.viewL r
  80                 (l', r') = deinterleave v'
  81             in
  82               (L.cons lFr l', L.cons rFr r')
  83
  84 -- Utility functions
  85 toLSV ∷ Storable α ⇒ S.Vector α → L.Vector α
  86 toLSV v = L.fromChunks [v]
  87
  88 wrapSocket ∷ String → CInt → IO Handle
  89 wrapSocket e (-1) = fail e
  90 wrapSocket _ fd   = fdToHandle (Fd fd)
  91
  92 closeSocket ∷ Handle → IO ()
  93 closeSocket h = do (Fd fd) ← handleToFd h
  94                    _       ← c'esd_close (fromIntegral fd)
  95                    return ()
  96
  97 withCStrOrNull ∷ Maybe String → (CString → IO a) → IO a
  98 withCStrOrNull Nothing  f = f nullPtr
  99 withCStrOrNull (Just s) f = withCString s f
 100
 101 failOnError ∷ Monad m ⇒ String → (CInt → Bool) → CInt → m CInt
 102 failOnError msg isErr rv
 103     | isErr rv  = fail msg
 104     | otherwise = return rv