{-# 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.WebKit2.Structs.UserScript
    ( 

-- * Exported types
    UserScript(..)                          ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [ref]("GI.WebKit2.Structs.UserScript#g:method:ref"), [unref]("GI.WebKit2.Structs.UserScript#g:method:unref").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveUserScriptMethod                 ,
#endif

-- ** new #method:new#

    userScriptNew                           ,


-- ** newForWorld #method:newForWorld#

    userScriptNewForWorld                   ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    UserScriptRefMethodInfo                 ,
#endif
    userScriptRef                           ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    UserScriptUnrefMethodInfo               ,
#endif
    userScriptUnref                         ,




    ) 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.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.WebKit2.Enums as WebKit2.Enums

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

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

foreign import ccall "webkit_user_script_get_type" c_webkit_user_script_get_type :: 
    IO GType

type instance O.ParentTypes UserScript = '[]
instance O.HasParentTypes UserScript

instance B.Types.TypedObject UserScript where
    glibType :: IO GType
glibType = IO GType
c_webkit_user_script_get_type

instance B.Types.GBoxed UserScript

-- | Convert 'UserScript' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe UserScript) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_webkit_user_script_get_type
    gvalueSet_ :: Ptr GValue -> Maybe UserScript -> IO ()
gvalueSet_ Ptr GValue
gv Maybe UserScript
P.Nothing = Ptr GValue -> Ptr UserScript -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr UserScript
forall a. Ptr a
FP.nullPtr :: FP.Ptr UserScript)
    gvalueSet_ Ptr GValue
gv (P.Just UserScript
obj) = UserScript -> (Ptr UserScript -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr UserScript
obj (Ptr GValue -> Ptr UserScript -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe UserScript)
gvalueGet_ Ptr GValue
gv = do
        Ptr UserScript
ptr <- Ptr GValue -> IO (Ptr UserScript)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr UserScript)
        if Ptr UserScript
ptr Ptr UserScript -> Ptr UserScript -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr UserScript
forall a. Ptr a
FP.nullPtr
        then UserScript -> Maybe UserScript
forall a. a -> Maybe a
P.Just (UserScript -> Maybe UserScript)
-> IO UserScript -> IO (Maybe UserScript)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr UserScript -> UserScript)
-> Ptr UserScript -> IO UserScript
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr UserScript -> UserScript
UserScript Ptr UserScript
ptr
        else Maybe UserScript -> IO (Maybe UserScript)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe UserScript
forall a. Maybe a
P.Nothing
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList UserScript
type instance O.AttributeList UserScript = UserScriptAttributeList
type UserScriptAttributeList = ('[ ] :: [(Symbol, *)])
#endif

-- method UserScript::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "source"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Source code of the user script."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "injected_frames"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "UserContentInjectedFrames" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitUserContentInjectedFrames value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "injection_time"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "UserScriptInjectionTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitUserScriptInjectionTime value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "allow_list"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An allow_list of URI patterns or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "block_list"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A block_list of URI patterns or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "WebKit2" , name = "UserScript" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_user_script_new" webkit_user_script_new :: 
    CString ->                              -- source : TBasicType TUTF8
    CUInt ->                                -- injected_frames : TInterface (Name {namespace = "WebKit2", name = "UserContentInjectedFrames"})
    CUInt ->                                -- injection_time : TInterface (Name {namespace = "WebKit2", name = "UserScriptInjectionTime"})
    Ptr CString ->                          -- allow_list : TCArray True (-1) (-1) (TBasicType TUTF8)
    Ptr CString ->                          -- block_list : TCArray True (-1) (-1) (TBasicType TUTF8)
    IO (Ptr UserScript)

-- | Creates a new user script. Scripts can be applied to some URIs
-- only by passing non-null values for /@allowList@/ or /@blockList@/. Passing a
-- 'P.Nothing' allow_list implies that all URIs are on the allow_list. The script
-- is applied if an URI matches the allow_list and not the block_list.
-- URI patterns must be of the form @[protocol]:\/\/[host]\/[path]@, where the
-- *host* and *path* components can contain the wildcard character (@*@) to
-- represent zero or more other characters.
-- 
-- /Since: 2.6/
userScriptNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@source@/: Source code of the user script.
    -> WebKit2.Enums.UserContentInjectedFrames
    -- ^ /@injectedFrames@/: A t'GI.WebKit2.Enums.UserContentInjectedFrames' value
    -> WebKit2.Enums.UserScriptInjectionTime
    -- ^ /@injectionTime@/: A t'GI.WebKit2.Enums.UserScriptInjectionTime' value
    -> Maybe ([T.Text])
    -- ^ /@allowList@/: An allow_list of URI patterns or 'P.Nothing'
    -> Maybe ([T.Text])
    -- ^ /@blockList@/: A block_list of URI patterns or 'P.Nothing'
    -> m UserScript
    -- ^ __Returns:__ A new t'GI.WebKit2.Structs.UserScript.UserScript'
userScriptNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text
-> UserContentInjectedFrames
-> UserScriptInjectionTime
-> Maybe [Text]
-> Maybe [Text]
-> m UserScript
userScriptNew Text
source UserContentInjectedFrames
injectedFrames UserScriptInjectionTime
injectionTime Maybe [Text]
allowList Maybe [Text]
blockList = IO UserScript -> m UserScript
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserScript -> m UserScript) -> IO UserScript -> m UserScript
forall a b. (a -> b) -> a -> b
$ do
    CString
