{-# LINE 1 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}
--------------------------------------------------------------------------------
{-# LINE 2 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}
-- |
-- Module    : Sound.ALSA.Sequencer.Subscribe.Query
-- Copyright : (c) Henning Thielemann, 2012
--             (c) Dylan Simon, 2011
-- License   : BSD3
--
-- Stability : provisional
--
-- This module contains functions for working with subscriptions.
-- Reference:
-- <http://www.alsa-project.org/alsa-doc/alsa-lib/group___seq_subscribe.html>
--------------------------------------------------------------------------------

module Sound.ALSA.Sequencer.Subscribe.Query
  ( T
  , Type(..)

  , malloc
  , copy
  , clone

  , getClient
  , getPort
  , getRoot
  , getType
  , getIndex
  , getNumSubs
  , getAddr
  , getQueue
  , getExclusive
  , getTimeUpdate
  , getTimeReal

  , setClient
  , setPort
  , setType
  , setIndex

  , query
  , queryAll
  ) where


{-# LINE 45 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}

{-# LINE 46 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}

import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq
import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr
import qualified Sound.ALSA.Sequencer.Marshal.Client as Client
import qualified Sound.ALSA.Sequencer.Marshal.Port as Port
import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue
import qualified Sound.ALSA.Sequencer.Area as Area
import qualified Sound.ALSA.Sequencer.Utility as U
import qualified Sound.ALSA.Exception as Exc

import qualified Foreign.C.Types as C
import Foreign.Ptr (Ptr, )
import Data.Word (Word, )
import Data.Maybe.HT (toMaybe, )


data T_
newtype T = Cons (Area.ForeignPtr T_)

with :: T -> (Area.Ptr T_ -> IO a) -> IO a
with (Cons p) f = Area.withForeignPtr p f

-- | Allocate an uninitialized object. (Not exported)
malloc :: IO T
malloc = Area.alloca $ \p ->
  do Exc.checkResult_ "Sequencer.query_subscribe" =<< malloc_ p
     fmap Cons (Area.newForeignPtr free =<< Area.peek p)

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_malloc"
  malloc_ :: Area.Ptr (Area.Ptr T_) -> IO C.CInt

foreign import ccall unsafe "alsa/asoundlib.h &snd_seq_query_subscribe_free"
  free :: Area.FunPtr (Area.Ptr T_ -> IO ())

-- | Copy the content of one object into another.
copy
  :: T     -- ^ Destination
  -> T     -- ^ Source
  -> IO ()

copy to from =
  with to $ \p1 ->
  with from $ \p2 ->
    copy_ p1 p2

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_copy"
  copy_ :: Area.Ptr T_ -> Area.Ptr T_ -> IO ()

-- | Copy the content of an object to a newly created object.
clone :: T -> IO T
clone from =
  do to <- malloc
     copy to from
     return to

instance Area.C T where
  malloc = malloc
  copy = copy
  clone = clone



{-# LINE 63 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}

getClient :: T -> IO Client.T
getClient i =
  fmap Client.imp $ with i getClient_

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_get_client"
  getClient_ :: Area.Ptr T_ -> IO C.CInt

setClient :: T -> Client.T -> IO ()
setClient i c =
  with i (flip setClient_ (Client.exp c))

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_set_client"
  setClient_  :: Area.Ptr T_ -> C.CInt -> IO ()


{-# LINE 66 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}
getPort :: T -> IO Port.T
getPort i =
  fmap Port.imp $ with i getPort_

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_get_port"
  getPort_ :: Area.Ptr T_ -> IO C.CInt

setPort :: T -> Port.T -> IO ()
setPort i c =
  with i (flip setPort_ (Port.exp c))

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_set_port"
  setPort_  :: Area.Ptr T_ -> C.CInt -> IO ()


{-# LINE 68 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}
getType :: T -> IO Type
getType i =
  fmap impType $ with i getType_

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_get_type"
  getType_ :: Area.Ptr T_ -> IO C.CInt

setType :: T -> Type -> IO ()
setType i c =
  with i (flip setType_ (expType c))

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_set_type"
  setType_  :: Area.Ptr T_ -> C.CInt -> IO ()


{-# LINE 70 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}
getIndex :: T -> IO Word
getIndex i =
  fmap fromIntegral $ with i getIndex_

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_get_index"
  getIndex_ :: Area.Ptr T_ -> IO C.CInt

setIndex :: T -> Word -> IO ()
setIndex i c =
  with i (flip setIndex_ (fromIntegral c))

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_set_index"
  setIndex_  :: Area.Ptr T_ -> C.CInt -> IO ()


{-# LINE 72 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}

-- RO
getNumSubs :: T -> IO Word
getNumSubs i =
  fmap fromIntegral $ with i getNumSubs_

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_get_num_subs"
  getNumSubs_ :: Area.Ptr T_ -> IO C.CInt


{-# LINE 75 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}
getQueue :: T -> IO Queue.T
getQueue i =
  fmap Queue.imp $ with i getQueue_

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_get_queue"
  getQueue_ :: Area.Ptr T_ -> IO C.CInt


{-# LINE 76 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}
getExclusive :: T -> IO Bool
getExclusive i =
  fmap (0 /=) $ with i getExclusive_

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_get_exclusive"
  getExclusive_ :: Area.Ptr T_ -> IO C.CInt


{-# LINE 77 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}
getTimeUpdate :: T -> IO Bool
getTimeUpdate i =
  fmap (0 /=) $ with i getTimeUpdate_

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_get_time_update"
  getTimeUpdate_ :: Area.Ptr T_ -> IO C.CInt


{-# LINE 78 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}
getTimeReal :: T -> IO Bool
getTimeReal i =
  fmap (0 /=) $ with i getTimeReal_

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_get_time_real"
  getTimeReal_ :: Area.Ptr T_ -> IO C.CInt


{-# LINE 79 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}


-- | Get the client/port address of a query
getRoot :: T -> IO Addr.T
getRoot i =
  Area.peek =<< with i getRoot_

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_get_root"
  getRoot_ :: Area.Ptr T_ -> IO (Area.Ptr Addr.T)


{-# LINE 83 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}
-- | Set the client/port address of a query
setRoot :: T -> Addr.T -> IO ()
setRoot i c =
  with i (\iptr -> Area.with c (setRoot_ iptr))

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_set_root"
  setRoot_  :: Area.Ptr T_ -> (Area.Ptr Addr.T) -> IO ()


{-# LINE 85 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}
-- | Get the address of subscriber of query
getAddr :: T -> IO Addr.T
getAddr i =
  Area.peek =<< with i getAddr_

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_get_addr"
  getAddr_ :: Area.Ptr T_ -> IO (Area.Ptr Addr.T)


{-# LINE 87 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}


-- | Query port subscriber list
queryPort :: Seq.T mode -> T -> IO Bool
queryPort (Seq.Cons h) q =
  U.checkResultQuery "Subscribe.queryPort" =<< with q (queryPort_ h)

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_port_subscribers"
  queryPort_ :: Ptr Seq.Core -> Ptr T_ -> IO C.CInt

-- | Queries a subscriber connected to (Write) or from (Read) a given address: @'query' seq addr typ index@
query :: Seq.T mode -> Addr.T -> Type -> Word -> IO (Maybe T)
query ss root t i = do
  q <- malloc
  setRoot q root
  setType q t
  setIndex q i
  r <- queryPort ss q
  return $ toMaybe r q

-- | Queries the list of subscribers accessing a port
queryAll :: Seq.T mode -> Addr.T -> Type -> IO [T]
queryAll ss root t = queryRest 0 where
  queryRest i = query ss root t i >>=
    maybe (return []) (\q -> (q:) `fmap` queryRest (succ i))


data Type =
     Read
   | Write
   deriving (Show, Eq, Ord, Enum)

expType :: Type -> C.CInt
expType t  = case t of
  Read  -> 0
{-# LINE 122 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}
  Write	-> 1
{-# LINE 123 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}

impType :: C.CInt -> Type
impType t  = case t of
  0  -> Read
{-# LINE 127 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}
  1 -> Write
{-# LINE 128 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}
  _ -> error ("QuerySubscribe.impType: unknown subscription type (" ++ show t ++ ")")