{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Resets some or all fields within a PDF form.
-- 
-- The default behavior resets only the list of /@fields@/, but setting
-- /@exclude@/ to 'P.True' will cause the action to reset all fields but those
-- listed. Providing an empty list of fields resets the entire form.
-- 
-- /Since: 0.90/

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

module GI.Poppler.Structs.ActionResetForm
    ( 

-- * Exported types
    ActionResetForm(..)                     ,
    newZeroActionResetForm                  ,


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolveActionResetFormMethod            ,
#endif



 -- * Properties


-- ** exclude #attr:exclude#
-- | whether to reset all but the listed fields

#if defined(ENABLE_OVERLOADING)
    actionResetForm_exclude                 ,
#endif
    getActionResetFormExclude               ,
    setActionResetFormExclude               ,


-- ** fields #attr:fields#
-- | list of field names to
--   reset \/ retain

#if defined(ENABLE_OVERLOADING)
    actionResetForm_fields                  ,
#endif
    clearActionResetFormFields              ,
    getActionResetFormFields                ,
    setActionResetFormFields                ,


-- ** title #attr:title#
-- | action title

#if defined(ENABLE_OVERLOADING)
    actionResetForm_title                   ,
#endif
    clearActionResetFormTitle               ,
    getActionResetFormTitle                 ,
    setActionResetFormTitle                 ,


-- ** type #attr:type#
-- | action type ('GI.Poppler.Enums.ActionTypeResetForm')

#if defined(ENABLE_OVERLOADING)
    actionResetForm_type                    ,
#endif
    getActionResetFormType                  ,
    setActionResetFormType                  ,




    ) 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.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 {-# SOURCE #-} qualified GI.Poppler.Enums as Poppler.Enums

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

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

instance BoxedPtr ActionResetForm where
    boxedPtrCopy :: ActionResetForm -> IO ActionResetForm
boxedPtrCopy = \ActionResetForm
p -> ActionResetForm
-> (Ptr ActionResetForm -> IO ActionResetForm)
-> IO ActionResetForm
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ActionResetForm
p (Int -> Ptr ActionResetForm -> IO (Ptr ActionResetForm)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
32 (Ptr ActionResetForm -> IO (Ptr ActionResetForm))
-> (Ptr ActionResetForm -> IO ActionResetForm)
-> Ptr ActionResetForm
-> IO ActionResetForm
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr ActionResetForm -> ActionResetForm)
-> Ptr ActionResetForm -> IO ActionResetForm
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr ActionResetForm -> ActionResetForm
ActionResetForm)
    boxedPtrFree :: ActionResetForm -> IO ()
boxedPtrFree = \ActionResetForm
x -> ActionResetForm -> (Ptr ActionResetForm -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr ActionResetForm
x Ptr ActionResetForm -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr ActionResetForm where
    boxedPtrCalloc :: IO (Ptr ActionResetForm)
boxedPtrCalloc = Int -> IO (Ptr ActionResetForm)
forall a. Int -> IO (Ptr a)
callocBytes Int
32


-- | Construct a `ActionResetForm` struct initialized to zero.
newZeroActionResetForm :: MonadIO m => m ActionResetForm
newZeroActionResetForm :: forall (m :: * -> *). MonadIO m => m ActionResetForm
newZeroActionResetForm = IO ActionResetForm -> m ActionResetForm
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActionResetForm -> m ActionResetForm)
-> IO ActionResetForm -> m ActionResetForm
forall a b. (a -> b) -> a -> b
$ IO (Ptr ActionResetForm)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr ActionResetForm)
-> (Ptr ActionResetForm -> IO ActionResetForm)
-> IO ActionResetForm
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr ActionResetForm -> ActionResetForm)
-> Ptr ActionResetForm -> IO ActionResetForm
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr ActionResetForm -> ActionResetForm
ActionResetForm

instance tag ~ 'AttrSet => Constructible ActionResetForm tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr ActionResetForm -> ActionResetForm)
-> [AttrOp ActionResetForm tag] -> m ActionResetForm
new ManagedPtr ActionResetForm -> ActionResetForm
_ [AttrOp ActionResetForm tag]
attrs = do
        ActionResetForm
