{-# LINE 2 "./System/GIO/Async/Cancellable.chs" #-}
-- GIMP Toolkit (GTK) Binding for Haskell: binding to gio -*-haskell-*-
--
-- Author : Peter Gavin
-- Created: 13-Oct-2008
--
-- Copyright (c) 2008 Peter Gavin
--
-- 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 3 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.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this program. If not, see
-- <http:
--
-- GIO, the C library which this Haskell library depends on, is
-- available under LGPL Version 2. The documentation included with
-- this library is based on the original GIO documentation.
--
-- | Maintainer : gtk2hs-devel@lists.sourceforge.net
-- Stability : alpha
-- Portability : portable (depends on GHC)
module System.GIO.Async.Cancellable (
    Cancellable,
    cancellableNew,
    cancellableIsCancelled,
    cancellableThrowErrorIfCancelled,
    cancellableGetCurrent,
    cancellablePopCurrent,
    cancellablePushCurrent,
    cancellableReset,
    cancellableCancel,
    cancellableCancelled
    ) where

import Control.Monad

import System.Glib.FFI
import System.Glib.GError
import System.GIO.Signals
{-# LINE 48 "./System/GIO/Async/Cancellable.chs" #-}

import System.GIO.Base
import System.GIO.Types
{-# LINE 51 "./System/GIO/Async/Cancellable.chs" #-}


{-# LINE 53 "./System/GIO/Async/Cancellable.chs" #-}

cancellableNew :: IO Cancellable
cancellableNew =
    g_cancellable_new >>= takeGObject

cancellableIsCancelled :: Cancellable -> IO Bool
cancellableIsCancelled =
    liftM toBool . (\(Cancellable arg1) -> withForeignPtr arg1 $ \argPtr1 ->g_cancellable_is_cancelled argPtr1)
{-# LINE 61 "./System/GIO/Async/Cancellable.chs" #-}

cancellableThrowErrorIfCancelled :: Cancellable -> IO ()
cancellableThrowErrorIfCancelled cancellable =
    propagateGError $ \gErrorPtr -> do
      (\(Cancellable arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->g_cancellable_set_error_if_cancelled argPtr1 arg2) cancellable gErrorPtr
      return ()

cancellableGetCurrent :: IO (Maybe Cancellable)
cancellableGetCurrent =
    g_cancellable_get_current >>= maybePeek takeGObject

cancellablePopCurrent :: Maybe Cancellable -> IO ()
cancellablePopCurrent cancellable =
    maybeWith withGObject cancellable g_cancellable_pop_current
    where
      _ = (\(Cancellable arg1) -> withForeignPtr arg1 $ \argPtr1 ->g_cancellable_pop_current argPtr1)
{-# LINE 77 "./System/GIO/Async/Cancellable.chs" #-}

cancellablePushCurrent :: Maybe Cancellable -> IO ()
cancellablePushCurrent cancellable =
    maybeWith withGObject cancellable g_cancellable_push_current
    where
      _ = (\(Cancellable arg1) -> withForeignPtr arg1 $ \argPtr1 ->g_cancellable_push_current argPtr1)
{-# LINE 83 "./System/GIO/Async/Cancellable.chs" #-}

cancellableReset :: Cancellable -> IO ()
cancellableReset = (\(Cancellable arg1) -> withForeignPtr arg1 $ \argPtr1 ->g_cancellable_reset argPtr1)
{-# LINE 86 "./System/GIO/Async/Cancellable.chs" #-}

cancellableCancel :: Cancellable -> IO ()
cancellableCancel = (\(Cancellable arg1) -> withForeignPtr arg1 $ \argPtr1 ->g_cancellable_cancel argPtr1)
{-# LINE 89 "./System/GIO/Async/Cancellable.chs" #-}

cancellableCancelled :: Signal Cancellable (IO ())
cancellableCancelled =
    Signal $ connect_NONE__NONE "cancelled"

foreign import ccall safe "g_cancellable_new"
  g_cancellable_new :: (IO (Ptr Cancellable))

foreign import ccall safe "g_cancellable_is_cancelled"
  g_cancellable_is_cancelled :: ((Ptr Cancellable) -> (IO CInt))

foreign import ccall safe "g_cancellable_set_error_if_cancelled"
  g_cancellable_set_error_if_cancelled :: ((Ptr Cancellable) -> ((Ptr (Ptr ())) -> (IO CInt)))

foreign import ccall safe "g_cancellable_get_current"
  g_cancellable_get_current :: (IO (Ptr Cancellable))

foreign import ccall safe "g_cancellable_pop_current"
  g_cancellable_pop_current :: ((Ptr Cancellable) -> (IO ()))

foreign import ccall safe "g_cancellable_push_current"
  g_cancellable_push_current :: ((Ptr Cancellable) -> (IO ()))

foreign import ccall safe "g_cancellable_reset"
  g_cancellable_reset :: ((Ptr Cancellable) -> (IO ()))

foreign import ccall safe "g_cancellable_cancel"
  g_cancellable_cancel :: ((Ptr Cancellable) -> (IO ()))