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

-- * Exported types
    UserScript(..)                          ,
    noUserScript                            ,


 -- * Methods
-- ** new #method:new#
    userScriptNew                           ,


-- ** ref #method:ref#
    UserScriptRefMethodInfo                 ,
    userScriptRef                           ,


-- ** unref #method:unref#
    UserScriptUnrefMethodInfo               ,
    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.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.WebKit2.Enums as WebKit2.Enums

newtype UserScript = UserScript (ManagedPtr UserScript)
foreign import ccall "webkit_user_script_get_type" c_webkit_user_script_get_type :: 
    IO GType

instance BoxedObject UserScript where
    boxedType _ = c_webkit_user_script_get_type

noUserScript :: Maybe UserScript
noUserScript = Nothing


instance O.HasAttributeList UserScript
type instance O.AttributeList UserScript = UserScriptAttributeList
type UserScriptAttributeList = ('[ ] :: [(Symbol, *)])

-- 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 = "whitelist", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "A whitelist of URI patterns or %NULL", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "blacklist", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "A blacklist 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 ->                          -- whitelist : TCArray True (-1) (-1) (TBasicType TUTF8)
    Ptr CString ->                          -- blacklist : 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 /@whitelist@/ or /@blacklist@/. Passing a
'Nothing' whitelist implies that all URIs are on the whitelist. The script
is applied if an URI matches the whitelist and not the blacklist.
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 'GI.WebKit2.Enums.UserContentInjectedFrames' value -}
    -> WebKit2.Enums.UserScriptInjectionTime
    {- ^ /@injectionTime@/: A 'GI.WebKit2.Enums.UserScriptInjectionTime' value -}
    -> Maybe ([T.Text])
    {- ^ /@whitelist@/: A whitelist of URI patterns or 'Nothing' -}
    -> Maybe ([T.Text])
    {- ^ /@blacklist@/: A blacklist of URI patterns or 'Nothing' -}
    -> m UserScript
    {- ^ __Returns:__ A new 'GI.WebKit2.Structs.UserScript.UserScript' -}
userScriptNew source injectedFrames injectionTime whitelist blacklist = liftIO $ do
    source' <- textToCString source
    let injectedFrames' = (fromIntegral . fromEnum) injectedFrames
    let injectionTime' = (fromIntegral . fromEnum) injectionTime
    maybeWhitelist <- case whitelist of
        Nothing -> return nullPtr
        Just jWhitelist -> do
            jWhitelist' <- packZeroTerminatedUTF8CArray jWhitelist
            return jWhitelist'
    maybeBlacklist <- case blacklist of
        Nothing -> return nullPtr
        Just jBlacklist -> do
            jBlacklist' <- packZeroTerminatedUTF8CArray jBlacklist
            return jBlacklist'
    result <- webkit_user_script_new source' injectedFrames' injectionTime' maybeWhitelist maybeBlacklist
    checkUnexpectedReturnNULL "userScriptNew" result
    result' <- (wrapBoxed UserScript) result
    freeMem source'
    mapZeroTerminatedCArray freeMem maybeWhitelist
    freeMem maybeWhitelist
    mapZeroTerminatedCArray freeMem maybeBlacklist
    freeMem maybeBlacklist
    return result'

-- 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 'GI.WebKit2.Structs.UserScript.UserScript' -}
    -> m UserScript
    {- ^ __Returns:__ The passed 'GI.WebKit2.Structs.UserScript.UserScript' -}
userScriptRef userScript = liftIO $ do
    userScript' <- unsafeManagedPtrGetPtr userScript
    result <- webkit_user_script_ref userScript'
    checkUnexpectedReturnNULL "userScriptRef" result
    result' <- (wrapBoxed UserScript) result
    touchManagedPtr userScript
    return result'

data UserScriptRefMethodInfo
instance (signature ~ (m UserScript), MonadIO m) => O.MethodInfo UserScriptRefMethodInfo UserScript signature where
    overloadedMethod _ = userScriptRef

-- 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
'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 'GI.WebKit2.Structs.UserScript.UserScript' -}
    -> m ()
userScriptUnref userScript = liftIO $ do
    userScript' <- unsafeManagedPtrGetPtr userScript
    webkit_user_script_unref userScript'
    touchManagedPtr userScript
    return ()

data UserScriptUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo UserScriptUnrefMethodInfo UserScript signature where
    overloadedMethod _ = userScriptUnref

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.MethodInfo info UserScript p) => O.IsLabelProxy t (UserScript -> p) where
    fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)

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