o <- m ActionResetForm
forall (m :: * -> *). MonadIO m => m ActionResetForm
newZeroActionResetForm
        ActionResetForm -> [AttrOp ActionResetForm 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set ActionResetForm
o [AttrOp ActionResetForm tag]
[AttrOp ActionResetForm 'AttrSet]
attrs
        ActionResetForm -> m ActionResetForm
forall (m :: * -> *) a. Monad m => a -> m a
return ActionResetForm
o


-- | Get the value of the “@type@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' actionResetForm #type
-- @
getActionResetFormType :: MonadIO m => ActionResetForm -> m Poppler.Enums.ActionType
getActionResetFormType :: forall (m :: * -> *). MonadIO m => ActionResetForm -> m ActionType
getActionResetFormType ActionResetForm
s = IO ActionType -> m ActionType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActionType -> m ActionType) -> IO ActionType -> m ActionType
forall a b. (a -> b) -> a -> b
$ ActionResetForm
-> (Ptr ActionResetForm -> IO ActionType) -> IO ActionType
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionResetForm
s ((Ptr ActionResetForm -> IO ActionType) -> IO ActionType)
-> (Ptr ActionResetForm -> IO ActionType) -> IO ActionType
forall a b. (a -> b) -> a -> b
$ \Ptr ActionResetForm
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActionResetForm
ptr Ptr ActionResetForm -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO CUInt
    let val' :: ActionType
val' = (Int -> ActionType
forall a. Enum a => Int -> a
toEnum (Int -> ActionType) -> (CUInt -> Int) -> CUInt -> ActionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
val
    ActionType -> IO ActionType
forall (m :: * -> *) a. Monad m => a -> m a
return ActionType
val'

-- | Set the value of the “@type@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' actionResetForm [ #type 'Data.GI.Base.Attributes.:=' value ]
-- @
setActionResetFormType :: MonadIO m => ActionResetForm -> Poppler.Enums.ActionType -> m ()
setActionResetFormType :: forall (m :: * -> *).
MonadIO m =>
ActionResetForm -> ActionType -> m ()
setActionResetFormType ActionResetForm
s ActionType
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActionResetForm -> (Ptr ActionResetForm -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionResetForm
s ((Ptr ActionResetForm -> IO ()) -> IO ())
-> (Ptr ActionResetForm -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionResetForm
ptr -> do
    let val' :: CUInt
val' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ActionType -> Int) -> ActionType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionType -> Int
forall a. Enum a => a -> Int
fromEnum) ActionType
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionResetForm
ptr Ptr ActionResetForm -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data ActionResetFormTypeFieldInfo
instance AttrInfo ActionResetFormTypeFieldInfo where
    type AttrBaseTypeConstraint ActionResetFormTypeFieldInfo = (~) ActionResetForm
    type AttrAllowedOps ActionResetFormTypeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ActionResetFormTypeFieldInfo = (~) Poppler.Enums.ActionType
    type AttrTransferTypeConstraint ActionResetFormTypeFieldInfo = (~)Poppler.Enums.ActionType
    type AttrTransferType ActionResetFormTypeFieldInfo = Poppler.Enums.ActionType
    type AttrGetType ActionResetFormTypeFieldInfo = Poppler.Enums.ActionType
    type AttrLabel ActionResetFormTypeFieldInfo = "type"
    type AttrOrigin ActionResetFormTypeFieldInfo = ActionResetForm
    attrGet = getActionResetFormType
    attrSet = setActionResetFormType
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Structs.ActionResetForm.type"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Structs-ActionResetForm.html#g:attr:type"
        })

actionResetForm_type :: AttrLabelProxy "type"
actionResetForm_type = AttrLabelProxy

#endif


