{-# 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.ActionJavascript
    ( 

-- * Exported types
    ActionJavascript(..)                    ,
    newZeroActionJavascript                 ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveActionJavascriptMethod           ,
#endif




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

#if defined(ENABLE_OVERLOADING)
    actionJavascript_script                 ,
#endif
    clearActionJavascriptScript             ,
    getActionJavascriptScript               ,
    setActionJavascriptScript               ,


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

#if defined(ENABLE_OVERLOADING)
    actionJavascript_title                  ,
#endif
    clearActionJavascriptTitle              ,
    getActionJavascriptTitle                ,
    setActionJavascriptTitle                ,


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

#if defined(ENABLE_OVERLOADING)
    actionJavascript_type                   ,
#endif
    getActionJavascriptType                 ,
    setActionJavascriptType                 ,




    ) 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 ActionJavascript = ActionJavascript (SP.ManagedPtr ActionJavascript)
    deriving (ActionJavascript -> ActionJavascript -> Bool
(ActionJavascript -> ActionJavascript -> Bool)
-> (ActionJavascript -> ActionJavascript -> Bool)
-> Eq ActionJavascript
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionJavascript -> ActionJavascript -> Bool
$c/= :: ActionJavascript -> ActionJavascript -> Bool
== :: ActionJavascript -> ActionJavascript -> Bool
$c== :: ActionJavascript -> ActionJavascript -> Bool
Eq)

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

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


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

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

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

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

actionJavascript_title :: AttrLabelProxy "title"
actionJavascript_title = AttrLabelProxy

#endif


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

-- | Set the value of the “@script@” 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' #script
-- @
clearActionJavascriptScript :: MonadIO m => ActionJavascript -> m ()
clearActionJavascriptScript :: ActionJavascript -> m ()
clearActionJavascriptScript ActionJavascript
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActionJavascript -> (Ptr ActionJavascript -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionJavascript
s ((Ptr ActionJavascript -> IO ()) -> IO ())
-> (Ptr ActionJavascript -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionJavascript
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionJavascript
ptr Ptr ActionJavascript -> 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 ActionJavascriptScriptFieldInfo
instance AttrInfo ActionJavascriptScriptFieldInfo where
    type AttrBaseTypeConstraint ActionJavascriptScriptFieldInfo = (~) ActionJavascript
    type AttrAllowedOps ActionJavascriptScriptFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ActionJavascriptScriptFieldInfo = (~) CString
    type AttrTransferTypeConstraint ActionJavascriptScriptFieldInfo = (~)CString
    type AttrTransferType ActionJavascriptScriptFieldInfo = CString
    type AttrGetType ActionJavascriptScriptFieldInfo = Maybe T.Text
    type AttrLabel ActionJavascriptScriptFieldInfo = "script"
    type AttrOrigin ActionJavascriptScriptFieldInfo = ActionJavascript
    attrGet = getActionJavascriptScript
    attrSet = setActionJavascriptScript
    attrConstruct = undefined
    attrClear = clearActionJavascriptScript
    attrTransfer _ v = do
        return v

actionJavascript_script :: AttrLabelProxy "script"
actionJavascript_script = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ActionJavascript
type instance O.AttributeList ActionJavascript = ActionJavascriptAttributeList
type ActionJavascriptAttributeList = ('[ '("type", ActionJavascriptTypeFieldInfo), '("title", ActionJavascriptTitleFieldInfo), '("script", ActionJavascriptScriptFieldInfo)] :: [(Symbol, *)])
#endif

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

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

#endif