{- common between Glib and Gtk, but with different G modules
-- This is somewhat silly, since Gtk events only differ by an extra lock, but we shouldn't depend on that.
-- If we wanted to, however, could just define:
     Gtk.inputAdd sh pri fun = Glib.inputAdd sh pri $ \ev ->
       threadsEnter >> fun ev >>= \r -> threadsLeave >> return r
-}
module Sound.ALSA.Sequencer.GlibGtk where

import qualified Sound.ALSA.Sequencer.GlibGtkClass as GC

import qualified Sound.ALSA.Sequencer.Poll as APoll
import qualified Sound.ALSA.Sequencer.Event as Event
import qualified Sound.ALSA.Sequencer as Seq
import Sound.ALSA.Exception (code, )

import qualified Data.EnumSet as EnumSet
import qualified System.Posix.Poll as Poll
import Control.Exception (catchJust, )
import Control.Monad (guard, )
import Foreign.C.Error (eINTR, )
import System.IO.Error (isFullError, )


add ::
  GC.T pri handler cond ->
  Seq.T mode -> Poll.Events -> pri -> IO Bool -> IO [handler]
add methods sh el pri fun =
  let add1 (Poll.Fd fd e _) =
         GC.inputAdd methods
            (fromIntegral fd) (map (GC.pio methods) $ EnumSet.toEnums e) pri fun
  in  mapM add1 =<< APoll.descriptors sh el

catchIntr :: IO a -> IO a
catchIntr f = catchJust (guard . (eINTR ==) . code) f (\() -> catchIntr f)

catchFull :: IO a -> IO a -> IO a
catchFull f e = catchJust (guard . isFullError) (catchIntr f) (\() -> e)


-- | Add a callback to the G main event loop to be called for each incoming sequencer event.
-- Only one such handler should be added.
inputAdd ::
  Seq.AllowInput mode =>
  GC.T pri handler cond ->
  Seq.T mode -> pri -> (Event.T -> IO Bool) -> IO [handler]
inputAdd methods sh pri fun = add methods sh Poll.inp pri handler where
  handler = do
    p <- Event.inputPending sh True `catchFull` return 0
    if p == 0 then return True else
      fmap Just (Event.input sh) `catchFull` return Nothing >>=
      maybe (return True) (\ev -> do
	r <- fun ev
	if r then handler else return r)

-- | Call @Sound.ALSA.Sequencer.Event.drainOutput@ whenever possible until the output buffer is empty.
-- Multiple calls will result in extra calls to drain, but otherwise be harmless.
drainOutput ::
  Seq.AllowOutput mode =>
  GC.T pri handler cond ->
  Seq.T mode -> pri -> IO [handler]
drainOutput methods sh pri = add methods sh Poll.out pri handler where
  handler = fmap (0 /=) $ Event.drainOutput sh `catchFull` return (-1)

-- | Remove a handler added with @inputAdd@ or @drainOutput@.
inputRemove ::
  GC.T pri handler cond -> [handler] -> IO ()
inputRemove methods = mapM_ (GC.inputRemove methods)