{-# LINE 2 "./System/Glib/MainLoop.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) General
--
-- Author : Axel Simon, Manuel M. T. Chakravarty, Duncan Coutts
--
-- Created: 11 October 2005
--
-- Copyright (C) 2000..2005 Axel Simon, Manuel M. T. Chakravarty, Duncan Coutts
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- main event loop, and events
--
module System.Glib.MainLoop (
  HandlerId,
  timeoutAdd,
  timeoutAddFull,
  timeoutRemove,
  idleAdd,
  idleRemove,
  IOCondition(..),
  inputAdd,
  inputRemove,
  Priority,
  priorityLow,
  priorityDefaultIdle,
  priorityHighIdle,
  priorityDefault,
  priorityHigh,
  MainLoop,
  mainLoopNew,
  mainLoopRun,
  mainLoopQuit,
  mainLoopIsRunning,
  MainContext,
  mainContextNew,
  mainContextDefault,
  mainContextIteration,
  mainContextFindSourceById,
  Source(..),
  sourceAttach,
  sourceSetPriority,
  sourceGetPriority,
  sourceDestroy,

  sourceIsDestroyed

  ) where

import Control.Monad (liftM)

import System.Glib.FFI
import System.Glib.Flags
import System.Glib.GObject (DestroyNotify, destroyFunPtr)


{-# LINE 71 "./System/Glib/MainLoop.chs" #-}

type SourceFunc = FunPtr (((Ptr ()) -> (IO CInt)))
{-# LINE 73 "./System/Glib/MainLoop.chs" #-}

foreign import ccall "wrapper" mkSourceFunc :: (Ptr () -> IO (CInt)) -> IO SourceFunc

type HandlerId = (CUInt)
{-# LINE 77 "./System/Glib/MainLoop.chs" #-}

-- Turn a function into a function pointer and a destructor pointer.
--
makeCallback :: IO (CInt) -> IO (SourceFunc, DestroyNotify)
makeCallback fun = do
  funPtr <- mkSourceFunc (const fun)
  return (funPtr, destroyFunPtr)

-- | Sets a function to be called at regular intervals, with the default
-- priority 'priorityDefault'. The function is called repeatedly until it
-- returns @False@, after which point the timeout function will not be called
-- again. The first call to the function will be at the end of the first interval.
--
-- Note that timeout functions may be delayed, due to the processing of other
-- event sources. Thus they should not be relied on for precise timing. After
-- each call to the timeout function, the time of the next timeout is
-- recalculated based on the current time and the given interval (it does not
-- try to 'catch up' time lost in delays).
--
timeoutAdd :: IO Bool -> Int -> IO HandlerId
timeoutAdd fun msec = timeoutAddFull fun priorityDefault msec

-- | Sets a function to be called at regular intervals, with the given
-- priority. The function is called repeatedly until it returns @False@, after
-- which point the timeout function will not be called again. The first call
-- to the function will be at the end of the first interval.
--
-- Note that timeout functions may be delayed, due to the processing of other
-- event sources. Thus they should not be relied on for precise timing. After
-- each call to the timeout function, the time of the next timeout is
-- recalculated based on the current time and the given interval (it does not
-- try to 'catch up' time lost in delays).
--
timeoutAddFull :: IO Bool -> Priority -> Int -> IO HandlerId
timeoutAddFull fun pri msec = do
  (funPtr, dPtr) <- makeCallback (liftM fromBool fun)
  g_timeout_add_full
{-# LINE 114 "./System/Glib/MainLoop.chs" #-}
    (fromIntegral pri)
    (fromIntegral msec)
    funPtr
    (castFunPtrToPtr funPtr)
    dPtr

-- | Remove a previously added timeout handler by its 'HandlerId'.
--
timeoutRemove :: HandlerId -> IO ()
timeoutRemove id = g_source_remove id >> return ()

-- | Add a callback that is called whenever the system is idle.
--
-- * A priority can be specified via an integer. This should usually be
-- 'priorityDefaultIdle'.
--
-- * If the function returns @False@ it will be removed.
--
idleAdd :: IO Bool -> Priority -> IO HandlerId
idleAdd fun pri = do
  (funPtr, dPtr) <- makeCallback (liftM fromBool fun)
  g_idle_add_full (fromIntegral pri) funPtr
    (castFunPtrToPtr funPtr) dPtr

-- | Remove a previously added idle handler by its 'HandlerId'.
--
idleRemove :: HandlerId -> IO ()
idleRemove id = g_source_remove id >> return ()

-- | Flags representing a condition to watch for on a file descriptor.
--
-- [@IOIn@] There is data to read.
-- [@IOOut@] Data can be written (without blocking).
-- [@IOPri@] There is urgent data to read.
-- [@IOErr@] Error condition.
-- [@IOHup@] Hung up (the connection has been broken, usually for
-- pipes and sockets).
-- [@IOInvalid@] Invalid request. The file descriptor is not open.
--
data IOCondition = IOIn
                 | IOOut
                 | IOPri
                 | IOErr
                 | IOHup
                 | IOInvalid
                 deriving (Eq,Bounded)
instance Enum IOCondition where
  fromEnum IOIn = 1
  fromEnum IOOut = 4
  fromEnum IOPri = 2
  fromEnum IOErr = 8
  fromEnum IOHup = 16
  fromEnum IOInvalid = 32

  toEnum 1 = IOIn
  toEnum 4 = IOOut
  toEnum 2 = IOPri
  toEnum 8 = IOErr
  toEnum 16 = IOHup
  toEnum 32 = IOInvalid
  toEnum unmatched = error ("IOCondition.toEnum: Cannot match " ++ show unmatched)

  succ IOIn = IOOut
  succ IOOut = IOPri
  succ IOPri = IOErr
  succ IOErr = IOHup
  succ IOHup = IOInvalid
  succ _ = undefined

  pred IOOut = IOIn
  pred IOPri = IOOut
  pred IOErr = IOPri
  pred IOHup = IOErr
  pred IOInvalid = IOHup
  pred _ = undefined

  enumFromTo x y | fromEnum x == fromEnum y = [ y ]
                 | otherwise = x : enumFromTo (succ x) y
  enumFrom x = enumFromTo x IOInvalid
  enumFromThen _ _ =     error "Enum IOCondition: enumFromThen not implemented"
  enumFromThenTo _ _ _ =     error "Enum IOCondition: enumFromThenTo not implemented"

{-# LINE 161 "./System/Glib/MainLoop.chs" #-}
instance Flags IOCondition

newtype IOChannel = IOChannel (Ptr (IOChannel))
{-# LINE 164 "./System/Glib/MainLoop.chs" #-}
type IOFunc = FunPtr (((Ptr IOChannel) -> (CInt -> ((Ptr ()) -> (IO CInt)))))
{-# LINE 165 "./System/Glib/MainLoop.chs" #-}

foreign import ccall "wrapper" mkIOFunc :: (Ptr IOChannel -> CInt -> Ptr () -> IO (CInt)) -> IO IOFunc

type FD = Int

-- | Adds the file descriptor into the main event loop with the given priority.
--
inputAdd ::
    FD -- ^ a file descriptor
 -> [IOCondition] -- ^ the condition to watch for
 -> Priority -- ^ the priority of the event source
 -> IO Bool -- ^ the function to call when the condition is satisfied.
                  -- The function should return False if the event source
                  -- should be removed.
 -> IO HandlerId -- ^ the event source id
inputAdd fd conds pri fun = do
  funPtr <- mkIOFunc (\_ _ _ -> liftM fromBool fun)
  channel <- g_io_channel_unix_new (fromIntegral fd)
  (\(IOChannel arg1) arg2 arg3 arg4 arg5 arg6 -> g_io_add_watch_full arg1 arg2 arg3 arg4 arg5 arg6)
{-# LINE 184 "./System/Glib/MainLoop.chs" #-}
    (IOChannel channel)
    (fromIntegral pri)
    ((fromIntegral . fromFlags) conds)
    funPtr
    (castFunPtrToPtr funPtr)
    destroyFunPtr

inputRemove :: HandlerId -> IO ()
inputRemove id = g_source_remove id >> return ()

-- Standard priorities







-- | Priorities for installing callbacks.
--
type Priority = Int

priorityHigh :: Int
priorityHigh = -100

priorityDefault :: Int
priorityDefault = 0

priorityHighIdle :: Int
priorityHighIdle = 100

priorityDefaultIdle :: Int
priorityDefaultIdle = 200

priorityLow :: Int
priorityLow = 300

-- | A main event loop abstraction.
newtype MainLoop = MainLoop (ForeignPtr (MainLoop))
{-# LINE 223 "./System/Glib/MainLoop.chs" #-}

-- | An opaque datatype representing a set of sources to be handled in
-- a main loop.
newtype MainContext = MainContext (ForeignPtr (MainContext))
{-# LINE 227 "./System/Glib/MainLoop.chs" #-}

-- | Create a new 'MainLoop'.
mainLoopNew :: Maybe MainContext -- ^ @context@ - the context to use, or 'Nothing' to use the default context
            -> Bool -- ^ @isRunning@ - 'True' to indicate that the loop is running; 'False' otherwise
            -> IO MainLoop -- ^ the new 'MainLoop'
mainLoopNew context isRunning =
    do let context' = maybe (MainContext nullForeignPtr) id context
       loopPtr <- (\(MainContext arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->g_main_loop_new argPtr1 arg2) context' $ fromBool isRunning
       liftM MainLoop $ newForeignPtr loopPtr mainLoopFinalizer
foreign import ccall unsafe "&g_main_loop_unref"
    mainLoopFinalizer :: FunPtr (Ptr MainLoop -> IO ())

-- | Runs a main loop until 'mainLoopQuit' is called on the
-- loop. If this is called for the thread of the loop's
-- 'MainContext', it will process events from the loop, otherwise it
-- will simply wait.
mainLoopRun :: MainLoop
            -> IO ()
mainLoopRun loop =
    (\(MainLoop arg1) -> withForeignPtr arg1 $ \argPtr1 ->g_main_loop_run argPtr1) loop

-- | Stops a 'MainLoop' from running. Any calls to mainLoopRun for the
-- loop will return.
mainLoopQuit :: MainLoop
             -> IO ()
mainLoopQuit loop =
    (\(MainLoop arg1) -> withForeignPtr arg1 $ \argPtr1 ->g_main_loop_quit argPtr1) loop

-- | Checks to see if the main loop is currently being run via mainLoopRun.
mainLoopIsRunning :: MainLoop
                  -> IO Bool
mainLoopIsRunning loop =
    liftM toBool $ (\(MainLoop arg1) -> withForeignPtr arg1 $ \argPtr1 ->g_main_loop_is_running argPtr1) loop

-- | Gets a 'MainLoop's context.
mainLoopGetContext :: MainLoop
                   -> MainContext
mainLoopGetContext loop =
    MainContext $ unsafePerformIO $
        (\(MainLoop arg1) -> withForeignPtr arg1 $ \argPtr1 ->g_main_loop_get_context argPtr1) loop >>=
            flip newForeignPtr mainContextFinalizer

foreign import ccall unsafe "&g_main_context_unref"
    mainContextFinalizer :: FunPtr (Ptr MainContext -> IO ())

-- | Creates a new 'MainContext'.
mainContextNew :: IO MainContext
mainContextNew =
    newContextMarshal g_main_context_new
{-# LINE 276 "./System/Glib/MainLoop.chs" #-}

-- | The default 'MainContext'. This is the main context used for main
-- loop functions when a main loop is not explicitly specified.
mainContextDefault :: MainContext
mainContextDefault =
    unsafePerformIO $ newContextMarshal g_main_context_default
{-# LINE 282 "./System/Glib/MainLoop.chs" #-}

newContextMarshal action =
    do ptr <- action
       liftM MainContext $ newForeignPtr ptr mainContextFinalizer

-- | Runs a single iteration for the given main loop. This involves
-- checking to see if any event sources are ready to be processed,
-- then if no events sources are ready and @mayBlock@ is 'True',
-- waiting for a source to become ready, then dispatching the
-- highest priority events sources that are ready. Note that even
-- when @mayBlock@ is 'True', it is still possible for
-- 'mainContextIteration' to return (0), since the the wait
-- may be interrupted for other reasons than an event source
-- becoming ready.
mainContextIteration :: MainContext
                     -> Bool
                     -> IO Bool
mainContextIteration context mayBlock =
    liftM toBool $ (\(MainContext arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->g_main_context_iteration argPtr1 arg2) context (fromBool mayBlock)

mainContextFindSourceById :: MainContext
                          -> HandlerId
                          -> IO Source
mainContextFindSourceById context id =
    (\(MainContext arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->g_main_context_find_source_by_id argPtr1 arg2) context (fromIntegral id) >>= newSource . castPtr

newtype Source = Source (ForeignPtr (Source))
{-# LINE 309 "./System/Glib/MainLoop.chs" #-}
newSource :: Ptr Source
          -> IO Source
newSource sourcePtr =
    liftM Source $ newForeignPtr sourcePtr sourceFinalizer
foreign import ccall unsafe "&g_source_unref"
    sourceFinalizer :: FunPtr (Ptr Source -> IO ())

sourceAttach :: Source
             -> MainContext
             -> IO HandlerId
sourceAttach source context =
    liftM fromIntegral $ (\(Source arg1) (MainContext arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->g_source_attach argPtr1 argPtr2) source context

sourceSetPriority :: Source
                  -> Priority
                  -> IO ()
sourceSetPriority source priority =
    (\(Source arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->g_source_set_priority argPtr1 arg2) source $ fromIntegral priority

sourceGetPriority :: Source
                  -> IO Priority
sourceGetPriority source =
    liftM fromIntegral $ (\(Source arg1) -> withForeignPtr arg1 $ \argPtr1 ->g_source_get_priority argPtr1) source

sourceDestroy :: Source
              -> IO ()
sourceDestroy source =
    (\(Source arg1) -> withForeignPtr arg1 $ \argPtr1 ->g_source_destroy argPtr1) source


sourceIsDestroyed :: Source
                  -> IO Bool
sourceIsDestroyed source =
    liftM toBool $ (\(Source arg1) -> withForeignPtr arg1 $ \argPtr1 ->g_source_is_destroyed argPtr1) source


sourceRemove :: HandlerId
             -> IO Bool
sourceRemove tag =
    liftM toBool $ g_source_remove $ fromIntegral tag

foreign import ccall unsafe "g_timeout_add_full"
  g_timeout_add_full :: (CInt -> (CUInt -> ((FunPtr ((Ptr ()) -> (IO CInt))) -> ((Ptr ()) -> ((FunPtr ((Ptr ()) -> (IO ()))) -> (IO CUInt))))))

foreign import ccall safe "g_source_remove"
  g_source_remove :: (CUInt -> (IO CInt))

foreign import ccall unsafe "g_idle_add_full"
  g_idle_add_full :: (CInt -> ((FunPtr ((Ptr ()) -> (IO CInt))) -> ((Ptr ()) -> ((FunPtr ((Ptr ()) -> (IO ()))) -> (IO CUInt)))))

foreign import ccall unsafe "g_io_channel_unix_new"
  g_io_channel_unix_new :: (CInt -> (IO (Ptr IOChannel)))

foreign import ccall unsafe "g_io_add_watch_full"
  g_io_add_watch_full :: ((Ptr IOChannel) -> (CInt -> (CInt -> ((FunPtr ((Ptr IOChannel) -> (CInt -> ((Ptr ()) -> (IO CInt))))) -> ((Ptr ()) -> ((FunPtr ((Ptr ()) -> (IO ()))) -> (IO CUInt)))))))

foreign import ccall safe "g_main_loop_new"
  g_main_loop_new :: ((Ptr MainContext) -> (CInt -> (IO (Ptr MainLoop))))

foreign import ccall safe "g_main_loop_run"
  g_main_loop_run :: ((Ptr MainLoop) -> (IO ()))

foreign import ccall safe "g_main_loop_quit"
  g_main_loop_quit :: ((Ptr MainLoop) -> (IO ()))

foreign import ccall safe "g_main_loop_is_running"
  g_main_loop_is_running :: ((Ptr MainLoop) -> (IO CInt))

foreign import ccall safe "g_main_loop_get_context"
  g_main_loop_get_context :: ((Ptr MainLoop) -> (IO (Ptr MainContext)))

foreign import ccall safe "g_main_context_new"
  g_main_context_new :: (IO (Ptr MainContext))

foreign import ccall safe "g_main_context_default"
  g_main_context_default :: (IO (Ptr MainContext))

foreign import ccall safe "g_main_context_iteration"
  g_main_context_iteration :: ((Ptr MainContext) -> (CInt -> (IO CInt)))

foreign import ccall safe "g_main_context_find_source_by_id"
  g_main_context_find_source_by_id :: ((Ptr MainContext) -> (CUInt -> (IO (Ptr ()))))

foreign import ccall safe "g_source_attach"
  g_source_attach :: ((Ptr Source) -> ((Ptr MainContext) -> (IO CUInt)))

foreign import ccall safe "g_source_set_priority"
  g_source_set_priority :: ((Ptr Source) -> (CInt -> (IO ())))

foreign import ccall safe "g_source_get_priority"
  g_source_get_priority :: ((Ptr Source) -> (IO CInt))

foreign import ccall safe "g_source_destroy"
  g_source_destroy :: ((Ptr Source) -> (IO ()))

foreign import ccall safe "g_source_is_destroyed"
  g_source_is_destroyed :: ((Ptr Source) -> (IO CInt))