{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)
-}

module GI.Gio.Objects.FileMonitor
    ( 

-- * Exported types
    FileMonitor(..)                         ,
    FileMonitorK                            ,
    toFileMonitor                           ,
    noFileMonitor                           ,


 -- * Methods
-- ** fileMonitorCancel
    fileMonitorCancel                       ,


-- ** fileMonitorEmitEvent
    fileMonitorEmitEvent                    ,


-- ** fileMonitorIsCancelled
    fileMonitorIsCancelled                  ,


-- ** fileMonitorSetRateLimit
    fileMonitorSetRateLimit                 ,




 -- * Properties
-- ** Cancelled
    FileMonitorCancelledPropertyInfo        ,
    getFileMonitorCancelled                 ,


-- ** RateLimit
    FileMonitorRateLimitPropertyInfo        ,
    constructFileMonitorRateLimit           ,
    getFileMonitorRateLimit                 ,
    setFileMonitorRateLimit                 ,




 -- * Signals
-- ** Changed
    FileMonitorChangedCallback              ,
    FileMonitorChangedCallbackC             ,
    FileMonitorChangedSignalInfo            ,
    afterFileMonitorChanged                 ,
    fileMonitorChangedCallbackWrapper       ,
    fileMonitorChangedClosure               ,
    mkFileMonitorChangedCallback            ,
    noFileMonitorChangedCallback            ,
    onFileMonitorChanged                    ,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.Gio.Types
import GI.Gio.Callbacks
import qualified GI.GObject as GObject

newtype FileMonitor = FileMonitor (ForeignPtr FileMonitor)
foreign import ccall "g_file_monitor_get_type"
    c_g_file_monitor_get_type :: IO GType

type instance ParentTypes FileMonitor = FileMonitorParentTypes
type FileMonitorParentTypes = '[GObject.Object]

instance GObject FileMonitor where
    gobjectIsInitiallyUnowned _ = False
    gobjectType _ = c_g_file_monitor_get_type
    

class GObject o => FileMonitorK o
instance (GObject o, IsDescendantOf FileMonitor o) => FileMonitorK o

toFileMonitor :: FileMonitorK o => o -> IO FileMonitor
toFileMonitor = unsafeCastTo FileMonitor

noFileMonitor :: Maybe FileMonitor
noFileMonitor = Nothing

-- signal FileMonitor::changed
type FileMonitorChangedCallback =
    File ->
    Maybe File ->
    FileMonitorEvent ->
    IO ()

noFileMonitorChangedCallback :: Maybe FileMonitorChangedCallback
noFileMonitorChangedCallback = Nothing

type FileMonitorChangedCallbackC =
    Ptr () ->                               -- object
    Ptr File ->
    Ptr File ->
    CUInt ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkFileMonitorChangedCallback :: FileMonitorChangedCallbackC -> IO (FunPtr FileMonitorChangedCallbackC)

fileMonitorChangedClosure :: FileMonitorChangedCallback -> IO Closure
fileMonitorChangedClosure cb = newCClosure =<< mkFileMonitorChangedCallback wrapped
    where wrapped = fileMonitorChangedCallbackWrapper cb

fileMonitorChangedCallbackWrapper ::
    FileMonitorChangedCallback ->
    Ptr () ->
    Ptr File ->
    Ptr File ->
    CUInt ->
    Ptr () ->
    IO ()
fileMonitorChangedCallbackWrapper _cb _ file other_file event_type _ = do
    file' <- (newObject File) file
    maybeOther_file <-
        if other_file == nullPtr
        then return Nothing
        else do
            other_file' <- (newObject File) other_file
            return $ Just other_file'
    let event_type' = (toEnum . fromIntegral) event_type
    _cb  file' maybeOther_file event_type'

onFileMonitorChanged :: (GObject a, MonadIO m) => a -> FileMonitorChangedCallback -> m SignalHandlerId
onFileMonitorChanged obj cb = liftIO $ connectFileMonitorChanged obj cb SignalConnectBefore
afterFileMonitorChanged :: (GObject a, MonadIO m) => a -> FileMonitorChangedCallback -> m SignalHandlerId
afterFileMonitorChanged obj cb = connectFileMonitorChanged obj cb SignalConnectAfter

connectFileMonitorChanged :: (GObject a, MonadIO m) =>
                             a -> FileMonitorChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectFileMonitorChanged obj cb after = liftIO $ do
    cb' <- mkFileMonitorChangedCallback (fileMonitorChangedCallbackWrapper cb)
    connectSignalFunPtr obj "changed" cb' after

-- VVV Prop "cancelled"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]

getFileMonitorCancelled :: (MonadIO m, FileMonitorK o) => o -> m Bool
getFileMonitorCancelled obj = liftIO $ getObjectPropertyBool obj "cancelled"

data FileMonitorCancelledPropertyInfo
instance AttrInfo FileMonitorCancelledPropertyInfo where
    type AttrAllowedOps FileMonitorCancelledPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint FileMonitorCancelledPropertyInfo = (~) ()
    type AttrBaseTypeConstraint FileMonitorCancelledPropertyInfo = FileMonitorK
    type AttrGetType FileMonitorCancelledPropertyInfo = Bool
    type AttrLabel FileMonitorCancelledPropertyInfo = "FileMonitor::cancelled"
    attrGet _ = getFileMonitorCancelled
    attrSet _ = undefined
    attrConstruct _ = undefined

