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