{-# LANGUAGE
    FlexibleContexts
  , FlexibleInstances
  , KindSignatures
  , MultiParamTypeClasses
  , UnicodeSyntax
  , ScopedTypeVariables
  #-}
-- | EsounD controlling handles.
module Sound.EsounD.Controller
    ( Controller
    , openController

    , lock
    , unlock
    )
    where
import Bindings.EsounD
import Control.Exception.Peel
import Control.Monad.IO.Class
import Control.Monad.IO.Peel
import Control.Monad.Trans.Region
import Control.Monad.Trans.Region.OnExit
import Control.Monad.Unicode
import Foreign.C.Types
import Network
import Sound.EsounD.Internals
import System.IO.SaferFileHandles.Unsafe
import System.Posix.Types
import Text.Printf

-- ^ An opaque ESD handle for controlling ESD.
data Controller (r ∷ ★ → ★)
    = Controller {
        coSocket ∷ !Fd
      , coCloseH ∷ !(FinalizerHandle r)
      }

instance Dup Controller where
    dup co = do ch' ← dup (coCloseH co)
                return co { coCloseH = ch' }

-- | Open an ESD handle for controlling ESD.
openController ∷ MonadPeelIO pr
               ⇒ Maybe HostName -- ^ host to connect to.
               → RegionT s pr (Controller (RegionT s pr))
openController host
    = block $
      do s  ← liftIO openSocket
         ch ← onExit $ sanitizeIOError $ closeSocket' s
         return Controller {
                      coSocket = s
                    , coCloseH = ch
                    }
    where
      openSocket ∷ IO Fd
      openSocket = withCStrOrNull host $ \hostPtr →
                       c'esd_open_sound hostPtr
                       ≫= wrapSocket'

      wrapSocket' ∷ Monad m ⇒ CInt → m Fd
      wrapSocket' (-1) = fail ( printf "esd_open_sound(%s) returned an error"
                                       (show host)
                              )
      wrapSocket' fd   = return $ Fd fd

      closeSocket' ∷ Fd → IO ()
      closeSocket' fd
          = do _ ← c'esd_close $ fdToCInt fd
               return ()

fdToCInt ∷ Fd → CInt
fdToCInt (Fd fd) = fromIntegral fd

-- | Lock the ESD so that it won't accept connections from remote
-- hosts.
lock ∷ ( AncestorRegion pr cr
        , MonadIO cr
        )
     ⇒ Controller pr
     → cr ()
lock co
    = liftIO $
      sanitizeIOError $
      c'esd_lock (fdToCInt $ coSocket co)
          ≫= failOnError "esd_lock(fd) returned an error"

-- | Unlock the ESD so that it will accept connections from remote
-- hosts.
unlock ∷ ( AncestorRegion pr cr
          , MonadIO cr
          )
       ⇒ Controller pr
       → cr ()
unlock co
    = liftIO $
      sanitizeIOError $
      c'esd_unlock (fdToCInt $ coSocket co)
          ≫= failOnError "esd_unlock(fd) returned an error"