-- | Get the value of the “@title@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' actionResetForm #title
-- @
getActionResetFormTitle :: MonadIO m => ActionResetForm -> m (Maybe T.Text)
getActionResetFormTitle :: forall (m :: * -> *).
MonadIO m =>
ActionResetForm -> m (Maybe Text)
getActionResetFormTitle ActionResetForm
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ ActionResetForm
-> (Ptr ActionResetForm -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionResetForm
s ((Ptr ActionResetForm -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr ActionResetForm -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr ActionResetForm
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActionResetForm
ptr Ptr ActionResetForm -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@title@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' actionResetForm [ #title 'Data.GI.Base.Attributes.:=' value ]
-- @
setActionResetFormTitle :: MonadIO m => ActionResetForm -> CString -> m ()
setActionResetFormTitle :: forall (m :: * -> *).
MonadIO m =>
ActionResetForm -> CString -> m ()
setActionResetFormTitle ActionResetForm
s CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActionResetForm -> (Ptr ActionResetForm -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionResetForm
s ((Ptr ActionResetForm -> IO ()) -> IO ())
-> (Ptr ActionResetForm -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionResetForm
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionResetForm
ptr Ptr ActionResetForm -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CString
val :: CString)

-- | Set the value of the “@title@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #title
-- @
clearActionResetFormTitle :: MonadIO m => ActionResetForm -> m ()
clearActionResetFormTitle :: forall (m :: * -> *). MonadIO m => ActionResetForm -> m ()
clearActionResetFormTitle ActionResetForm
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActionResetForm -> (Ptr ActionResetForm -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionResetForm
s ((Ptr ActionResetForm -> IO ()) -> IO ())
-> (Ptr ActionResetForm -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionResetForm
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionResetForm
ptr Ptr ActionResetForm -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data ActionResetFormTitleFieldInfo
instance AttrInfo ActionResetFormTitleFieldInfo where
    type AttrBaseTypeConstraint ActionResetFormTitleFieldInfo = (~) ActionResetForm
    type AttrAllowedOps ActionResetFormTitleFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ActionResetFormTitleFieldInfo = (~) CString
    type AttrTransferTypeConstraint ActionResetFormTitleFieldInfo = (~)CString
    type AttrTransferType ActionResetFormTitleFieldInfo = CString
    type AttrGetType ActionResetFormTitleFieldInfo = Maybe T.Text
    type AttrLabel ActionResetFormTitleFieldInfo = "title"
    type AttrOrigin ActionResetFormTitleFieldInfo = ActionResetForm
    attrGet = getActionResetFormTitle
    attrSet = setActionResetFormTitle
    attrConstruct = undefined
    attrClear = clearActionResetFormTitle
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Structs.ActionResetForm.title"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Structs-ActionResetForm.html#g:attr:title"
        })

actionResetForm_title :: AttrLabelProxy "title"
actionResetForm_title = AttrLabelProxy

#endif


-- | Get the value of the “@fields@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' actionResetForm #fields
-- @
getActionResetFormFields :: MonadIO m => ActionResetForm -> m [T.Text]
getActionResetFormFields :: forall (m :: * -> *). MonadIO m => ActionResetForm -> m [Text]
getActionResetFormFields ActionResetForm
s = IO [Text] -> m [Text]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ ActionResetForm -> (Ptr ActionResetForm -> IO [Text]) -> IO [Text]
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionResetForm
s ((Ptr ActionResetForm -> IO [Text]) -> IO [Text])
-> (Ptr ActionResetForm -> IO [Text]) -> IO [Text]
forall a b. (a -> b) -> a -> b
$ \Ptr ActionResetForm
ptr -> do
    Ptr (GList CString)
val <- Ptr (Ptr (GList CString)) -> IO (Ptr (GList CString))
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActionResetForm
ptr Ptr ActionResetForm -> Int -> Ptr (Ptr (GList CString))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO (Ptr (GList CString))
    [CString]
val' <- Ptr (GList CString) -> IO [CString]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList CString)
val
    [Text]
val'' <- (CString -> IO Text) -> [CString] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText [CString]
val'
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
val''

-- | Set the value of the “@fields@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' actionResetForm [ #fields 'Data.GI.Base.Attributes.:=' value ]
-- @
setActionResetFormFields :: MonadIO m => ActionResetForm -> Ptr (GList CString) -> m ()
setActionResetFormFields :: forall (m :: * -> *).
MonadIO m =>
ActionResetForm -> Ptr (GList CString) -> m ()
setActionResetFormFields ActionResetForm
s Ptr (GList CString)
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActionResetForm -> (Ptr ActionResetForm -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionResetForm
s ((Ptr ActionResetForm -> IO ()) -> IO ())
-> (Ptr ActionResetForm -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionResetForm
ptr -> do
    Ptr (Ptr (GList CString)) -> Ptr (GList CString) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionResetForm
ptr Ptr ActionResetForm -> Int -> Ptr (Ptr (GList CString))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (Ptr (GList CString)
val :: Ptr (GList CString))

-- | Set the value of the “@fields@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #fields
-- @
clearActionResetFormFields :: MonadIO m => ActionResetForm -> m ()
clearActionResetFormFields :: forall (m :: * -> *). MonadIO m => ActionResetForm -> m ()
clearActionResetFormFields ActionResetForm
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActionResetForm -> (Ptr ActionResetForm -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionResetForm
s ((Ptr ActionResetForm -> IO ()) -> IO ())
-> (Ptr ActionResetForm -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionResetForm
ptr -> do
    Ptr (Ptr (GList CString)) -> Ptr (GList CString) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionResetForm
ptr Ptr ActionResetForm -> Int -> Ptr (Ptr (GList CString))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (Ptr (GList CString)
forall a. Ptr a
FP.nullPtr :: Ptr (GList CString))

#if defined(ENABLE_OVERLOADING)
data ActionResetFormFieldsFieldInfo
instance AttrInfo ActionResetFormFieldsFieldInfo where
    type AttrBaseTypeConstraint ActionResetFormFieldsFieldInfo = (~) ActionResetForm
    type AttrAllowedOps ActionResetFormFieldsFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ActionResetFormFieldsFieldInfo = (~) (Ptr (GList CString))
    type AttrTransferTypeConstraint ActionResetFormFieldsFieldInfo = (~)(Ptr (GList CString))
    type AttrTransferType ActionResetFormFieldsFieldInfo = (Ptr (GList CString))
    type AttrGetType ActionResetFormFieldsFieldInfo = [T.Text]
    type AttrLabel ActionResetFormFieldsFieldInfo = "fields"
    type AttrOrigin ActionResetFormFieldsFieldInfo = ActionResetForm
    attrGet = getActionResetFormFields
    attrSet = setActionResetFormFields
    attrConstruct = undefined
    attrClear = clearActionResetFormFields
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Structs.ActionResetForm.fields"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Structs-ActionResetForm.html#g:attr:fields"
        })

actionResetForm_fields :: AttrLabelProxy "fields"
actionResetForm_fields = AttrLabelProxy

#endif


-- | Get the value of the “@exclude@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' actionResetForm #exclude
-- @
getActionResetFormExclude :: MonadIO m => ActionResetForm -> m Bool
getActionResetFormExclude :: forall (m :: * -> *). MonadIO m => ActionResetForm -> m Bool
getActionResetFormExclude ActionResetForm
s = IO Bool -> m Bool
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
$ ActionResetForm -> (Ptr ActionResetForm -> IO Bool) -> IO Bool
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionResetForm
s ((Ptr ActionResetForm -> IO Bool) -> IO Bool)
-> (Ptr ActionResetForm -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr ActionResetForm
ptr -> do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActionResetForm
ptr Ptr ActionResetForm -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO CInt
    let val' :: Bool
val' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
val
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
val'

-- | Set the value of the “@exclude@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' actionResetForm [ #exclude 'Data.GI.Base.Attributes.:=' value ]
-- @
setActionResetFormExclude :: MonadIO m => ActionResetForm -> Bool -> m ()
setActionResetFormExclude :: forall (m :: * -> *). MonadIO m => ActionResetForm -> Bool -> m ()
setActionResetFormExclude ActionResetForm
s Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActionResetForm -> (Ptr ActionResetForm -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionResetForm
s ((Ptr ActionResetForm -> IO ()) -> IO ())
-> (Ptr ActionResetForm -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionResetForm
ptr -> do
    let val' :: CInt
val' = (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
val
    Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionResetForm
ptr Ptr ActionResetForm -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (CInt
val' :: CInt)

#if defined(ENABLE_OVERLOADING)
data ActionResetFormExcludeFieldInfo
instance AttrInfo ActionResetFormExcludeFieldInfo where
    type AttrBaseTypeConstraint ActionResetFormExcludeFieldInfo = (~) ActionResetForm
    type AttrAllowedOps ActionResetFormExcludeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ActionResetFormExcludeFieldInfo = (~) Bool
    type AttrTransferTypeConstraint ActionResetFormExcludeFieldInfo = (~)Bool
    type AttrTransferType ActionResetFormExcludeFieldInfo = Bool
    type AttrGetType ActionResetFormExcludeFieldInfo = Bool
    type AttrLabel ActionResetFormExcludeFieldInfo = "exclude"
    type AttrOrigin ActionResetFormExcludeFieldInfo = ActionResetForm
    attrGet = getActionResetFormExclude
    attrSet = setActionResetFormExclude
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Structs.ActionResetForm.exclude"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Structs-ActionResetForm.html#g:attr:exclude"
        })

actionResetForm_exclude :: AttrLabelProxy "exclude"
actionResetForm_exclude = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ActionResetForm
type instance O.AttributeList ActionResetForm = ActionResetFormAttributeList
type ActionResetFormAttributeList = ('[ '("type", ActionResetFormTypeFieldInfo), '("title", ActionResetFormTitleFieldInfo), '("fields", ActionResetFormFieldsFieldInfo), '("exclude", ActionResetFormExcludeFieldInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveActionResetFormMethod (t :: Symbol) (o :: *) :: * where
    ResolveActionResetFormMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif