{-# 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>
--------------------------------------------------------------------------------

{-# LANGUAGE ForeignFunctionInterface #-}
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 46 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}

{-# LINE 47 "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 64 "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 67 "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 69 "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 71 "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 73 "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 76 "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 77 "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 78 "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 79 "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 80 "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 84 "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 86 "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 88 "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 123 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}
  Write -> 1
{-# LINE 124 "src/Sound/ALSA/Sequencer/Subscribe/Query.hsc" #-}

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