{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)
-}

module GI.Poppler.Structs.ActionLaunch
    ( 

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


 -- * Properties
-- ** fileName #attr:fileName#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    actionLaunch_fileName                   ,
#endif
    clearActionLaunchFileName               ,
    getActionLaunchFileName                 ,
    setActionLaunchFileName                 ,


-- ** params #attr:params#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    actionLaunch_params                     ,
#endif
    clearActionLaunchParams                 ,
    getActionLaunchParams                   ,
    setActionLaunchParams                   ,


-- ** title #attr:title#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    actionLaunch_title                      ,
#endif
    clearActionLaunchTitle                  ,
    getActionLaunchTitle                    ,
    setActionLaunchTitle                    ,


-- ** type #attr:type#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
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 {-# SOURCE #-} qualified GI.Poppler.Enums as Poppler.Enums

newtype ActionLaunch = ActionLaunch (ManagedPtr ActionLaunch)
instance WrappedPtr ActionLaunch where
    wrappedPtrCalloc = callocBytes 32
    wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 32 >=> wrapPtr ActionLaunch)
    wrappedPtrFree = Just ptr_to_g_free

-- | Construct a `ActionLaunch` struct initialized to zero.
newZeroActionLaunch :: MonadIO m => m ActionLaunch
newZeroActionLaunch = liftIO $ wrappedPtrCalloc >>= wrapPtr ActionLaunch

instance tag ~ 'AttrSet => Constructible ActionLaunch tag where
    new _ attrs = do
        o <- newZeroActionLaunch
        GI.Attributes.set o attrs
        return o


noActionLaunch :: Maybe ActionLaunch
noActionLaunch = Nothing

getActionLaunchType :: MonadIO m => ActionLaunch -> m Poppler.Enums.ActionType
getActionLaunchType s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO CUInt
    let val' = (toEnum . fromIntegral) val
    return val'

setActionLaunchType :: MonadIO m => ActionLaunch -> Poppler.Enums.ActionType -> m ()
setActionLaunchType s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = (fromIntegral . fromEnum) val
    poke (ptr `plusPtr` 0) (val' :: CUInt)

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

actionLaunch_type :: AttrLabelProxy "type"
actionLaunch_type = AttrLabelProxy

#endif


getActionLaunchTitle :: MonadIO m => ActionLaunch -> m (Maybe T.Text)
getActionLaunchTitle s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return result

setActionLaunchTitle :: MonadIO m => ActionLaunch -> CString -> m ()
setActionLaunchTitle s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (val :: CString)

clearActionLaunchTitle :: MonadIO m => ActionLaunch -> m ()
clearActionLaunchTitle s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data ActionLaunchTitleFieldInfo
instance AttrInfo ActionLaunchTitleFieldInfo where
    type AttrAllowedOps ActionLaunchTitleFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ActionLaunchTitleFieldInfo = (~) CString
    type AttrBaseTypeConstraint ActionLaunchTitleFieldInfo = (~) ActionLaunch
    type AttrGetType ActionLaunchTitleFieldInfo = Maybe T.Text
    type AttrLabel ActionLaunchTitleFieldInfo = "title"
    type AttrOrigin ActionLaunchTitleFieldInfo = ActionLaunch
    attrGet _ = getActionLaunchTitle
    attrSet _ = setActionLaunchTitle
    attrConstruct = undefined
    attrClear _ = clearActionLaunchTitle

actionLaunch_title :: AttrLabelProxy "title"
actionLaunch_title = AttrLabelProxy

#endif


getActionLaunchFileName :: MonadIO m => ActionLaunch -> m (Maybe T.Text)
getActionLaunchFileName s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return result

setActionLaunchFileName :: MonadIO m => ActionLaunch -> CString -> m ()
setActionLaunchFileName s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (val :: CString)

clearActionLaunchFileName :: MonadIO m => ActionLaunch -> m ()
clearActionLaunchFileName s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (FP.nullPtr :: CString)

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

actionLaunch_fileName :: AttrLabelProxy "fileName"
actionLaunch_fileName = AttrLabelProxy

#endif


getActionLaunchParams :: MonadIO m => ActionLaunch -> m (Maybe T.Text)
getActionLaunchParams s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 24) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return result

setActionLaunchParams :: MonadIO m => ActionLaunch -> CString -> m ()
setActionLaunchParams s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 24) (val :: CString)

clearActionLaunchParams :: MonadIO m => ActionLaunch -> m ()
clearActionLaunchParams s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 24) (FP.nullPtr :: CString)

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

actionLaunch_params :: AttrLabelProxy "params"
actionLaunch_params = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
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) && !defined(__HADDOCK_VERSION__)
type family ResolveActionLaunchMethod (t :: Symbol) (o :: *) :: * where
    ResolveActionLaunchMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveActionLaunchMethod t ActionLaunch, O.MethodInfo info ActionLaunch p) => O.IsLabelProxy t (ActionLaunch -> p) where
    fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)

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

#endif