source' <- Text -> IO CString
textToCString Text
source
    let injectedFrames' :: CUInt
injectedFrames' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (UserContentInjectedFrames -> Int)
-> UserContentInjectedFrames
-> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserContentInjectedFrames -> Int
forall a. Enum a => a -> Int
fromEnum) UserContentInjectedFrames
injectedFrames
    let injectionTime' :: CUInt
injectionTime' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (UserScriptInjectionTime -> Int)
-> UserScriptInjectionTime
-> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserScriptInjectionTime -> Int
forall a. Enum a => a -> Int
fromEnum) UserScriptInjectionTime
injectionTime
    Ptr CString
maybeAllowList <- case Maybe [Text]
allowList of
        Maybe [Text]
Nothing -> Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just [Text]
jAllowList -> do
            Ptr CString
jAllowList' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
jAllowList
            Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jAllowList'
    Ptr CString
maybeBlockList <- case Maybe [Text]
blockList of
        Maybe [Text]
Nothing -> Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just [Text]
jBlockList -> do
            Ptr CString
jBlockList' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
jBlockList
            Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jBlockList'
    Ptr UserScript
result <- CString
-> CUInt
-> CUInt
-> Ptr CString
-> Ptr CString
-> IO (Ptr UserScript)
webkit_user_script_new CString
source' CUInt
injectedFrames' CUInt
injectionTime' Ptr CString
maybeAllowList Ptr CString
maybeBlockList
    Text -> Ptr UserScript -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"userScriptNew" Ptr UserScript
result
    UserScript
result' <- ((ManagedPtr UserScript -> UserScript)
-> Ptr UserScript -> IO UserScript
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr UserScript -> UserScript
UserScript) Ptr UserScript
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
source'
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeAllowList
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeAllowList
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeBlockList
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeBlockList
    UserScript -> IO UserScript
forall (m :: * -> *) a. Monad m => a -> m a
return UserScript
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method UserScript::new_for_world
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "source"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Source code of the user script."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "injected_frames"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "UserContentInjectedFrames" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitUserContentInjectedFrames value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "injection_time"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "UserScriptInjectionTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitUserScriptInjectionTime value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "world_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a #WebKitScriptWorld"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "allow_list"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An allow_list of URI patterns or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "block_list"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A block_list of URI patterns or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "WebKit2" , name = "UserScript" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_user_script_new_for_world" webkit_user_script_new_for_world :: 
    CString ->                              -- source : TBasicType TUTF8
    CUInt ->                                -- injected_frames : TInterface (Name {namespace = "WebKit2", name = "UserContentInjectedFrames"})
    CUInt ->                                -- injection_time : TInterface (Name {namespace = "WebKit2", name = "UserScriptInjectionTime"})
    CString ->                              -- world_name : TBasicType TUTF8
    Ptr CString ->                          -- allow_list : TCArray True (-1) (-1) (TBasicType TUTF8)
    Ptr CString ->                          -- block_list : TCArray True (-1) (-1) (TBasicType TUTF8)
    IO (Ptr UserScript)

-- | Creates a new user script for script world with name /@worldName@/.
-- See 'GI.WebKit2.Structs.UserScript.userScriptNew' for a full description.
-- 
-- /Since: 2.22/
userScriptNewForWorld ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@source@/: Source code of the user script.
    -> WebKit2.Enums.UserContentInjectedFrames
    -- ^ /@injectedFrames@/: A t'GI.WebKit2.Enums.UserContentInjectedFrames' value
    -> WebKit2.Enums.UserScriptInjectionTime
    -- ^ /@injectionTime@/: A t'GI.WebKit2.Enums.UserScriptInjectionTime' value
    -> T.Text
    -- ^ /@worldName@/: the name of a @/WebKitScriptWorld/@
    -> Maybe ([T.Text])
    -- ^ /@allowList@/: An allow_list of URI patterns or 'P.Nothing'
    -> Maybe ([T.Text])
    -- ^ /@blockList@/: A block_list of URI patterns or 'P.Nothing'
    -> m UserScript
    -- ^ __Returns:__ A new t'GI.WebKit2.Structs.UserScript.UserScript'
userScriptNewForWorld :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text
-> UserContentInjectedFrames
-> UserScriptInjectionTime
-> Text
-> Maybe [Text]
-> Maybe [Text]
-> m UserScript
userScriptNewForWorld Text
source UserContentInjectedFrames
injectedFrames UserScriptInjectionTime
injectionTime Text
worldName Maybe [Text]
allowList Maybe [Text]
blockList = IO UserScript -> m UserScript
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserScript -> m UserScript) -> IO UserScript -> m UserScript
forall a b. (a -> b) -> a -> b
$ do
    CString
source' <- Text -> IO CString
textToCString Text
source
    let injectedFrames' :: CUInt
injectedFrames' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (UserContentInjectedFrames -> Int)
-> UserContentInjectedFrames
-> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserContentInjectedFrames -> Int
forall a. Enum a => a -> Int
fromEnum) UserContentInjectedFrames
injectedFrames
    let injectionTime' :: CUInt
injectionTime' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (UserScriptInjectionTime -> Int)
-> UserScriptInjectionTime
-> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserScriptInjectionTime -> Int
forall a. Enum a => a -> Int
fromEnum) UserScriptInjectionTime
injectionTime
    CString
worldName' <- Text -> IO CString
textToCString Text
worldName
    Ptr CString
maybeAllowList <- case Maybe [Text]
allowList of
        Maybe [Text]
Nothing -> Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just [Text]
jAllowList -> do
            Ptr CString
jAllowList' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
jAllowList
            Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jAllowList'
    Ptr CString
maybeBlockList <- case Maybe [Text]
blockList of
        Maybe [Text]
Nothing -> Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just [Text]
jBlockList -> do
            Ptr CString
jBlockList' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
jBlockList
            Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jBlockList'
    Ptr UserScript
result <- CString
-> CUInt
-> CUInt
-> CString
-> Ptr CString
-> Ptr CString
-> IO (Ptr UserScript)
webkit_user_script_new_for_world CString
source' CUInt
injectedFrames' CUInt
injectionTime' CString
worldName' Ptr CString
maybeAllowList Ptr CString
maybeBlockList
    Text -> Ptr UserScript -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"userScriptNewForWorld" Ptr UserScript
result
    UserScript
result' <- ((ManagedPtr UserScript -> UserScript)
-> Ptr UserScript -> IO UserScript
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr UserScript -> UserScript
UserScript) Ptr UserScript
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
source'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
worldName'
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeAllowList
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeAllowList
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeBlockList
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeBlockList
    UserScript -> IO UserScript
