--------------------------------------------------------------------------------
-- |
-- Module    : Sound.ALSA.Sequencer.Client
-- Copyright : (c) Henning Thielemann, 2010
--             (c) Iavor S. Diatchki, 2007
-- License   : BSD3
--
-- Maintainer: Henning Thielemann
-- Stability : provisional
--
-- This module contains functions for working with sequencer clients.
-- Reference:
-- <http://www.alsa-project.org/alsa-doc/alsa-lib/group___seq_client.html>
--------------------------------------------------------------------------------

module Sound.ALSA.Sequencer.Client.Info
  ( T

  , get
  , getAny
  , queryFirst
  , queryNext
  , set

  , copy
  , clone

  , getClient
  , getType
  , getName
  , getBroadcastFilter
  , getErrorBounce
  , getNumPorts
  , getEventLost

  , setClient
  , setName
  , setBroadcastFilter
  , setErrorBounce
  ) where


import qualified Sound.ALSA.Sequencer.Marshal.Client as Client
import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq
import qualified Sound.ALSA.Sequencer.Area as Area
import qualified Sound.ALSA.Exception as Exc

import Foreign.C.Types(CInt, )
import Foreign.Ptr(Ptr, )
import Data.Word (Word, )

import Control.Monad (guard, )


--------------------------------------------------------------------------------

type T  = Area.ClientInfo
type T_ = Area.ClientInfo_

-- | Create a new information area filled with data about the sequencer client.
get :: Seq.T mode -> IO T
get (Seq.Cons h) =
  do info <- Area.client_info_malloc
     Exc.checkResult "get_client_info" =<< Area.with_client_info info (snd_seq_get_client_info h)
     return info

foreign import ccall "alsa/asoundlib.h snd_seq_get_client_info"
  snd_seq_get_client_info :: Ptr Seq.Core -> Ptr T_ -> IO CInt


-- | Create a new information area filled with data about an arbitrary client.
getAny :: Seq.T mode -> Client.T -> IO T
getAny (Seq.Cons h) c =
  do info <- Area.client_info_malloc
     Exc.checkResult "get_any_client_info" =<< Area.with_client_info info
                        (snd_seq_get_any_client_info h (Client.exp c))
     return info

foreign import ccall "alsa/asoundlib.h snd_seq_get_any_client_info"
  snd_seq_get_any_client_info
    :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt



queryFirst :: Seq.T mode -> IO T
queryFirst h =
  do x <- Area.client_info_malloc
     Area.with_client_info x (`Area.snd_seq_client_info_set_client` (-1))
     _b <- queryNext h x
     -- XXX: check that we did get the first client (should be System)
     return x


-- | Get information about the client with the next biggest identifier.
queryNext :: Seq.T mode -> T
                    -> IO Bool  -- ^ Was there a next client?
queryNext (Seq.Cons h) info =
  Exc.checkResultMaybe "query_next_client"
         (const True) (\x -> guard (x == -2) >> return False)
      =<< Area.with_client_info info (snd_seq_query_next_client h)

foreign import ccall "alsa/asoundlib.h snd_seq_query_next_client"
  snd_seq_query_next_client :: Ptr Seq.Core -> Ptr T_ -> IO CInt


-- | Set the information for the sequencer client based on the data
-- in the given information area.
set :: Seq.T mode -> T -> IO ()
set (Seq.Cons h) info =
  Exc.checkResult_ "set_client_info" =<< Area.with_client_info info (snd_seq_set_client_info h)

foreign import ccall "alsa/asoundlib.h snd_seq_set_client_info"
  snd_seq_set_client_info :: Ptr Seq.Core -> Ptr T_ -> IO CInt


copy :: T -> T -> IO ()
clone :: T -> IO T
getClient :: T -> IO Client.T
getType :: T -> IO Client.Type
getName :: T -> IO String
getBroadcastFilter :: T -> IO Bool
getErrorBounce :: T -> IO Bool
getNumPorts :: T -> IO Word
getEventLost :: T -> IO Word
setClient :: T -> Client.T -> IO ()
setName :: T -> String -> IO ()
setBroadcastFilter :: T -> Bool -> IO ()
setErrorBounce :: T -> Bool -> IO ()

copy               = Area.client_info_copy
clone              = Area.client_info_clone
getClient          = Area.client_info_get_client
getType            = Area.client_info_get_type
getName            = Area.client_info_get_name
getBroadcastFilter = Area.client_info_get_broadcast_filter
getErrorBounce     = Area.client_info_get_error_bounce
getNumPorts        = Area.client_info_get_num_ports
getEventLost       = Area.client_info_get_event_lost
setClient          = Area.client_info_set_client
setName            = Area.client_info_set_name
setBroadcastFilter = Area.client_info_set_broadcast_filter
setErrorBounce     = Area.client_info_set_error_bounce