{-# LANGUAGE
    FlexibleContexts
  , FlexibleInstances
  , KindSignatures
  , MultiParamTypeClasses
  , UnicodeSyntax
  , ScopedTypeVariables
  #-}
-- | EsounD filtering streams.
module Sound.EsounD.Filter
    ( Filter
    , openFilter
    )
    where
import Bindings.EsounD
import Control.Exception.Control
import Control.Monad.IO.Class
import Control.Monad.IO.Control
import Control.Monad.Trans.Region
import Control.Monad.Trans.Region.OnExit
import Control.Monad.Unicode
import Data.Bits
import Data.StorableVector      as S
import Data.StorableVector.Lazy as L
import Network
import Prelude.Unicode
import Sound.EsounD.Streams
import Sound.EsounD.Internals
import System.IO
import System.IO.SaferFileHandles.Unsafe
import Text.Printf

-- ^ An opaque ESD handle for filtering sound produced by ESD.
--
-- Reading from the stream will give a block of audio frames, which is
-- the mixed output from other players and filters. The filter is free
-- to process this block as it likes, but must then write an
-- identically sized block to the stream. The frames so returned is
-- played by the ESD, possibly after applying more filters to it.
data Filter fr ch (r ∷ ★ → ★)
    = Filter {
        fiRate   ∷ !Int
      , fiHandle ∷ !Handle
      , fiCloseH ∷ !(FinalizerHandle r)
      }

instance Dup (Filter fr ch) where
    dup fi = do ch' ← dup (fiCloseH fi)
                return fi { fiCloseH = ch' }

instance Stream (Filter fr ch) where
    streamSampleRate = fiRate

instance Frame fr ⇒ ReadableStream (Filter fr Mono) (L.Vector fr) where
    readFrames fi nFrames
        = liftIO $
          sanitizeIOError $
          fmap toLSV $
          S.hGet (fiHandle fi) nFrames

instance Frame fr ⇒ ReadableStream (Filter fr Stereo) (L.Vector fr, L.Vector fr) where
    readFrames fi nFrames
        = liftIO $
          sanitizeIOError $
          fmap (deinterleave ∘ toLSV) $
          S.hGet (fiHandle fi) nFrames

instance Frame fr ⇒ WritableStream (Filter fr Mono) (L.Vector fr) where 
    writeFrames fi v
        = liftIO $
          sanitizeIOError $
          do L.hPut (fiHandle fi) v
             hFlush (fiHandle fi) 

instance Frame fr ⇒ WritableStream (Filter fr Stereo) (L.Vector fr, L.Vector fr) where
    writeFrames fi (l, r)
        = liftIO $
          sanitizeIOError $
          do L.hPut (fiHandle fi) (interleave l r)
             hFlush (fiHandle fi)

-- | Open an ESD handle for filtering sound produced by ESD.
--
-- The new filter will be placed at the head of the list of filters:
-- i.e. it will receive data for processing first, and the next filter
-- will receive the resultant processed data.
openFilter ∷ ∀fr ch s pr.
              ( Frame fr
              , Channels ch
              , MonadControlIO pr
              )
           ⇒ Int            -- ^ sample rate for the stream.
           → Maybe HostName -- ^ host to connect to.
           → Maybe String   -- ^ name used to identify this stream to
                             --   ESD (if any).
           → RegionT s pr (Filter fr ch (RegionT s pr))
openFilter rate host name
    = mask_ $
      do h  ← liftIO openSocket
         ch ← onExit $ sanitizeIOError $ closeSocket h
         return Filter {
                      fiRate   = rate
                    , fiHandle = h
                    , fiCloseH = ch
                    }
    where
      fmt ∷ C'esd_format_t
      fmt = frameFmt   ((⊥) ∷ fr) .|.
            channelFmt ((⊥) ∷ ch) .|.
            c'ESD_STREAM

      openSocket ∷ IO Handle
      openSocket = withCStrOrNull host $ \hostPtr →
                   withCStrOrNull name $ \namePtr →
                       c'esd_filter_stream
                       fmt
                       (fromIntegral rate)
                       hostPtr
                       namePtr
                       ≫= wrapSocket
                               ( printf "esd_filter_stream(%s, %s, %s, %s) returned an error"
                                        (show fmt )
                                        (show rate)
                                        (show host)
                                        (show name)
                               )