{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Poppler.Structs.IndexIter
    ( 

-- * Exported types
    IndexIter(..)                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copy]("GI.Poppler.Structs.IndexIter#g:method:copy"), [free]("GI.Poppler.Structs.IndexIter#g:method:free"), [isOpen]("GI.Poppler.Structs.IndexIter#g:method:isOpen"), [next]("GI.Poppler.Structs.IndexIter#g:method:next").
-- 
-- ==== Getters
-- [getAction]("GI.Poppler.Structs.IndexIter#g:method:getAction"), [getChild]("GI.Poppler.Structs.IndexIter#g:method:getChild").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveIndexIterMethod                  ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    IndexIterCopyMethodInfo                 ,
#endif
    indexIterCopy                           ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    IndexIterFreeMethodInfo                 ,
#endif
    indexIterFree                           ,


-- ** getAction #method:getAction#

#if defined(ENABLE_OVERLOADING)
    IndexIterGetActionMethodInfo            ,
#endif
    indexIterGetAction                      ,


-- ** getChild #method:getChild#

#if defined(ENABLE_OVERLOADING)
    IndexIterGetChildMethodInfo             ,
#endif
    indexIterGetChild                       ,


-- ** isOpen #method:isOpen#

#if defined(ENABLE_OVERLOADING)
    IndexIterIsOpenMethodInfo               ,
#endif
    indexIterIsOpen                         ,


-- ** new #method:new#

    indexIterNew                            ,


-- ** next #method:next#

#if defined(ENABLE_OVERLOADING)
    IndexIterNextMethodInfo                 ,
#endif
    indexIterNext                           ,




    ) 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.Kind as DK
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 Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.Cairo.Structs.Context as Cairo.Context
import qualified GI.Cairo.Structs.Region as Cairo.Region
import qualified GI.Cairo.Structs.Surface as Cairo.Surface
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GLib.Structs.DateTime as GLib.DateTime
import qualified GI.GLib.Structs.String as GLib.String
import qualified GI.GLib.Structs.Tree as GLib.Tree
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.InputStream as Gio.InputStream
import qualified GI.Poppler.Callbacks as Poppler.Callbacks
import {-# SOURCE #-} qualified GI.Poppler.Enums as Poppler.Enums
import {-# SOURCE #-} qualified GI.Poppler.Flags as Poppler.Flags
import {-# SOURCE #-} qualified GI.Poppler.Objects.Annot as Poppler.Annot
import {-# SOURCE #-} qualified GI.Poppler.Objects.Attachment as Poppler.Attachment
import {-# SOURCE #-} qualified GI.Poppler.Objects.Document as Poppler.Document
import {-# SOURCE #-} qualified GI.Poppler.Objects.FormField as Poppler.FormField
import {-# SOURCE #-} qualified GI.Poppler.Objects.Layer as Poppler.Layer
import {-# SOURCE #-} qualified GI.Poppler.Objects.Media as Poppler.Media
import {-# SOURCE #-} qualified GI.Poppler.Objects.Movie as Poppler.Movie
import {-# SOURCE #-} qualified GI.Poppler.Objects.PSFile as Poppler.PSFile
import {-# SOURCE #-} qualified GI.Poppler.Objects.Page as Poppler.Page
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionAny as Poppler.ActionAny
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionGotoDest as Poppler.ActionGotoDest
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionGotoRemote as Poppler.ActionGotoRemote
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionJavascript as Poppler.ActionJavascript
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionLaunch as Poppler.ActionLaunch
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionLayer as Poppler.ActionLayer
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionMovie as Poppler.ActionMovie
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionNamed as Poppler.ActionNamed
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionOCGState as Poppler.ActionOCGState
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionRendition as Poppler.ActionRendition
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionResetForm as Poppler.ActionResetForm
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionUri as Poppler.ActionUri
import {-# SOURCE #-} qualified GI.Poppler.Structs.AnnotMapping as Poppler.AnnotMapping
import {-# SOURCE #-} qualified GI.Poppler.Structs.CertificateInfo as Poppler.CertificateInfo
import {-# SOURCE #-} qualified GI.Poppler.Structs.Color as Poppler.Color
import {-# SOURCE #-} qualified GI.Poppler.Structs.Dest as Poppler.Dest
import {-# SOURCE #-} qualified GI.Poppler.Structs.FormFieldMapping as Poppler.FormFieldMapping
import {-# SOURCE #-} qualified GI.Poppler.Structs.ImageMapping as Poppler.ImageMapping
import {-# SOURCE #-} qualified GI.Poppler.Structs.LinkMapping as Poppler.LinkMapping
import {-# SOURCE #-} qualified GI.Poppler.Structs.PageRange as Poppler.PageRange
import {-# SOURCE #-} qualified GI.Poppler.Structs.PageTransition as Poppler.PageTransition
import {-# SOURCE #-} qualified GI.Poppler.Structs.Rectangle as Poppler.Rectangle
import {-# SOURCE #-} qualified GI.Poppler.Structs.SignatureInfo as Poppler.SignatureInfo
import {-# SOURCE #-} qualified GI.Poppler.Structs.SigningData as Poppler.SigningData
import {-# SOURCE #-} qualified GI.Poppler.Structs.TextAttributes as Poppler.TextAttributes
import {-# SOURCE #-} qualified GI.Poppler.Unions.Action as Poppler.Action

#else
import {-# SOURCE #-} qualified GI.Poppler.Objects.Document as Poppler.Document
import {-# SOURCE #-} qualified GI.Poppler.Unions.Action as Poppler.Action

#endif

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

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

foreign import ccall "poppler_index_iter_get_type" c_poppler_index_iter_get_type :: 
    IO GType

type instance O.ParentTypes IndexIter = '[]
instance O.HasParentTypes IndexIter

instance B.Types.TypedObject IndexIter where
    glibType :: IO GType
glibType = IO GType
c_poppler_index_iter_get_type

instance B.Types.GBoxed IndexIter

-- | Convert 'IndexIter' 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 IndexIter) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_poppler_index_iter_get_type
    gvalueSet_ :: Ptr GValue -> Maybe IndexIter -> IO ()
gvalueSet_ Ptr GValue
gv Maybe IndexIter
P.Nothing = Ptr GValue -> Ptr IndexIter -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr IndexIter
forall a. Ptr a
FP.nullPtr :: FP.Ptr IndexIter)
    gvalueSet_ Ptr GValue
gv (P.Just IndexIter
obj) = IndexIter -> (Ptr IndexIter -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr IndexIter
obj (Ptr GValue -> Ptr IndexIter -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe IndexIter)
gvalueGet_ Ptr GValue
gv = do
        Ptr IndexIter
ptr <- Ptr GValue -> IO (Ptr IndexIter)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr IndexIter)
        if Ptr IndexIter
ptr Ptr IndexIter -> Ptr IndexIter -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr IndexIter
forall a. Ptr a
FP.nullPtr
        then IndexIter -> Maybe IndexIter
forall a. a -> Maybe a
P.Just (IndexIter -> Maybe IndexIter)
-> IO IndexIter -> IO (Maybe IndexIter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr IndexIter -> IndexIter)
-> Ptr IndexIter -> IO IndexIter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr IndexIter -> IndexIter
IndexIter Ptr IndexIter
ptr
        else Maybe IndexIter -> IO (Maybe IndexIter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe IndexIter
forall a. Maybe a
P.Nothing
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList IndexIter
type instance O.AttributeList IndexIter = IndexIterAttributeList
type IndexIterAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

-- method IndexIter::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "document"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Document" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerDocument" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Poppler" , name = "IndexIter" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_index_iter_new" poppler_index_iter_new :: 
    Ptr Poppler.Document.Document ->        -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO (Ptr IndexIter)

-- | Returns the root t'GI.Poppler.Structs.IndexIter.IndexIter' for /@document@/, or 'P.Nothing'.  This must be
-- freed with 'GI.Poppler.Structs.IndexIter.indexIterFree'.
-- 
-- Certain documents have an index associated with them.  This index can be used
-- to help the user navigate the document, and is similar to a table of
-- contents.  Each node in the index will contain a t'GI.Poppler.Unions.Action.Action' that can be
-- displayed to the user &mdash; typically a @/POPPLER_ACTION_GOTO_DEST/@ or a
-- @/POPPLER_ACTION_URI/@.
-- 
-- Here is a simple example of some code that walks the full index:
-- 
-- \<informalexample>\<programlisting>
-- static void
-- walk_index (PopplerIndexIter *iter)
-- {
--   do
--     {
--       \/\<!-- -->* Get the action and do something with it *\<!-- -->\/
--       PopplerIndexIter *child = poppler_index_iter_get_child (iter);
--       if (child)
--         walk_index (child);
--       poppler_index_iter_free (child);
--     }
--   while (poppler_index_iter_next (iter));
-- }
-- ...
-- {
--   iter = poppler_index_iter_new (document);
--   walk_index (iter);
--   poppler_index_iter_free (iter);
-- }
-- \<\/programlisting>\<\/informalexample>
indexIterNew ::
    (B.CallStack.HasCallStack, MonadIO m, Poppler.Document.IsDocument a) =>
    a
    -- ^ /@document@/: a t'GI.Poppler.Objects.Document.Document'
    -> m IndexIter
    -- ^ __Returns:__ a new t'GI.Poppler.Structs.IndexIter.IndexIter'
indexIterNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m IndexIter
indexIterNew a
document = IO IndexIter -> m IndexIter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IndexIter -> m IndexIter) -> IO IndexIter -> m IndexIter
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr IndexIter
result <- Ptr Document -> IO (Ptr IndexIter)
poppler_index_iter_new Ptr Document
document'
    Text -> Ptr IndexIter -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"indexIterNew" Ptr IndexIter
result
    IndexIter
result' <- ((ManagedPtr IndexIter -> IndexIter)
-> Ptr IndexIter -> IO IndexIter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr IndexIter -> IndexIter
IndexIter) Ptr IndexIter
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    IndexIter -> IO IndexIter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IndexIter
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method IndexIter::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "IndexIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerIndexIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Poppler" , name = "IndexIter" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_index_iter_copy" poppler_index_iter_copy :: 
    Ptr IndexIter ->                        -- iter : TInterface (Name {namespace = "Poppler", name = "IndexIter"})
    IO (Ptr IndexIter)

-- | Creates a new t'GI.Poppler.Structs.IndexIter.IndexIter' as a copy of /@iter@/.  This must be freed with
-- 'GI.Poppler.Structs.IndexIter.indexIterFree'.
indexIterCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexIter
    -- ^ /@iter@/: a t'GI.Poppler.Structs.IndexIter.IndexIter'
    -> m IndexIter
    -- ^ __Returns:__ a new t'GI.Poppler.Structs.IndexIter.IndexIter'
indexIterCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IndexIter -> m IndexIter
indexIterCopy IndexIter
iter = IO IndexIter -> m IndexIter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IndexIter -> m IndexIter) -> IO IndexIter -> m IndexIter
forall a b. (a -> b) -> a -> b
$ do
    Ptr IndexIter
iter' <- IndexIter -> IO (Ptr IndexIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexIter
iter
    Ptr IndexIter
result <- Ptr IndexIter -> IO (Ptr IndexIter)
poppler_index_iter_copy Ptr IndexIter
iter'
    Text -> Ptr IndexIter -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"indexIterCopy" Ptr IndexIter
result
    IndexIter
result' <- ((ManagedPtr IndexIter -> IndexIter)
-> Ptr IndexIter -> IO IndexIter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr IndexIter -> IndexIter
IndexIter) Ptr IndexIter
result
    IndexIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexIter
iter
    IndexIter -> IO IndexIter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IndexIter
result'

#if defined(ENABLE_OVERLOADING)
data IndexIterCopyMethodInfo
instance (signature ~ (m IndexIter), MonadIO m) => O.OverloadedMethod IndexIterCopyMethodInfo IndexIter signature where
    overloadedMethod = indexIterCopy

instance O.OverloadedMethodInfo IndexIterCopyMethodInfo IndexIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Structs.IndexIter.indexIterCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.30/docs/GI-Poppler-Structs-IndexIter.html#v:indexIterCopy"
        })


#endif

-- method IndexIter::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "IndexIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerIndexIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_index_iter_free" poppler_index_iter_free :: 
    Ptr IndexIter ->                        -- iter : TInterface (Name {namespace = "Poppler", name = "IndexIter"})
    IO ()

-- | Frees /@iter@/.
indexIterFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexIter
    -- ^ /@iter@/: a t'GI.Poppler.Structs.IndexIter.IndexIter'
    -> m ()
indexIterFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IndexIter -> m ()
indexIterFree IndexIter
iter = 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 IndexIter
iter' <- IndexIter -> IO (Ptr IndexIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexIter
iter
    Ptr IndexIter -> IO ()
poppler_index_iter_free Ptr IndexIter
iter'
    IndexIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexIter
iter
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndexIterFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod IndexIterFreeMethodInfo IndexIter signature where
    overloadedMethod = indexIterFree

instance O.OverloadedMethodInfo IndexIterFreeMethodInfo IndexIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Structs.IndexIter.indexIterFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.30/docs/GI-Poppler-Structs-IndexIter.html#v:indexIterFree"
        })


#endif

-- method IndexIter::get_action
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "IndexIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerIndexIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Poppler" , name = "Action" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_index_iter_get_action" poppler_index_iter_get_action :: 
    Ptr IndexIter ->                        -- iter : TInterface (Name {namespace = "Poppler", name = "IndexIter"})
    IO (Ptr Poppler.Action.Action)

-- | Returns the t'GI.Poppler.Unions.Action.Action' associated with /@iter@/.  It must be freed with
-- 'GI.Poppler.Unions.Action.actionFree'.
indexIterGetAction ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexIter
    -- ^ /@iter@/: a t'GI.Poppler.Structs.IndexIter.IndexIter'
    -> m Poppler.Action.Action
    -- ^ __Returns:__ a new t'GI.Poppler.Unions.Action.Action'
indexIterGetAction :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IndexIter -> m Action
indexIterGetAction IndexIter
iter = IO Action -> m Action
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Action -> m Action) -> IO Action -> m Action
forall a b. (a -> b) -> a -> b
$ do
    Ptr IndexIter
iter' <- IndexIter -> IO (Ptr IndexIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexIter
iter
    Ptr Action
result <- Ptr IndexIter -> IO (Ptr Action)
poppler_index_iter_get_action Ptr IndexIter
iter'
    Text -> Ptr Action -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"indexIterGetAction" Ptr Action
result
    Action
result' <- ((ManagedPtr Action -> Action) -> Ptr Action -> IO Action
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Action -> Action
Poppler.Action.Action) Ptr Action
result
    IndexIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexIter
iter
    Action -> IO Action
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Action
result'

#if defined(ENABLE_OVERLOADING)
data IndexIterGetActionMethodInfo
instance (signature ~ (m Poppler.Action.Action), MonadIO m) => O.OverloadedMethod IndexIterGetActionMethodInfo IndexIter signature where
    overloadedMethod = indexIterGetAction

instance O.OverloadedMethodInfo IndexIterGetActionMethodInfo IndexIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Structs.IndexIter.indexIterGetAction",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.30/docs/GI-Poppler-Structs-IndexIter.html#v:indexIterGetAction"
        })


#endif

-- method IndexIter::get_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parent"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "IndexIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerIndexIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Poppler" , name = "IndexIter" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_index_iter_get_child" poppler_index_iter_get_child :: 
    Ptr IndexIter ->                        -- parent : TInterface (Name {namespace = "Poppler", name = "IndexIter"})
    IO (Ptr IndexIter)

-- | Returns a newly created child of /@parent@/, or 'P.Nothing' if the iter has no child.
-- See 'GI.Poppler.Structs.IndexIter.indexIterNew' for more information on this function.
indexIterGetChild ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexIter
    -- ^ /@parent@/: a t'GI.Poppler.Structs.IndexIter.IndexIter'
    -> m IndexIter
    -- ^ __Returns:__ a new t'GI.Poppler.Structs.IndexIter.IndexIter'
indexIterGetChild :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IndexIter -> m IndexIter
indexIterGetChild IndexIter
parent = IO IndexIter -> m IndexIter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IndexIter -> m IndexIter) -> IO IndexIter -> m IndexIter
forall a b. (a -> b) -> a -> b
$ do
    Ptr IndexIter
parent' <- IndexIter -> IO (Ptr IndexIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexIter
parent
    Ptr IndexIter
result <- Ptr IndexIter -> IO (Ptr IndexIter)
poppler_index_iter_get_child Ptr IndexIter
parent'
    Text -> Ptr IndexIter -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"indexIterGetChild" Ptr IndexIter
result
    IndexIter
result' <- ((ManagedPtr IndexIter -> IndexIter)
-> Ptr IndexIter -> IO IndexIter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr IndexIter -> IndexIter
IndexIter) Ptr IndexIter
result
    IndexIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexIter
parent
    IndexIter -> IO IndexIter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IndexIter
result'

#if defined(ENABLE_OVERLOADING)
data IndexIterGetChildMethodInfo
instance (signature ~ (m IndexIter), MonadIO m) => O.OverloadedMethod IndexIterGetChildMethodInfo IndexIter signature where
    overloadedMethod = indexIterGetChild

instance O.OverloadedMethodInfo IndexIterGetChildMethodInfo IndexIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Structs.IndexIter.indexIterGetChild",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.30/docs/GI-Poppler-Structs-IndexIter.html#v:indexIterGetChild"
        })


#endif

-- method IndexIter::is_open
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "IndexIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerIndexIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_index_iter_is_open" poppler_index_iter_is_open :: 
    Ptr IndexIter ->                        -- iter : TInterface (Name {namespace = "Poppler", name = "IndexIter"})
    IO CInt

-- | Returns whether this node should be expanded by default to the user.  The
-- document can provide a hint as to how the document\'s index should be expanded
-- initially.
indexIterIsOpen ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexIter
    -- ^ /@iter@/: a t'GI.Poppler.Structs.IndexIter.IndexIter'
    -> m Bool
    -- ^ __Returns:__ 'P.True', if the document wants /@iter@/ to be expanded
indexIterIsOpen :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IndexIter -> m Bool
indexIterIsOpen IndexIter
iter = 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 IndexIter
iter' <- IndexIter -> IO (Ptr IndexIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexIter
iter
    CInt
result <- Ptr IndexIter -> IO CInt
poppler_index_iter_is_open Ptr IndexIter
iter'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    IndexIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexIter
iter
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data IndexIterIsOpenMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod IndexIterIsOpenMethodInfo IndexIter signature where
    overloadedMethod = indexIterIsOpen

instance O.OverloadedMethodInfo IndexIterIsOpenMethodInfo IndexIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Structs.IndexIter.indexIterIsOpen",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.30/docs/GI-Poppler-Structs-IndexIter.html#v:indexIterIsOpen"
        })


#endif

-- method IndexIter::next
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "IndexIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerIndexIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_index_iter_next" poppler_index_iter_next :: 
    Ptr IndexIter ->                        -- iter : TInterface (Name {namespace = "Poppler", name = "IndexIter"})
    IO CInt

-- | Sets /@iter@/ to point to the next action at the current level, if valid.  See
-- 'GI.Poppler.Structs.IndexIter.indexIterNew' for more information.
indexIterNext ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexIter
    -- ^ /@iter@/: a t'GI.Poppler.Structs.IndexIter.IndexIter'
    -> m Bool
    -- ^ __Returns:__ 'P.True', if /@iter@/ was set to the next action
indexIterNext :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IndexIter -> m Bool
indexIterNext IndexIter
iter = 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 IndexIter
iter' <- IndexIter -> IO (Ptr IndexIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexIter
iter
    CInt
result <- Ptr IndexIter -> IO CInt
poppler_index_iter_next Ptr IndexIter
iter'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    IndexIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexIter
iter
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data IndexIterNextMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod IndexIterNextMethodInfo IndexIter signature where
    overloadedMethod = indexIterNext

instance O.OverloadedMethodInfo IndexIterNextMethodInfo IndexIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Structs.IndexIter.indexIterNext",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.30/docs/GI-Poppler-Structs-IndexIter.html#v:indexIterNext"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveIndexIterMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveIndexIterMethod "copy" o = IndexIterCopyMethodInfo
    ResolveIndexIterMethod "free" o = IndexIterFreeMethodInfo
    ResolveIndexIterMethod "isOpen" o = IndexIterIsOpenMethodInfo
    ResolveIndexIterMethod "next" o = IndexIterNextMethodInfo
    ResolveIndexIterMethod "getAction" o = IndexIterGetActionMethodInfo
    ResolveIndexIterMethod "getChild" o = IndexIterGetChildMethodInfo
    ResolveIndexIterMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveIndexIterMethod t IndexIter, O.OverloadedMethod info IndexIter p) => OL.IsLabel t (IndexIter -> 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 ~ ResolveIndexIterMethod t IndexIter, O.OverloadedMethod info IndexIter p, R.HasField t IndexIter p) => R.HasField t IndexIter p where
    getField = O.overloadedMethod @info

#endif

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

#endif