forall (m :: * -> *) a. Monad m => a -> m a
return UserScript
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method UserScript::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "user_script"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "UserScript" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitUserScript"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "WebKit2" , name = "UserScript" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_user_script_ref" webkit_user_script_ref :: 
    Ptr UserScript ->                       -- user_script : TInterface (Name {namespace = "WebKit2", name = "UserScript"})
    IO (Ptr UserScript)

-- | Atomically increments the reference count of /@userScript@/ by one.
-- This function is MT-safe and may be called from any thread.
-- 
-- /Since: 2.6/
userScriptRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UserScript
    -- ^ /@userScript@/: a t'GI.WebKit2.Structs.UserScript.UserScript'
    -> m UserScript
    -- ^ __Returns:__ The passed t'GI.WebKit2.Structs.UserScript.UserScript'
userScriptRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UserScript -> m UserScript
userScriptRef UserScript
userScript = IO UserScript -> m UserScript
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserScript -> m UserScript) -> IO UserScript -> m UserScript
forall a b. (a -> b) -> a -> b
$ do
    Ptr UserScript
userScript' <- UserScript -> IO (Ptr UserScript)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UserScript
userScript
    Ptr UserScript
result <- Ptr UserScript -> IO (Ptr UserScript)
webkit_user_script_ref Ptr UserScript
userScript'
    Text -> Ptr UserScript -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"userScriptRef" Ptr UserScript
result
    UserScript
result' <- ((ManagedPtr UserScript -> UserScript)
-> Ptr UserScript -> IO UserScript
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr UserScript -> UserScript
UserScript) Ptr UserScript
result
    UserScript -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr UserScript
userScript
    UserScript -> IO UserScript
forall (m :: * -> *) a. Monad m => a -> m a
return UserScript
result'

#if defined(ENABLE_OVERLOADING)
data UserScriptRefMethodInfo
instance (signature ~ (m UserScript), MonadIO m) => O.OverloadedMethod UserScriptRefMethodInfo UserScript signature where
    overloadedMethod = userScriptRef

instance O.OverloadedMethodInfo UserScriptRefMethodInfo UserScript where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Structs.UserScript.userScriptRef",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Structs-UserScript.html#v:userScriptRef"
        }


#endif

-- method UserScript::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "user_script"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "UserScript" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitUserScript"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_user_script_unref" webkit_user_script_unref :: 
    Ptr UserScript ->                       -- user_script : TInterface (Name {namespace = "WebKit2", name = "UserScript"})
    IO ()

-- | Atomically decrements the reference count of /@userScript@/ by one.
-- If the reference count drops to 0, all memory allocated by
-- t'GI.WebKit2.Structs.UserScript.UserScript' is released. This function is MT-safe and may be called
-- from any thread.
-- 
-- /Since: 2.6/
userScriptUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UserScript
    -- ^ /@userScript@/: a t'GI.WebKit2.Structs.UserScript.UserScript'
    -> m ()
userScriptUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UserScript -> m ()
userScriptUnref UserScript
userScript = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr UserScript
userScript' <- UserScript -> IO (Ptr UserScript)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UserScript
userScript
    Ptr UserScript -> IO ()
webkit_user_script_unref Ptr UserScript
userScript'
    UserScript -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr UserScript
userScript
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data UserScriptUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod UserScriptUnrefMethodInfo UserScript signature where
    overloadedMethod = userScriptUnref

instance O.OverloadedMethodInfo UserScriptUnrefMethodInfo UserScript where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Structs.UserScript.userScriptUnref",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Structs-UserScript.html#v:userScriptUnref"
        }


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveUserScriptMethod (t :: Symbol) (o :: *) :: * where
    ResolveUserScriptMethod "ref" o = UserScriptRefMethodInfo
    ResolveUserScriptMethod "unref" o = UserScriptUnrefMethodInfo
    ResolveUserScriptMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif