{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- IBusObservedPath provides methods for file path manipulation,
-- such as monitor modification, directory tree traversal.

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.IBus.Objects.ObservedPath
    ( 

-- * Exported types
    ObservedPath(..)                        ,
    IsObservedPath                          ,
    toObservedPath                          ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [checkModification]("GI.IBus.Objects.ObservedPath#g:method:checkModification"), [copy]("GI.IBus.Objects.Serializable#g:method:copy"), [destroy]("GI.IBus.Objects.Object#g:method:destroy"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [output]("GI.IBus.Objects.ObservedPath#g:method:output"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeQattachment]("GI.IBus.Objects.Serializable#g:method:removeQattachment"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [serializeObject]("GI.IBus.Objects.Serializable#g:method:serializeObject"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [traverse]("GI.IBus.Objects.ObservedPath#g:method:traverse"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQattachment]("GI.IBus.Objects.Serializable#g:method:getQattachment"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setQattachment]("GI.IBus.Objects.Serializable#g:method:setQattachment").

#if defined(ENABLE_OVERLOADING)
    ResolveObservedPathMethod               ,
#endif

-- ** checkModification #method:checkModification#

#if defined(ENABLE_OVERLOADING)
    ObservedPathCheckModificationMethodInfo ,
#endif
    observedPathCheckModification           ,


-- ** new #method:new#

    observedPathNew                         ,


-- ** newFromXmlNode #method:newFromXmlNode#

    observedPathNewFromXmlNode              ,


-- ** output #method:output#

#if defined(ENABLE_OVERLOADING)
    ObservedPathOutputMethodInfo            ,
#endif
    observedPathOutput                      ,


-- ** traverse #method:traverse#

#if defined(ENABLE_OVERLOADING)
    ObservedPathTraverseMethodInfo          ,
#endif
    observedPathTraverse                    ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GLib.Structs.String as GLib.String
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.IBus.Objects.Object as IBus.Object
import {-# SOURCE #-} qualified GI.IBus.Objects.Serializable as IBus.Serializable
import {-# SOURCE #-} qualified GI.IBus.Structs.XML as IBus.XML

-- | Memory-managed wrapper type.
newtype ObservedPath = ObservedPath (SP.ManagedPtr ObservedPath)
    deriving (ObservedPath -> ObservedPath -> Bool
(ObservedPath -> ObservedPath -> Bool)
-> (ObservedPath -> ObservedPath -> Bool) -> Eq ObservedPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ObservedPath -> ObservedPath -> Bool
== :: ObservedPath -> ObservedPath -> Bool
$c/= :: ObservedPath -> ObservedPath -> Bool
/= :: ObservedPath -> ObservedPath -> Bool
Eq)

instance SP.ManagedPtrNewtype ObservedPath where
    toManagedPtr :: ObservedPath -> ManagedPtr ObservedPath
toManagedPtr (ObservedPath ManagedPtr ObservedPath
p) = ManagedPtr ObservedPath
p

foreign import ccall "ibus_observed_path_get_type"
    c_ibus_observed_path_get_type :: IO B.Types.GType

instance B.Types.TypedObject ObservedPath where
    glibType :: IO GType
glibType = IO GType
c_ibus_observed_path_get_type

instance B.Types.GObject ObservedPath

-- | Type class for types which can be safely cast to `ObservedPath`, for instance with `toObservedPath`.
class (SP.GObject o, O.IsDescendantOf ObservedPath o) => IsObservedPath o
instance (SP.GObject o, O.IsDescendantOf ObservedPath o) => IsObservedPath o

instance O.HasParentTypes ObservedPath
type instance O.ParentTypes ObservedPath = '[IBus.Serializable.Serializable, IBus.Object.Object, GObject.Object.Object]

-- | Cast to `ObservedPath`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toObservedPath :: (MIO.MonadIO m, IsObservedPath o) => o -> m ObservedPath
toObservedPath :: forall (m :: * -> *) o.
(MonadIO m, IsObservedPath o) =>
o -> m ObservedPath
toObservedPath = IO ObservedPath -> m ObservedPath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO ObservedPath -> m ObservedPath)
-> (o -> IO ObservedPath) -> o -> m ObservedPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr ObservedPath -> ObservedPath) -> o -> IO ObservedPath
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr ObservedPath -> ObservedPath
ObservedPath

-- | Convert 'ObservedPath' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe ObservedPath) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_ibus_observed_path_get_type
    gvalueSet_ :: Ptr GValue -> Maybe ObservedPath -> IO ()
gvalueSet_ Ptr GValue
gv Maybe ObservedPath
P.Nothing = Ptr GValue -> Ptr ObservedPath -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr ObservedPath
forall a. Ptr a
FP.nullPtr :: FP.Ptr ObservedPath)
    gvalueSet_ Ptr GValue
gv (P.Just ObservedPath
obj) = ObservedPath -> (Ptr ObservedPath -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ObservedPath
obj (Ptr GValue -> Ptr ObservedPath -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe ObservedPath)
gvalueGet_ Ptr GValue
gv = do
        Ptr ObservedPath
ptr <- Ptr GValue -> IO (Ptr ObservedPath)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr ObservedPath)
        if Ptr ObservedPath
ptr Ptr ObservedPath -> Ptr ObservedPath -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr ObservedPath
forall a. Ptr a
FP.nullPtr
        then ObservedPath -> Maybe ObservedPath
forall a. a -> Maybe a
P.Just (ObservedPath -> Maybe ObservedPath)
-> IO ObservedPath -> IO (Maybe ObservedPath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr ObservedPath -> ObservedPath)
-> Ptr ObservedPath -> IO ObservedPath
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr ObservedPath -> ObservedPath
ObservedPath Ptr ObservedPath
ptr
        else Maybe ObservedPath -> IO (Maybe ObservedPath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ObservedPath
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveObservedPathMethod (t :: Symbol) (o :: *) :: * where
    ResolveObservedPathMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveObservedPathMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveObservedPathMethod "checkModification" o = ObservedPathCheckModificationMethodInfo
    ResolveObservedPathMethod "copy" o = IBus.Serializable.SerializableCopyMethodInfo
    ResolveObservedPathMethod "destroy" o = IBus.Object.ObjectDestroyMethodInfo
    ResolveObservedPathMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveObservedPathMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveObservedPathMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveObservedPathMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveObservedPathMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveObservedPathMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveObservedPathMethod "output" o = ObservedPathOutputMethodInfo
    ResolveObservedPathMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveObservedPathMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveObservedPathMethod "removeQattachment" o = IBus.Serializable.SerializableRemoveQattachmentMethodInfo
    ResolveObservedPathMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveObservedPathMethod "serializeObject" o = IBus.Serializable.SerializableSerializeObjectMethodInfo
    ResolveObservedPathMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveObservedPathMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveObservedPathMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveObservedPathMethod "traverse" o = ObservedPathTraverseMethodInfo
    ResolveObservedPathMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveObservedPathMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveObservedPathMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveObservedPathMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveObservedPathMethod "getQattachment" o = IBus.Serializable.SerializableGetQattachmentMethodInfo
    ResolveObservedPathMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveObservedPathMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveObservedPathMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveObservedPathMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveObservedPathMethod "setQattachment" o = IBus.Serializable.SerializableSetQattachmentMethodInfo
    ResolveObservedPathMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveObservedPathMethod t ObservedPath, O.OverloadedMethod info ObservedPath p) => OL.IsLabel t (ObservedPath -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveObservedPathMethod t ObservedPath, O.OverloadedMethod info ObservedPath p, R.HasField t ObservedPath p) => R.HasField t ObservedPath p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveObservedPathMethod t ObservedPath, O.OverloadedMethodInfo info ObservedPath) => OL.IsLabel t (O.MethodProxy info ObservedPath) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ObservedPath
type instance O.AttributeList ObservedPath = ObservedPathAttributeList
type ObservedPathAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ObservedPath = ObservedPathSignalList
type ObservedPathSignalList = ('[ '("destroy", IBus.Object.ObjectDestroySignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method ObservedPath::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The path string." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fill_stat"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Auto-fill the path status."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "IBus" , name = "ObservedPath" })
-- throws : False
-- Skip return : False

foreign import ccall "ibus_observed_path_new" ibus_observed_path_new :: 
    CString ->                              -- path : TBasicType TUTF8
    CInt ->                                 -- fill_stat : TBasicType TBoolean
    IO (Ptr ObservedPath)

-- | Creates a new t'GI.IBus.Objects.ObservedPath.ObservedPath' from an XML node.
observedPathNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@path@/: The path string.
    -> Bool
    -- ^ /@fillStat@/: Auto-fill the path status.
    -> m ObservedPath
    -- ^ __Returns:__ A newly allocated t'GI.IBus.Objects.ObservedPath.ObservedPath'.
observedPathNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Bool -> m ObservedPath
observedPathNew Text
path Bool
fillStat = IO ObservedPath -> m ObservedPath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ObservedPath -> m ObservedPath)
-> IO ObservedPath -> m ObservedPath
forall a b. (a -> b) -> a -> b
$ do
    CString
path' <- Text -> IO CString
textToCString Text
path
    let fillStat' :: CInt
fillStat' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
fillStat
    Ptr ObservedPath
result <- CString -> CInt -> IO (Ptr ObservedPath)
ibus_observed_path_new CString
path' CInt
fillStat'
    Text -> Ptr ObservedPath -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"observedPathNew" Ptr ObservedPath
result
    ObservedPath
result' <- ((ManagedPtr ObservedPath -> ObservedPath)
-> Ptr ObservedPath -> IO ObservedPath
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ObservedPath -> ObservedPath
ObservedPath) Ptr ObservedPath
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
    ObservedPath -> IO ObservedPath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ObservedPath
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ObservedPath::new_from_xml_node
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "IBus" , name = "XML" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An XML node that contain path."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fill_stat"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Auto-fill the path status."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "IBus" , name = "ObservedPath" })
-- throws : False
-- Skip return : False

foreign import ccall "ibus_observed_path_new_from_xml_node" ibus_observed_path_new_from_xml_node :: 
    Ptr IBus.XML.XML ->                     -- node : TInterface (Name {namespace = "IBus", name = "XML"})
    CInt ->                                 -- fill_stat : TBasicType TBoolean
    IO (Ptr ObservedPath)

-- | Creates an new t'GI.IBus.Objects.ObservedPath.ObservedPath' from an XML node.
observedPathNewFromXmlNode ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IBus.XML.XML
    -- ^ /@node@/: An XML node that contain path.
    -> Bool
    -- ^ /@fillStat@/: Auto-fill the path status.
    -> m ObservedPath
    -- ^ __Returns:__ A newly allocated t'GI.IBus.Objects.ObservedPath.ObservedPath'.
observedPathNewFromXmlNode :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
XML -> Bool -> m ObservedPath
observedPathNewFromXmlNode XML
node Bool
fillStat = IO ObservedPath -> m ObservedPath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ObservedPath -> m ObservedPath)
-> IO ObservedPath -> m ObservedPath
forall a b. (a -> b) -> a -> b
$ do
    Ptr XML
node' <- XML -> IO (Ptr XML)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr XML
node
    let fillStat' :: CInt
fillStat' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
fillStat
    Ptr ObservedPath
result <- Ptr XML -> CInt -> IO (Ptr ObservedPath)
ibus_observed_path_new_from_xml_node Ptr XML
node' CInt
fillStat'
    Text -> Ptr ObservedPath -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"observedPathNewFromXmlNode" Ptr ObservedPath
result
    ObservedPath
result' <- ((ManagedPtr ObservedPath -> ObservedPath)
-> Ptr ObservedPath -> IO ObservedPath
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ObservedPath -> ObservedPath
ObservedPath) Ptr ObservedPath
result
    XML -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr XML
