Sound/EsounD/Internals.hs

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