{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- 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.ActionLaunch
    ( 

-- * Exported types
    ActionLaunch(..)                        ,
    newZeroActionLaunch                     ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveActionLaunchMethod               ,
#endif




 -- * Properties
-- ** fileName #attr:fileName#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    actionLaunch_fileName                   ,
#endif
    clearActionLaunchFileName               ,
    getActionLaunchFileName                 ,
    setActionLaunchFileName                 ,


-- ** params #attr:params#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    actionLaunch_params                     ,
#endif
    clearActionLaunchParams                 ,
    getActionLaunchParams                   ,
    setActionLaunchParams                   ,


-- ** title #attr:title#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    actionLaunch_title                      ,
#endif
    clearActionLaunchTitle                  ,
    getActionLaunchTitle                    ,
    setActionLaunchTitle                    ,


-- ** type #attr:type#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    actionLaunch_type                       ,
#endif
    getActionLaunchType                     ,
    setActionLaunchType                     ,




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

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

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

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


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

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

#if defined(ENABLE_OVERLOADING)
data ActionLaunchTypeFieldInfo
instance AttrInfo ActionLaunchTypeFieldInfo where
    type AttrBaseTypeConstraint ActionLaunchTypeFieldInfo = (~) ActionLaunch
    type AttrAllowedOps ActionLaunchTypeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ActionLaunchTypeFieldInfo = (~) Poppler.Enums.ActionType
    type AttrTransferTypeConstraint ActionLaunchTypeFieldInfo = (~)Poppler.Enums.ActionType
    type AttrTransferType ActionLaunchTypeFieldInfo = Poppler.Enums.ActionType
    type AttrGetType ActionLaunchTypeFieldInfo = Poppler.Enums.ActionType
    type AttrLabel ActionLaunchTypeFieldInfo = "type"
    type AttrOrigin ActionLaunchTypeFieldInfo = ActionLaunch
    attrGet = getActionLaunchType
    attrSet = setActionLaunchType
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

actionLaunch_type :: AttrLabelProxy "type"
actionLaunch_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' actionLaunch #title
-- @
getActionLaunchTitle :: MonadIO m => ActionLaunch -> m (Maybe T.Text)
getActionLaunchTitle :: ActionLaunch -> m (Maybe Text)
getActionLaunchTitle ActionLaunch
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
$ ActionLaunch
-> (Ptr ActionLaunch -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionLaunch
s ((Ptr ActionLaunch -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr ActionLaunch -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr ActionLaunch
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActionLaunch
ptr Ptr ActionLaunch -> 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' actionLaunch [ #title 'Data.GI.Base.Attributes.:=' value ]
-- @
setActionLaunchTitle :: MonadIO m => ActionLaunch -> CString -> m ()
setActionLaunchTitle :: ActionLaunch -> CString -> m ()
setActionLaunchTitle ActionLaunch
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
$ ActionLaunch -> (Ptr ActionLaunch -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionLaunch
s ((Ptr ActionLaunch -> IO ()) -> IO ())
-> (Ptr ActionLaunch -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionLaunch
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionLaunch
ptr Ptr ActionLaunch -> 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
-- @
clearActionLaunchTitle :: MonadIO m => ActionLaunch -> m ()
clearActionLaunchTitle :: ActionLaunch -> m ()
clearActionLaunchTitle ActionLaunch
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActionLaunch -> (Ptr ActionLaunch -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionLaunch
s ((Ptr ActionLaunch -> IO ()) -> IO ())
-> (Ptr ActionLaunch -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionLaunch
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionLaunch
ptr Ptr ActionLaunch -> 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 ActionLaunchTitleFieldInfo
instance AttrInfo ActionLaunchTitleFieldInfo where
    type AttrBaseTypeConstraint ActionLaunchTitleFieldInfo = (~) ActionLaunch
    type AttrAllowedOps ActionLaunchTitleFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ActionLaunchTitleFieldInfo = (~) CString
    type AttrTransferTypeConstraint ActionLaunchTitleFieldInfo = (~)CString
    type AttrTransferType ActionLaunchTitleFieldInfo = CString
    type AttrGetType ActionLaunchTitleFieldInfo = Maybe T.Text
    type AttrLabel ActionLaunchTitleFieldInfo = "title"
    type AttrOrigin ActionLaunchTitleFieldInfo = ActionLaunch
    attrGet = getActionLaunchTitle
    attrSet = setActionLaunchTitle
    attrConstruct = undefined
    attrClear = clearActionLaunchTitle
    attrTransfer _ v = do
        return v

actionLaunch_title :: AttrLabelProxy "title"
actionLaunch_title = AttrLabelProxy

#endif


-- | Get the value of the “@file_name@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' actionLaunch #fileName
-- @
getActionLaunchFileName :: MonadIO m => ActionLaunch -> m (Maybe T.Text)
getActionLaunchFileName :: ActionLaunch -> m (Maybe Text)
getActionLaunchFileName ActionLaunch
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
$ ActionLaunch
-> (Ptr ActionLaunch -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionLaunch
s ((Ptr ActionLaunch -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr ActionLaunch -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr ActionLaunch
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActionLaunch
ptr Ptr ActionLaunch -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: 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 “@file_name@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' actionLaunch [ #fileName 'Data.GI.Base.Attributes.:=' value ]
-- @
setActionLaunchFileName :: MonadIO m => ActionLaunch -> CString -> m ()
setActionLaunchFileName :: ActionLaunch -> CString -> m ()
setActionLaunchFileName ActionLaunch
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
$ ActionLaunch -> (Ptr ActionLaunch -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionLaunch
s ((Ptr ActionLaunch -> IO ()) -> IO ())
-> (Ptr ActionLaunch -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionLaunch
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionLaunch
ptr Ptr ActionLaunch -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (CString
val :: CString)

-- | Set the value of the “@file_name@” 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' #fileName
-- @
clearActionLaunchFileName :: MonadIO m => ActionLaunch -> m ()
clearActionLaunchFileName :: ActionLaunch -> m ()
clearActionLaunchFileName ActionLaunch
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActionLaunch -> (Ptr ActionLaunch -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionLaunch
s ((Ptr ActionLaunch -> IO ()) -> IO ())
-> (Ptr ActionLaunch -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionLaunch
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionLaunch
ptr Ptr ActionLaunch -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data ActionLaunchFileNameFieldInfo
instance AttrInfo ActionLaunchFileNameFieldInfo where
    type AttrBaseTypeConstraint ActionLaunchFileNameFieldInfo = (~) ActionLaunch
    type AttrAllowedOps ActionLaunchFileNameFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ActionLaunchFileNameFieldInfo = (~) CString
    type AttrTransferTypeConstraint ActionLaunchFileNameFieldInfo = (~)CString
    type AttrTransferType ActionLaunchFileNameFieldInfo = CString
    type AttrGetType ActionLaunchFileNameFieldInfo = Maybe T.Text
    type AttrLabel ActionLaunchFileNameFieldInfo = "file_name"
    type AttrOrigin ActionLaunchFileNameFieldInfo = ActionLaunch
    attrGet = getActionLaunchFileName
    attrSet = setActionLaunchFileName
    attrConstruct = undefined
    attrClear = clearActionLaunchFileName
    attrTransfer _ v = do
        return v

actionLaunch_fileName :: AttrLabelProxy "fileName"
actionLaunch_fileName = AttrLabelProxy

#endif


-- | Get the value of the “@params@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' actionLaunch #params
-- @
getActionLaunchParams :: MonadIO m => ActionLaunch -> m (Maybe T.Text)
getActionLaunchParams :: ActionLaunch -> m (Maybe Text)
getActionLaunchParams ActionLaunch
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
$ ActionLaunch
-> (Ptr ActionLaunch -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionLaunch
s ((Ptr ActionLaunch -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr ActionLaunch -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr ActionLaunch
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActionLaunch
ptr Ptr ActionLaunch -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: 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 “@params@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' actionLaunch [ #params 'Data.GI.Base.Attributes.:=' value ]
-- @
setActionLaunchParams :: MonadIO m => ActionLaunch -> CString -> m ()
setActionLaunchParams :: ActionLaunch -> CString -> m ()
setActionLaunchParams ActionLaunch
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
$ ActionLaunch -> (Ptr ActionLaunch -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionLaunch
s ((Ptr ActionLaunch -> IO ()) -> IO ())
-> (Ptr ActionLaunch -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionLaunch
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionLaunch
ptr Ptr ActionLaunch -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (CString
val :: CString)

-- | Set the value of the “@params@” 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' #params
-- @
clearActionLaunchParams :: MonadIO m => ActionLaunch -> m ()
clearActionLaunchParams :: ActionLaunch -> m ()
clearActionLaunchParams ActionLaunch
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActionLaunch -> (Ptr ActionLaunch -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionLaunch
s ((Ptr ActionLaunch -> IO ()) -> IO ())
-> (Ptr ActionLaunch -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionLaunch
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionLaunch
ptr Ptr ActionLaunch -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data ActionLaunchParamsFieldInfo
instance AttrInfo ActionLaunchParamsFieldInfo where
    type AttrBaseTypeConstraint ActionLaunchParamsFieldInfo = (~) ActionLaunch
    type AttrAllowedOps ActionLaunchParamsFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ActionLaunchParamsFieldInfo = (~) CString
    type AttrTransferTypeConstraint ActionLaunchParamsFieldInfo = (~)CString
    type AttrTransferType ActionLaunchParamsFieldInfo = CString
    type AttrGetType ActionLaunchParamsFieldInfo = Maybe T.Text
    type AttrLabel ActionLaunchParamsFieldInfo = "params"
    type AttrOrigin ActionLaunchParamsFieldInfo = ActionLaunch
    attrGet = getActionLaunchParams
    attrSet = setActionLaunchParams
    attrConstruct = undefined
    attrClear = clearActionLaunchParams
    attrTransfer _ v = do
        return v

actionLaunch_params :: AttrLabelProxy "params"
actionLaunch_params = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ActionLaunch
type instance O.AttributeList ActionLaunch = ActionLaunchAttributeList
type ActionLaunchAttributeList = ('[ '("type", ActionLaunchTypeFieldInfo), '("title", ActionLaunchTitleFieldInfo), '("fileName", ActionLaunchFileNameFieldInfo), '("params", ActionLaunchParamsFieldInfo)] :: [(Symbol, *)])
#endif

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

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

#endif