node
    ObservedPath -> IO ObservedPath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ObservedPath
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ObservedPath::check_modification
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "path"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "ObservedPath" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusObservedPath."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_observed_path_check_modification" ibus_observed_path_check_modification :: 
    Ptr ObservedPath ->                     -- path : TInterface (Name {namespace = "IBus", name = "ObservedPath"})
    IO CInt

-- | Checks whether the path is modified by comparing the mtime in object and
-- mtime in file system.
observedPathCheckModification ::
    (B.CallStack.HasCallStack, MonadIO m, IsObservedPath a) =>
    a
    -- ^ /@path@/: An IBusObservedPath.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if imtime is changed, otherwise 'P.False'.
observedPathCheckModification :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsObservedPath a) =>
a -> m Bool
observedPathCheckModification a
path = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr ObservedPath
path' <- a -> IO (Ptr ObservedPath)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    CInt
result <- Ptr ObservedPath -> IO CInt
ibus_observed_path_check_modification Ptr ObservedPath
path'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ObservedPathCheckModificationMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsObservedPath a) => O.OverloadedMethod ObservedPathCheckModificationMethodInfo a signature where
    overloadedMethod = observedPathCheckModification

instance O.OverloadedMethodInfo ObservedPathCheckModificationMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.ObservedPath.observedPathCheckModification",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-ObservedPath.html#v:observedPathCheckModification"
        })


