{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Fields common to all t'GI.Poppler.Unions.Action.Action's

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

module GI.Poppler.Structs.ActionAny
    ( 

-- * Exported types
    ActionAny(..)                           ,
    newZeroActionAny                        ,


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolveActionAnyMethod                  ,
#endif



 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    actionAny_title                         ,
#endif
    clearActionAnyTitle                     ,
    getActionAnyTitle                       ,
    setActionAnyTitle                       ,


-- ** type #attr:type#
-- | action type

#if defined(ENABLE_OVERLOADING)
    actionAny_type                          ,
#endif
    getActionAnyType                        ,
    setActionAnyType                        ,




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

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

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

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


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

instance tag ~ 'AttrSet => Constructible ActionAny tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr ActionAny -> ActionAny)
-> [AttrOp ActionAny tag] -> m ActionAny
new ManagedPtr ActionAny -> ActionAny
_ [AttrOp ActionAny tag]
attrs = do
        ActionAny
o <- m ActionAny
forall (m :: * -> *). MonadIO m => m ActionAny
newZeroActionAny
        ActionAny -> [AttrOp ActionAny 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set ActionAny
o [AttrOp ActionAny tag]
[AttrOp ActionAny 'AttrSet]
attrs
        ActionAny -> m ActionAny
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ActionAny
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' actionAny #type
-- @
getActionAnyType :: MonadIO m => ActionAny -> m Poppler.Enums.ActionType
getActionAnyType :: forall (m :: * -> *). MonadIO m => ActionAny -> m ActionType
getActionAnyType ActionAny
s = IO ActionType -> m ActionType
forall a. IO a -> m a
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
$ ActionAny -> (Ptr ActionAny -> IO ActionType) -> IO ActionType
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionAny
s ((Ptr ActionAny -> IO ActionType) -> IO ActionType)
-> (Ptr ActionAny -> IO ActionType) -> IO ActionType
forall a b. (a -> b) -> a -> b
$ \Ptr ActionAny
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActionAny
ptr Ptr ActionAny -> 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 a. a -> IO a
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' actionAny [ #type 'Data.GI.Base.Attributes.:=' value ]
-- @
setActionAnyType :: MonadIO m => ActionAny -> Poppler.Enums.ActionType -> m ()
setActionAnyType :: forall (m :: * -> *). MonadIO m => ActionAny -> ActionType -> m ()
setActionAnyType ActionAny
s ActionType
val = 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
$ ActionAny -> (Ptr ActionAny -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionAny
s ((Ptr ActionAny -> IO ()) -> IO ())
-> (Ptr ActionAny -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionAny
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 ActionAny
ptr Ptr ActionAny -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CUInt
val' :: CUInt)

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

actionAny_type :: AttrLabelProxy "type"
actionAny_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' actionAny #title
-- @
getActionAnyTitle :: MonadIO m => ActionAny -> m (Maybe T.Text)
getActionAnyTitle :: forall (m :: * -> *). MonadIO m => ActionAny -> m (Maybe Text)
getActionAnyTitle ActionAny
s = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
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
$ ActionAny -> (Ptr ActionAny -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionAny
s ((Ptr ActionAny -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr ActionAny -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr ActionAny
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActionAny
ptr Ptr ActionAny -> 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
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' actionAny [ #title 'Data.GI.Base.Attributes.:=' value ]
-- @
setActionAnyTitle :: MonadIO m => ActionAny -> CString -> m ()
setActionAnyTitle :: forall (m :: * -> *). MonadIO m => ActionAny -> CString -> m ()
setActionAnyTitle ActionAny
s CString
val = 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
$ ActionAny -> (Ptr ActionAny -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionAny
s ((Ptr ActionAny -> IO ()) -> IO ())
-> (Ptr ActionAny -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionAny
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionAny
ptr Ptr ActionAny -> 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
-- @
clearActionAnyTitle :: MonadIO m => ActionAny -> m ()
clearActionAnyTitle :: forall (m :: * -> *). MonadIO m => ActionAny -> m ()
clearActionAnyTitle ActionAny
s = 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
$ ActionAny -> (Ptr ActionAny -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionAny
s ((Ptr ActionAny -> IO ()) -> IO ())
-> (Ptr ActionAny -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionAny
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionAny
ptr Ptr ActionAny -> 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 ActionAnyTitleFieldInfo
instance AttrInfo ActionAnyTitleFieldInfo where
    type AttrBaseTypeConstraint ActionAnyTitleFieldInfo = (~) ActionAny
    type AttrAllowedOps ActionAnyTitleFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ActionAnyTitleFieldInfo = (~) CString
    type AttrTransferTypeConstraint ActionAnyTitleFieldInfo = (~)CString
    type AttrTransferType ActionAnyTitleFieldInfo = CString
    type AttrGetType ActionAnyTitleFieldInfo = Maybe T.Text
    type AttrLabel ActionAnyTitleFieldInfo = "title"
    type AttrOrigin ActionAnyTitleFieldInfo = ActionAny
    attrGet = getActionAnyTitle
    attrSet = setActionAnyTitle
    attrConstruct = undefined
    attrClear = clearActionAnyTitle
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Structs.ActionAny.title"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.27/docs/GI-Poppler-Structs-ActionAny.html#g:attr:title"
        })

actionAny_title :: AttrLabelProxy "title"
actionAny_title = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ActionAny
type instance O.AttributeList ActionAny = ActionAnyAttributeList
type ActionAnyAttributeList = ('[ '("type", ActionAnyTypeFieldInfo), '("title", ActionAnyTitleFieldInfo)] :: [(Symbol, *)])
#endif

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

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

#endif

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

#endif