-- VVV Prop "rate-limit"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable]

getFileMonitorRateLimit :: (MonadIO m, FileMonitorK o) => o -> m Int32
getFileMonitorRateLimit obj = liftIO $ getObjectPropertyCInt obj "rate-limit"

setFileMonitorRateLimit :: (MonadIO m, FileMonitorK o) => o -> Int32 -> m ()
setFileMonitorRateLimit obj val = liftIO $ setObjectPropertyCInt obj "rate-limit" val

constructFileMonitorRateLimit :: Int32 -> IO ([Char], GValue)
constructFileMonitorRateLimit val = constructObjectPropertyCInt "rate-limit" val

data FileMonitorRateLimitPropertyInfo
instance AttrInfo FileMonitorRateLimitPropertyInfo where
    type AttrAllowedOps FileMonitorRateLimitPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint FileMonitorRateLimitPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint FileMonitorRateLimitPropertyInfo = FileMonitorK
    type AttrGetType FileMonitorRateLimitPropertyInfo = Int32
    type AttrLabel FileMonitorRateLimitPropertyInfo = "FileMonitor::rate-limit"
    attrGet _ = getFileMonitorRateLimit
    attrSet _ = setFileMonitorRateLimit
    attrConstruct _ = constructFileMonitorRateLimit

type instance AttributeList FileMonitor = FileMonitorAttributeList
type FileMonitorAttributeList = ('[ '("cancelled", FileMonitorCancelledPropertyInfo), '("rate-limit", FileMonitorRateLimitPropertyInfo)] :: [(Symbol, *)])

data FileMonitorChangedSignalInfo
instance SignalInfo FileMonitorChangedSignalInfo where
    type HaskellCallbackType FileMonitorChangedSignalInfo = FileMonitorChangedCallback
    connectSignal _ = connectFileMonitorChanged

type instance SignalList FileMonitor = FileMonitorSignalList
type FileMonitorSignalList = ('[ '("changed", FileMonitorChangedSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

-- method FileMonitor::cancel
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "g_file_monitor_cancel" g_file_monitor_cancel :: 
    Ptr FileMonitor ->                      -- _obj : TInterface "Gio" "FileMonitor"
    IO CInt


fileMonitorCancel ::
    (MonadIO m, FileMonitorK a) =>
    a ->                                    -- _obj
    m Bool
fileMonitorCancel _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_file_monitor_cancel _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method FileMonitor::emit_event
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "other_file", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "event_type", argType = TInterface "Gio" "FileMonitorEvent", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "other_file", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "event_type", argType = TInterface "Gio" "FileMonitorEvent", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_file_monitor_emit_event" g_file_monitor_emit_event :: 
    Ptr FileMonitor ->                      -- _obj : TInterface "Gio" "FileMonitor"
    Ptr File ->                             -- child : TInterface "Gio" "File"
    Ptr File ->                             -- other_file : TInterface "Gio" "File"
    CUInt ->                                -- event_type : TInterface "Gio" "FileMonitorEvent"
    IO ()


fileMonitorEmitEvent ::
    (MonadIO m, FileMonitorK a, FileK b, FileK c) =>
    a ->                                    -- _obj
    b ->                                    -- child
    c ->                                    -- other_file
    FileMonitorEvent ->                     -- event_type
    m ()
fileMonitorEmitEvent _obj child other_file event_type = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let child' = unsafeManagedPtrCastPtr child
    let other_file' = unsafeManagedPtrCastPtr other_file
    let event_type' = (fromIntegral . fromEnum) event_type
    g_file_monitor_emit_event _obj' child' other_file' event_type'
    touchManagedPtr _obj
    touchManagedPtr child
    touchManagedPtr other_file
    return ()

-- method FileMonitor::is_cancelled
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "g_file_monitor_is_cancelled" g_file_monitor_is_cancelled :: 
    Ptr FileMonitor ->                      -- _obj : TInterface "Gio" "FileMonitor"
    IO CInt


fileMonitorIsCancelled ::
    (MonadIO m, FileMonitorK a) =>
    a ->                                    -- _obj
    m Bool
fileMonitorIsCancelled _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_file_monitor_is_cancelled _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method FileMonitor::set_rate_limit
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "limit_msecs", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "limit_msecs", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_file_monitor_set_rate_limit" g_file_monitor_set_rate_limit :: 
    Ptr FileMonitor ->                      -- _obj : TInterface "Gio" "FileMonitor"
    Int32 ->                                -- limit_msecs : TBasicType TInt32
    IO ()


fileMonitorSetRateLimit ::
    (MonadIO m, FileMonitorK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- limit_msecs
    m ()
fileMonitorSetRateLimit _obj limit_msecs = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    g_file_monitor_set_rate_limit _obj' limit_msecs
    touchManagedPtr _obj
    return ()