#endif

-- method ObservedPath::output
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "path"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "ObservedPath" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusObservedPath."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "output"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "String" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Path is appended to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "indent"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of indent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_observed_path_output" ibus_observed_path_output :: 
    Ptr ObservedPath ->                     -- path : TInterface (Name {namespace = "IBus", name = "ObservedPath"})
    Ptr GLib.String.String ->               -- output : TInterface (Name {namespace = "GLib", name = "String"})
    Int32 ->                                -- indent : TBasicType TInt
    IO ()

-- | Append the observed path to a string with following format:
-- &lt;path mtime=\"&lt;i&gt;modified time&lt;\/i&gt;\" &gt;&lt;i&gt;path&lt;\/i&gt;&lt;\/path&gt;
observedPathOutput ::
    (B.CallStack.HasCallStack, MonadIO m, IsObservedPath a) =>
    a
    -- ^ /@path@/: An IBusObservedPath.
    -> GLib.String.String
    -- ^ /@output@/: Path is appended to.
    -> Int32
    -- ^ /@indent@/: number of indent.
    -> m ()
observedPathOutput :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsObservedPath a) =>
a -> String -> Int32 -> m ()
observedPathOutput a
path String
output Int32
indent = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ObservedPath
path' <- a -> IO (Ptr ObservedPath)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    Ptr String
output' <- String -> IO (Ptr String)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr String
output
    Ptr ObservedPath -> Ptr String -> Int32 -> IO ()
ibus_observed_path_output Ptr ObservedPath
path' Ptr String
output' Int32
indent
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    String -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr String
output
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ObservedPathOutputMethodInfo
instance (signature ~ (GLib.String.String -> Int32 -> m ()), MonadIO m, IsObservedPath a) => O.OverloadedMethod ObservedPathOutputMethodInfo a signature where
    overloadedMethod = observedPathOutput

instance O.OverloadedMethodInfo ObservedPathOutputMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.ObservedPath.observedPathOutput",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-ObservedPath.html#v:observedPathOutput"
        })


#endif

-- method ObservedPath::traverse
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "path"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "ObservedPath" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusObservedPath."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dir_only"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Only looks for subdirs, not files"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "IBus" , name = "ObservedPath" }))
-- throws : False
-- Skip return : False

foreign import ccall "ibus_observed_path_traverse" ibus_observed_path_traverse :: 
    Ptr ObservedPath ->                     -- path : TInterface (Name {namespace = "IBus", name = "ObservedPath"})
    CInt ->                                 -- dir_only : TBasicType TBoolean
    IO (Ptr (GList (Ptr ObservedPath)))

-- | Recursively traverse the path and put the files and subdirectory in to
-- a newly allocated
-- GLists, if the /@path@/ is a directory. Otherwise returns NULL.
observedPathTraverse ::
    (B.CallStack.HasCallStack, MonadIO m, IsObservedPath a) =>
    a
    -- ^ /@path@/: An IBusObservedPath.
    -> Bool
    -- ^ /@dirOnly@/: Only looks for subdirs, not files
    -> m [ObservedPath]
    -- ^ __Returns:__ A newly allocate
    -- GList which holds content in path; NULL if /@path@/ is not directory.
observedPathTraverse :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsObservedPath a) =>
a -> Bool -> m [ObservedPath]
observedPathTraverse a
path Bool
dirOnly = IO [ObservedPath] -> m [ObservedPath]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ObservedPath] -> m [ObservedPath])
-> IO [ObservedPath] -> m [ObservedPath]
forall a b. (a -> b) -> a -> b
$ do
    Ptr ObservedPath
path' <- a -> IO (Ptr ObservedPath)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    let dirOnly' :: CInt
dirOnly' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
dirOnly
    Ptr (GList (Ptr ObservedPath))
result <- Ptr ObservedPath -> CInt -> IO (Ptr (GList (Ptr ObservedPath)))
ibus_observed_path_traverse Ptr ObservedPath
path' CInt
dirOnly'
    [Ptr ObservedPath]
result' <- Ptr (GList (Ptr ObservedPath)) -> IO [Ptr ObservedPath]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr ObservedPath))
result
    [ObservedPath]
result'' <- (Ptr ObservedPath -> IO ObservedPath)
-> [Ptr ObservedPath] -> IO [ObservedPath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr ObservedPath -> ObservedPath)
-> Ptr ObservedPath -> IO ObservedPath
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ObservedPath -> ObservedPath
ObservedPath) [Ptr ObservedPath]
result'
    Ptr (GList (Ptr ObservedPath)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr ObservedPath))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    [ObservedPath] -> IO [ObservedPath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ObservedPath]
result''

#if defined(ENABLE_OVERLOADING)
data ObservedPathTraverseMethodInfo
instance (signature ~ (Bool -> m [ObservedPath]), MonadIO m, IsObservedPath a) => O.OverloadedMethod ObservedPathTraverseMethodInfo a signature where
    overloadedMethod = observedPathTraverse

instance O.OverloadedMethodInfo ObservedPathTraverseMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.ObservedPath.observedPathTraverse",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-ObservedPath.html#v:observedPathTraverse"
        })


#endif