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

-- * Exported types
    UserContentFilterStore(..)              ,
    IsUserContentFilterStore                ,
    toUserContentFilterStore                ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [fetchIdentifiers]("GI.WebKit2.Objects.UserContentFilterStore#g:method:fetchIdentifiers"), [fetchIdentifiersFinish]("GI.WebKit2.Objects.UserContentFilterStore#g:method:fetchIdentifiersFinish"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [load]("GI.WebKit2.Objects.UserContentFilterStore#g:method:load"), [loadFinish]("GI.WebKit2.Objects.UserContentFilterStore#g:method:loadFinish"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [remove]("GI.WebKit2.Objects.UserContentFilterStore#g:method:remove"), [removeFinish]("GI.WebKit2.Objects.UserContentFilterStore#g:method:removeFinish"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [save]("GI.WebKit2.Objects.UserContentFilterStore#g:method:save"), [saveFinish]("GI.WebKit2.Objects.UserContentFilterStore#g:method:saveFinish"), [saveFromFile]("GI.WebKit2.Objects.UserContentFilterStore#g:method:saveFromFile"), [saveFromFileFinish]("GI.WebKit2.Objects.UserContentFilterStore#g:method:saveFromFileFinish"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getPath]("GI.WebKit2.Objects.UserContentFilterStore#g:method:getPath"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveUserContentFilterStoreMethod     ,
#endif

-- ** fetchIdentifiers #method:fetchIdentifiers#

#if defined(ENABLE_OVERLOADING)
    UserContentFilterStoreFetchIdentifiersMethodInfo,
#endif
    userContentFilterStoreFetchIdentifiers  ,


-- ** fetchIdentifiersFinish #method:fetchIdentifiersFinish#

#if defined(ENABLE_OVERLOADING)
    UserContentFilterStoreFetchIdentifiersFinishMethodInfo,
#endif
    userContentFilterStoreFetchIdentifiersFinish,


-- ** getPath #method:getPath#

#if defined(ENABLE_OVERLOADING)
    UserContentFilterStoreGetPathMethodInfo ,
#endif
    userContentFilterStoreGetPath           ,


-- ** load #method:load#

#if defined(ENABLE_OVERLOADING)
    UserContentFilterStoreLoadMethodInfo    ,
#endif
    userContentFilterStoreLoad              ,


-- ** loadFinish #method:loadFinish#

#if defined(ENABLE_OVERLOADING)
    UserContentFilterStoreLoadFinishMethodInfo,
#endif
    userContentFilterStoreLoadFinish        ,


-- ** new #method:new#

    userContentFilterStoreNew               ,


-- ** remove #method:remove#

#if defined(ENABLE_OVERLOADING)
    UserContentFilterStoreRemoveMethodInfo  ,
#endif
    userContentFilterStoreRemove            ,


-- ** removeFinish #method:removeFinish#

#if defined(ENABLE_OVERLOADING)
    UserContentFilterStoreRemoveFinishMethodInfo,
#endif
    userContentFilterStoreRemoveFinish      ,


-- ** save #method:save#

#if defined(ENABLE_OVERLOADING)
    UserContentFilterStoreSaveMethodInfo    ,
#endif
    userContentFilterStoreSave              ,


-- ** saveFinish #method:saveFinish#

#if defined(ENABLE_OVERLOADING)
    UserContentFilterStoreSaveFinishMethodInfo,
#endif
    userContentFilterStoreSaveFinish        ,


-- ** saveFromFile #method:saveFromFile#

#if defined(ENABLE_OVERLOADING)
    UserContentFilterStoreSaveFromFileMethodInfo,
#endif
    userContentFilterStoreSaveFromFile      ,


-- ** saveFromFileFinish #method:saveFromFileFinish#

#if defined(ENABLE_OVERLOADING)
    UserContentFilterStoreSaveFromFileFinishMethodInfo,
#endif
    userContentFilterStoreSaveFromFileFinish,




 -- * Properties


-- ** path #attr:path#
-- | The directory used for filter storage. This path is used as the base
-- directory where user content filters are stored on disk.
-- 
-- /Since: 2.24/

#if defined(ENABLE_OVERLOADING)
    UserContentFilterStorePathPropertyInfo  ,
#endif
    constructUserContentFilterStorePath     ,
    getUserContentFilterStorePath           ,
#if defined(ENABLE_OVERLOADING)
    userContentFilterStorePath              ,
#endif




    ) 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 qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.WebKit2.Structs.UserContentFilter as WebKit2.UserContentFilter

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

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

foreign import ccall "webkit_user_content_filter_store_get_type"
    c_webkit_user_content_filter_store_get_type :: IO B.Types.GType

instance B.Types.TypedObject UserContentFilterStore where
    glibType :: IO GType
glibType = IO GType
c_webkit_user_content_filter_store_get_type

instance B.Types.GObject UserContentFilterStore

-- | Type class for types which can be safely cast to `UserContentFilterStore`, for instance with `toUserContentFilterStore`.
class (SP.GObject o, O.IsDescendantOf UserContentFilterStore o) => IsUserContentFilterStore o
instance (SP.GObject o, O.IsDescendantOf UserContentFilterStore o) => IsUserContentFilterStore o

instance O.HasParentTypes UserContentFilterStore
type instance O.ParentTypes UserContentFilterStore = '[GObject.Object.Object]

-- | Cast to `UserContentFilterStore`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toUserContentFilterStore :: (MIO.MonadIO m, IsUserContentFilterStore o) => o -> m UserContentFilterStore
toUserContentFilterStore :: forall (m :: * -> *) o.
(MonadIO m, IsUserContentFilterStore o) =>
o -> m UserContentFilterStore
toUserContentFilterStore = IO UserContentFilterStore -> m UserContentFilterStore
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO UserContentFilterStore -> m UserContentFilterStore)
-> (o -> IO UserContentFilterStore)
-> o
-> m UserContentFilterStore
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr UserContentFilterStore -> UserContentFilterStore)
-> o -> IO UserContentFilterStore
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr UserContentFilterStore -> UserContentFilterStore
UserContentFilterStore

-- | Convert 'UserContentFilterStore' 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 UserContentFilterStore) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_webkit_user_content_filter_store_get_type
    gvalueSet_ :: Ptr GValue -> Maybe UserContentFilterStore -> IO ()
gvalueSet_ Ptr GValue
gv Maybe UserContentFilterStore
P.Nothing = Ptr GValue -> Ptr UserContentFilterStore -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr UserContentFilterStore
forall a. Ptr a
FP.nullPtr :: FP.Ptr UserContentFilterStore)
    gvalueSet_ Ptr GValue
gv (P.Just UserContentFilterStore
obj) = UserContentFilterStore
-> (Ptr UserContentFilterStore -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr UserContentFilterStore
obj (Ptr GValue -> Ptr UserContentFilterStore -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe UserContentFilterStore)
gvalueGet_ Ptr GValue
gv = do
        Ptr UserContentFilterStore
ptr <- Ptr GValue -> IO (Ptr UserContentFilterStore)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr UserContentFilterStore)
        if Ptr UserContentFilterStore
ptr Ptr UserContentFilterStore -> Ptr UserContentFilterStore -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr UserContentFilterStore
forall a. Ptr a
FP.nullPtr
        then UserContentFilterStore -> Maybe UserContentFilterStore
forall a. a -> Maybe a
P.Just (UserContentFilterStore -> Maybe UserContentFilterStore)
-> IO UserContentFilterStore -> IO (Maybe UserContentFilterStore)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr UserContentFilterStore -> UserContentFilterStore)
-> Ptr UserContentFilterStore -> IO UserContentFilterStore
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr UserContentFilterStore -> UserContentFilterStore
UserContentFilterStore Ptr UserContentFilterStore
ptr
        else Maybe UserContentFilterStore -> IO (Maybe UserContentFilterStore)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe UserContentFilterStore
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveUserContentFilterStoreMethod (t :: Symbol) (o :: *) :: * where
    ResolveUserContentFilterStoreMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveUserContentFilterStoreMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveUserContentFilterStoreMethod "fetchIdentifiers" o = UserContentFilterStoreFetchIdentifiersMethodInfo
    ResolveUserContentFilterStoreMethod "fetchIdentifiersFinish" o = UserContentFilterStoreFetchIdentifiersFinishMethodInfo
    ResolveUserContentFilterStoreMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveUserContentFilterStoreMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveUserContentFilterStoreMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveUserContentFilterStoreMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveUserContentFilterStoreMethod "load" o = UserContentFilterStoreLoadMethodInfo
    ResolveUserContentFilterStoreMethod "loadFinish" o = UserContentFilterStoreLoadFinishMethodInfo
    ResolveUserContentFilterStoreMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveUserContentFilterStoreMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveUserContentFilterStoreMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveUserContentFilterStoreMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveUserContentFilterStoreMethod "remove" o = UserContentFilterStoreRemoveMethodInfo
    ResolveUserContentFilterStoreMethod "removeFinish" o = UserContentFilterStoreRemoveFinishMethodInfo
    ResolveUserContentFilterStoreMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveUserContentFilterStoreMethod "save" o = UserContentFilterStoreSaveMethodInfo
    ResolveUserContentFilterStoreMethod "saveFinish" o = UserContentFilterStoreSaveFinishMethodInfo
    ResolveUserContentFilterStoreMethod "saveFromFile" o = UserContentFilterStoreSaveFromFileMethodInfo
    ResolveUserContentFilterStoreMethod "saveFromFileFinish" o = UserContentFilterStoreSaveFromFileFinishMethodInfo
    ResolveUserContentFilterStoreMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveUserContentFilterStoreMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveUserContentFilterStoreMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveUserContentFilterStoreMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveUserContentFilterStoreMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveUserContentFilterStoreMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveUserContentFilterStoreMethod "getPath" o = UserContentFilterStoreGetPathMethodInfo
    ResolveUserContentFilterStoreMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveUserContentFilterStoreMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveUserContentFilterStoreMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveUserContentFilterStoreMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveUserContentFilterStoreMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveUserContentFilterStoreMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "path"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@path@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' userContentFilterStore #path
-- @
getUserContentFilterStorePath :: (MonadIO m, IsUserContentFilterStore o) => o -> m T.Text
getUserContentFilterStorePath :: forall (m :: * -> *) o.
(MonadIO m, IsUserContentFilterStore o) =>
o -> m Text
getUserContentFilterStorePath o
obj = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getUserContentFilterStorePath" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"path"

-- | Construct a `GValueConstruct` with valid value for the “@path@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructUserContentFilterStorePath :: (IsUserContentFilterStore o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructUserContentFilterStorePath :: forall o (m :: * -> *).
(IsUserContentFilterStore o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructUserContentFilterStorePath Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"path" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data UserContentFilterStorePathPropertyInfo
instance AttrInfo UserContentFilterStorePathPropertyInfo where
    type AttrAllowedOps UserContentFilterStorePathPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint UserContentFilterStorePathPropertyInfo = IsUserContentFilterStore
    type AttrSetTypeConstraint UserContentFilterStorePathPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint UserContentFilterStorePathPropertyInfo = (~) T.Text
    type AttrTransferType UserContentFilterStorePathPropertyInfo = T.Text
    type AttrGetType UserContentFilterStorePathPropertyInfo = T.Text
    type AttrLabel UserContentFilterStorePathPropertyInfo = "path"
    type AttrOrigin UserContentFilterStorePathPropertyInfo = UserContentFilterStore
    attrGet = getUserContentFilterStorePath
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructUserContentFilterStorePath
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList UserContentFilterStore
type instance O.AttributeList UserContentFilterStore = UserContentFilterStoreAttributeList
type UserContentFilterStoreAttributeList = ('[ '("path", UserContentFilterStorePathPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
userContentFilterStorePath :: AttrLabelProxy "path"
userContentFilterStorePath = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList UserContentFilterStore = UserContentFilterStoreSignalList
type UserContentFilterStoreSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method UserContentFilterStore::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "storage_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "path where data for filters will be stored on disk"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "WebKit2" , name = "UserContentFilterStore" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_user_content_filter_store_new" webkit_user_content_filter_store_new :: 
    CString ->                              -- storage_path : TBasicType TUTF8
    IO (Ptr UserContentFilterStore)

-- | Create a new t'GI.WebKit2.Objects.UserContentFilterStore.UserContentFilterStore' to manipulate filters stored at /@storagePath@/.
-- The path must point to a local filesystem, and will be created if needed.
-- 
-- /Since: 2.24/
userContentFilterStoreNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@storagePath@/: path where data for filters will be stored on disk
    -> m UserContentFilterStore
    -- ^ __Returns:__ a newly created t'GI.WebKit2.Objects.UserContentFilterStore.UserContentFilterStore'
userContentFilterStoreNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m UserContentFilterStore
userContentFilterStoreNew Text
storagePath = IO UserContentFilterStore -> m UserContentFilterStore
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserContentFilterStore -> m UserContentFilterStore)
-> IO UserContentFilterStore -> m UserContentFilterStore
forall a b. (a -> b) -> a -> b
$ do
    CString
storagePath' <- Text -> IO CString
textToCString Text
storagePath
    Ptr UserContentFilterStore
result <- CString -> IO (Ptr UserContentFilterStore)
webkit_user_content_filter_store_new CString
storagePath'
    Text -> Ptr UserContentFilterStore -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"userContentFilterStoreNew" Ptr UserContentFilterStore
result
    UserContentFilterStore
result' <- ((ManagedPtr UserContentFilterStore -> UserContentFilterStore)
-> Ptr UserContentFilterStore -> IO UserContentFilterStore
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr UserContentFilterStore -> UserContentFilterStore
UserContentFilterStore) Ptr UserContentFilterStore
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
storagePath'
    UserContentFilterStore -> IO UserContentFilterStore
forall (m :: * -> *) a. Monad m => a -> m a
return UserContentFilterStore
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method UserContentFilterStore::fetch_identifiers
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "store"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "UserContentFilterStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitUserContentFilterStore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable or %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GAsyncReadyCallback to call when the removal is completed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to the callback function"
--                 , 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_content_filter_store_fetch_identifiers" webkit_user_content_filter_store_fetch_identifiers :: 
    Ptr UserContentFilterStore ->           -- store : TInterface (Name {namespace = "WebKit2", name = "UserContentFilterStore"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously retrieve a list of the identifiers for all the stored filters.
-- 
-- When the operation is finished, /@callback@/ will be invoked, which then can use
-- 'GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreFetchIdentifiersFinish' to obtain the list of
-- filter identifiers.
-- 
-- /Since: 2.24/
userContentFilterStoreFetchIdentifiers ::
    (B.CallStack.HasCallStack, MonadIO m, IsUserContentFilterStore a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@store@/: a t'GI.WebKit2.Objects.UserContentFilterStore.UserContentFilterStore'
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the removal is completed
    -> m ()
userContentFilterStoreFetchIdentifiers :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsUserContentFilterStore a,
 IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
userContentFilterStoreFetchIdentifiers a
store Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 UserContentFilterStore
store' <- a -> IO (Ptr UserContentFilterStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
store
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr UserContentFilterStore
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
webkit_user_content_filter_store_fetch_identifiers Ptr UserContentFilterStore
store' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
store
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data UserContentFilterStoreFetchIdentifiersMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsUserContentFilterStore a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod UserContentFilterStoreFetchIdentifiersMethodInfo a signature where
    overloadedMethod = userContentFilterStoreFetchIdentifiers

instance O.OverloadedMethodInfo UserContentFilterStoreFetchIdentifiersMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreFetchIdentifiers",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-UserContentFilterStore.html#v:userContentFilterStoreFetchIdentifiers"
        }


#endif

-- method UserContentFilterStore::fetch_identifiers_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "store"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "UserContentFilterStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitUserContentFilterStore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "webkit_user_content_filter_store_fetch_identifiers_finish" webkit_user_content_filter_store_fetch_identifiers_finish :: 
    Ptr UserContentFilterStore ->           -- store : TInterface (Name {namespace = "WebKit2", name = "UserContentFilterStore"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    IO (Ptr CString)

-- | Finishes an asynchronous fetch of the list of identifiers for the stored filters previously
-- started with 'GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreFetchIdentifiers'.
-- 
-- /Since: 2.24/
userContentFilterStoreFetchIdentifiersFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsUserContentFilterStore a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@store@/: a t'GI.WebKit2.Objects.UserContentFilterStore.UserContentFilterStore'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m [T.Text]
    -- ^ __Returns:__ a 'P.Nothing'-terminated list of filter identifiers.
userContentFilterStoreFetchIdentifiersFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsUserContentFilterStore a,
 IsAsyncResult b) =>
a -> b -> m [Text]
userContentFilterStoreFetchIdentifiersFinish a
store b
result_ = IO [Text] -> m [Text]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ do
    Ptr UserContentFilterStore
store' <- a -> IO (Ptr UserContentFilterStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
store
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr CString
result <- Ptr UserContentFilterStore -> Ptr AsyncResult -> IO (Ptr CString)
webkit_user_content_filter_store_fetch_identifiers_finish Ptr UserContentFilterStore
store' Ptr AsyncResult
result_'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"userContentFilterStoreFetchIdentifiersFinish" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    (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
result
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
store
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

#if defined(ENABLE_OVERLOADING)
data UserContentFilterStoreFetchIdentifiersFinishMethodInfo
instance (signature ~ (b -> m [T.Text]), MonadIO m, IsUserContentFilterStore a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod UserContentFilterStoreFetchIdentifiersFinishMethodInfo a signature where
    overloadedMethod = userContentFilterStoreFetchIdentifiersFinish

instance O.OverloadedMethodInfo UserContentFilterStoreFetchIdentifiersFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreFetchIdentifiersFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-UserContentFilterStore.html#v:userContentFilterStoreFetchIdentifiersFinish"
        }


#endif

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

foreign import ccall "webkit_user_content_filter_store_get_path" webkit_user_content_filter_store_get_path :: 
    Ptr UserContentFilterStore ->           -- store : TInterface (Name {namespace = "WebKit2", name = "UserContentFilterStore"})
    IO CString

-- | /No description available in the introspection data./
-- 
-- /Since: 2.24/
userContentFilterStoreGetPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsUserContentFilterStore a) =>
    a
    -- ^ /@store@/: a t'GI.WebKit2.Objects.UserContentFilterStore.UserContentFilterStore'
    -> m T.Text
    -- ^ __Returns:__ The storage path for user content filters.
userContentFilterStoreGetPath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsUserContentFilterStore a) =>
a -> m Text
userContentFilterStoreGetPath a
store = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr UserContentFilterStore
store' <- a -> IO (Ptr UserContentFilterStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
store
    CString
result <- Ptr UserContentFilterStore -> IO CString
webkit_user_content_filter_store_get_path Ptr UserContentFilterStore
store'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"userContentFilterStoreGetPath" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
store
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data UserContentFilterStoreGetPathMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsUserContentFilterStore a) => O.OverloadedMethod UserContentFilterStoreGetPathMethodInfo a signature where
    overloadedMethod = userContentFilterStoreGetPath

instance O.OverloadedMethodInfo UserContentFilterStoreGetPathMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreGetPath",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-UserContentFilterStore.html#v:userContentFilterStoreGetPath"
        }


#endif

-- method UserContentFilterStore::load
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "store"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "UserContentFilterStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitUserContentFilterStore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "identifier"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a filter identifier"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable or %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GAsyncReadyCallback to call when the load is completed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to the callback function"
--                 , 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_content_filter_store_load" webkit_user_content_filter_store_load :: 
    Ptr UserContentFilterStore ->           -- store : TInterface (Name {namespace = "WebKit2", name = "UserContentFilterStore"})
    CString ->                              -- identifier : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously load a content filter given its /@identifier@/. The filter must have been
-- previously stored using 'GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreSave'.
-- 
-- When the operation is finished, /@callback@/ will be invoked, which then can use
-- 'GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreLoadFinish' to obtain the resulting filter.
-- 
-- /Since: 2.24/
userContentFilterStoreLoad ::
    (B.CallStack.HasCallStack, MonadIO m, IsUserContentFilterStore a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@store@/: a t'GI.WebKit2.Objects.UserContentFilterStore.UserContentFilterStore'
    -> T.Text
    -- ^ /@identifier@/: a filter identifier
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the load is completed
    -> m ()
userContentFilterStoreLoad :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsUserContentFilterStore a,
 IsCancellable b) =>
a -> Text -> Maybe b -> Maybe AsyncReadyCallback -> m ()
userContentFilterStoreLoad a
store Text
identifier Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 UserContentFilterStore
store' <- a -> IO (Ptr UserContentFilterStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
store
    CString
identifier' <- Text -> IO CString
textToCString Text
identifier
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr UserContentFilterStore
-> CString
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
webkit_user_content_filter_store_load Ptr UserContentFilterStore
store' CString
identifier' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
store
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
identifier'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data UserContentFilterStoreLoadMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsUserContentFilterStore a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod UserContentFilterStoreLoadMethodInfo a signature where
    overloadedMethod = userContentFilterStoreLoad

instance O.OverloadedMethodInfo UserContentFilterStoreLoadMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreLoad",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-UserContentFilterStore.html#v:userContentFilterStoreLoad"
        }


#endif

-- method UserContentFilterStore::load_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "store"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "UserContentFilterStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitUserContentFilterStore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "WebKit2" , name = "UserContentFilter" })
-- throws : True
-- Skip return : False

foreign import ccall "webkit_user_content_filter_store_load_finish" webkit_user_content_filter_store_load_finish :: 
    Ptr UserContentFilterStore ->           -- store : TInterface (Name {namespace = "WebKit2", name = "UserContentFilterStore"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr WebKit2.UserContentFilter.UserContentFilter)

-- | Finishes an asynchronous filter load previously started with
-- 'GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreLoad'.
-- 
-- /Since: 2.24/
userContentFilterStoreLoadFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsUserContentFilterStore a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@store@/: a t'GI.WebKit2.Objects.UserContentFilterStore.UserContentFilterStore'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m WebKit2.UserContentFilter.UserContentFilter
    -- ^ __Returns:__ a t'GI.WebKit2.Structs.UserContentFilter.UserContentFilter', or 'P.Nothing' if the load failed /(Can throw 'Data.GI.Base.GError.GError')/
userContentFilterStoreLoadFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsUserContentFilterStore a,
 IsAsyncResult b) =>
a -> b -> m UserContentFilter
userContentFilterStoreLoadFinish a
store b
result_ = IO UserContentFilter -> m UserContentFilter
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserContentFilter -> m UserContentFilter)
-> IO UserContentFilter -> m UserContentFilter
forall a b. (a -> b) -> a -> b
$ do
    Ptr UserContentFilterStore
store' <- a -> IO (Ptr UserContentFilterStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
store
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO UserContentFilter -> IO () -> IO UserContentFilter
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr UserContentFilter
result <- (Ptr (Ptr GError) -> IO (Ptr UserContentFilter))
-> IO (Ptr UserContentFilter)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr UserContentFilter))
 -> IO (Ptr UserContentFilter))
-> (Ptr (Ptr GError) -> IO (Ptr UserContentFilter))
-> IO (Ptr UserContentFilter)
forall a b. (a -> b) -> a -> b
$ Ptr UserContentFilterStore
-> Ptr AsyncResult
-> Ptr (Ptr GError)
-> IO (Ptr UserContentFilter)
webkit_user_content_filter_store_load_finish Ptr UserContentFilterStore
store' Ptr AsyncResult
result_'
        Text -> Ptr UserContentFilter -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"userContentFilterStoreLoadFinish" Ptr UserContentFilter
result
        UserContentFilter
result' <- ((ManagedPtr UserContentFilter -> UserContentFilter)
-> Ptr UserContentFilter -> IO UserContentFilter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr UserContentFilter -> UserContentFilter
WebKit2.UserContentFilter.UserContentFilter) Ptr UserContentFilter
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
store
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        UserContentFilter -> IO UserContentFilter
forall (m :: * -> *) a. Monad m => a -> m a
return UserContentFilter
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data UserContentFilterStoreLoadFinishMethodInfo
instance (signature ~ (b -> m WebKit2.UserContentFilter.UserContentFilter), MonadIO m, IsUserContentFilterStore a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod UserContentFilterStoreLoadFinishMethodInfo a signature where
    overloadedMethod = userContentFilterStoreLoadFinish

instance O.OverloadedMethodInfo UserContentFilterStoreLoadFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreLoadFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-UserContentFilterStore.html#v:userContentFilterStoreLoadFinish"
        }


#endif

-- method UserContentFilterStore::remove
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "store"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "UserContentFilterStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitUserContentFilterStore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "identifier"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a filter identifier"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable or %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GAsyncReadyCallback to call when the removal is completed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to the callback function"
--                 , 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_content_filter_store_remove" webkit_user_content_filter_store_remove :: 
    Ptr UserContentFilterStore ->           -- store : TInterface (Name {namespace = "WebKit2", name = "UserContentFilterStore"})
    CString ->                              -- identifier : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously remove a content filter given its /@identifier@/.
-- 
-- When the operation is finished, /@callback@/ will be invoked, which then can use
-- 'GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreRemoveFinish' to check whether the removal was
-- successful.
-- 
-- /Since: 2.24/
userContentFilterStoreRemove ::
    (B.CallStack.HasCallStack, MonadIO m, IsUserContentFilterStore a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@store@/: a t'GI.WebKit2.Objects.UserContentFilterStore.UserContentFilterStore'
    -> T.Text
    -- ^ /@identifier@/: a filter identifier
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the removal is completed
    -> m ()
userContentFilterStoreRemove :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsUserContentFilterStore a,
 IsCancellable b) =>
a -> Text -> Maybe b -> Maybe AsyncReadyCallback -> m ()
userContentFilterStoreRemove a
store Text
identifier Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 UserContentFilterStore
store' <- a -> IO (Ptr UserContentFilterStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
store
    CString
identifier' <- Text -> IO CString
textToCString Text
identifier
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr UserContentFilterStore
-> CString
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
webkit_user_content_filter_store_remove Ptr UserContentFilterStore
store' CString
identifier' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
store
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
identifier'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data UserContentFilterStoreRemoveMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsUserContentFilterStore a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod UserContentFilterStoreRemoveMethodInfo a signature where
    overloadedMethod = userContentFilterStoreRemove

instance O.OverloadedMethodInfo UserContentFilterStoreRemoveMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreRemove",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-UserContentFilterStore.html#v:userContentFilterStoreRemove"
        }


#endif

-- method UserContentFilterStore::remove_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "store"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "UserContentFilterStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitUserContentFilterStore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "webkit_user_content_filter_store_remove_finish" webkit_user_content_filter_store_remove_finish :: 
    Ptr UserContentFilterStore ->           -- store : TInterface (Name {namespace = "WebKit2", name = "UserContentFilterStore"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes an asynchronous filter removal previously started with
-- 'GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreRemove'.
-- 
-- /Since: 2.24/
userContentFilterStoreRemoveFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsUserContentFilterStore a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@store@/: a t'GI.WebKit2.Objects.UserContentFilterStore.UserContentFilterStore'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
userContentFilterStoreRemoveFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsUserContentFilterStore a,
 IsAsyncResult b) =>
a -> b -> m ()
userContentFilterStoreRemoveFinish a
store b
result_ = 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 UserContentFilterStore
store' <- a -> IO (Ptr UserContentFilterStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
store
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr UserContentFilterStore
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
webkit_user_content_filter_store_remove_finish Ptr UserContentFilterStore
store' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
store
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data UserContentFilterStoreRemoveFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsUserContentFilterStore a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod UserContentFilterStoreRemoveFinishMethodInfo a signature where
    overloadedMethod = userContentFilterStoreRemoveFinish

instance O.OverloadedMethodInfo UserContentFilterStoreRemoveFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreRemoveFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-UserContentFilterStore.html#v:userContentFilterStoreRemoveFinish"
        }


#endif

-- method UserContentFilterStore::save
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "store"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "UserContentFilterStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitUserContentFilterStore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "identifier"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string used to identify the saved filter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#GBytes containing the rule set in JSON format"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable or %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GAsyncReadyCallback to call when saving is completed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to the callback function"
--                 , 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_content_filter_store_save" webkit_user_content_filter_store_save :: 
    Ptr UserContentFilterStore ->           -- store : TInterface (Name {namespace = "WebKit2", name = "UserContentFilterStore"})
    CString ->                              -- identifier : TBasicType TUTF8
    Ptr GLib.Bytes.Bytes ->                 -- source : TInterface (Name {namespace = "GLib", name = "Bytes"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously save a content filter from a source rule set in the
-- <https://webkit.org/blog/3476/content-blockers-first-look/ WebKit content extesions JSON format>.
-- 
-- The /@identifier@/ can be used afterwards to refer to the filter when using
-- 'GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreRemove' and 'GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreLoad'.
-- When the /@identifier@/ has been used in the past, the new filter source will replace
-- the one saved beforehand for the same identifier.
-- 
-- When the operation is finished, /@callback@/ will be invoked, which then can use
-- 'GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreSaveFinish' to obtain the resulting filter.
-- 
-- /Since: 2.24/
userContentFilterStoreSave ::
    (B.CallStack.HasCallStack, MonadIO m, IsUserContentFilterStore a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@store@/: a t'GI.WebKit2.Objects.UserContentFilterStore.UserContentFilterStore'
    -> T.Text
    -- ^ /@identifier@/: a string used to identify the saved filter
    -> GLib.Bytes.Bytes
    -- ^ /@source@/: t'GI.GLib.Structs.Bytes.Bytes' containing the rule set in JSON format
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when saving is completed
    -> m ()
userContentFilterStoreSave :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsUserContentFilterStore a,
 IsCancellable b) =>
a -> Text -> Bytes -> Maybe b -> Maybe AsyncReadyCallback -> m ()
userContentFilterStoreSave a
store Text
identifier Bytes
source Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 UserContentFilterStore
store' <- a -> IO (Ptr UserContentFilterStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
store
    CString
identifier' <- Text -> IO CString
textToCString Text
identifier
    Ptr Bytes
source' <- Bytes -> IO (Ptr Bytes)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bytes
source
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr UserContentFilterStore
-> CString
-> Ptr Bytes
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
webkit_user_content_filter_store_save Ptr UserContentFilterStore
store' CString
identifier' Ptr Bytes
source' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
store
    Bytes -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Bytes
source
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
identifier'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data UserContentFilterStoreSaveMethodInfo
instance (signature ~ (T.Text -> GLib.Bytes.Bytes -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsUserContentFilterStore a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod UserContentFilterStoreSaveMethodInfo a signature where
    overloadedMethod = userContentFilterStoreSave

instance O.OverloadedMethodInfo UserContentFilterStoreSaveMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreSave",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-UserContentFilterStore.html#v:userContentFilterStoreSave"
        }


#endif

-- method UserContentFilterStore::save_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "store"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "UserContentFilterStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitUserContentFilterStore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "WebKit2" , name = "UserContentFilter" })
-- throws : True
-- Skip return : False

foreign import ccall "webkit_user_content_filter_store_save_finish" webkit_user_content_filter_store_save_finish :: 
    Ptr UserContentFilterStore ->           -- store : TInterface (Name {namespace = "WebKit2", name = "UserContentFilterStore"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr WebKit2.UserContentFilter.UserContentFilter)

-- | Finishes an asynchronous filter save previously started with
-- 'GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreSave'.
-- 
-- /Since: 2.24/
userContentFilterStoreSaveFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsUserContentFilterStore a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@store@/: a t'GI.WebKit2.Objects.UserContentFilterStore.UserContentFilterStore'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m WebKit2.UserContentFilter.UserContentFilter
    -- ^ __Returns:__ a t'GI.WebKit2.Structs.UserContentFilter.UserContentFilter', or 'P.Nothing' if saving failed /(Can throw 'Data.GI.Base.GError.GError')/
userContentFilterStoreSaveFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsUserContentFilterStore a,
 IsAsyncResult b) =>
a -> b -> m UserContentFilter
userContentFilterStoreSaveFinish a
store b
result_ = IO UserContentFilter -> m UserContentFilter
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserContentFilter -> m UserContentFilter)
-> IO UserContentFilter -> m UserContentFilter
forall a b. (a -> b) -> a -> b
$ do
    Ptr UserContentFilterStore
store' <- a -> IO (Ptr UserContentFilterStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
store
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO UserContentFilter -> IO () -> IO UserContentFilter
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr UserContentFilter
result <- (Ptr (Ptr GError) -> IO (Ptr UserContentFilter))
-> IO (Ptr UserContentFilter)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr UserContentFilter))
 -> IO (Ptr UserContentFilter))
-> (Ptr (Ptr GError) -> IO (Ptr UserContentFilter))
-> IO (Ptr UserContentFilter)
forall a b. (a -> b) -> a -> b
$ Ptr UserContentFilterStore
-> Ptr AsyncResult
-> Ptr (Ptr GError)
-> IO (Ptr UserContentFilter)
webkit_user_content_filter_store_save_finish Ptr UserContentFilterStore
store' Ptr AsyncResult
result_'
        Text -> Ptr UserContentFilter -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"userContentFilterStoreSaveFinish" Ptr UserContentFilter
result
        UserContentFilter
result' <- ((ManagedPtr UserContentFilter -> UserContentFilter)
-> Ptr UserContentFilter -> IO UserContentFilter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr UserContentFilter -> UserContentFilter
WebKit2.UserContentFilter.UserContentFilter) Ptr UserContentFilter
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
store
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        UserContentFilter -> IO UserContentFilter
forall (m :: * -> *) a. Monad m => a -> m a
return UserContentFilter
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data UserContentFilterStoreSaveFinishMethodInfo
instance (signature ~ (b -> m WebKit2.UserContentFilter.UserContentFilter), MonadIO m, IsUserContentFilterStore a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod UserContentFilterStoreSaveFinishMethodInfo a signature where
    overloadedMethod = userContentFilterStoreSaveFinish

instance O.OverloadedMethodInfo UserContentFilterStoreSaveFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreSaveFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-UserContentFilterStore.html#v:userContentFilterStoreSaveFinish"
        }


#endif

-- method UserContentFilterStore::save_from_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "store"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "UserContentFilterStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitUserContentFilterStore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "identifier"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string used to identify the saved filter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GFile containing the rule set in JSON format"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable or %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GAsyncReadyCallback to call when saving is completed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to the callback function"
--                 , 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_content_filter_store_save_from_file" webkit_user_content_filter_store_save_from_file :: 
    Ptr UserContentFilterStore ->           -- store : TInterface (Name {namespace = "WebKit2", name = "UserContentFilterStore"})
    CString ->                              -- identifier : TBasicType TUTF8
    Ptr Gio.File.File ->                    -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously save a content filter from the contents of a file, which must be
-- native to the platform, as checked by 'GI.Gio.Interfaces.File.fileIsNative'. See
-- 'GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreSave' for more details.
-- 
-- When the operation is finished, /@callback@/ will be invoked, which then can use
-- 'GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreSaveFinish' to obtain the resulting filter.
-- 
-- /Since: 2.24/
userContentFilterStoreSaveFromFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsUserContentFilterStore a, Gio.File.IsFile b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@store@/: a t'GI.WebKit2.Objects.UserContentFilterStore.UserContentFilterStore'
    -> T.Text
    -- ^ /@identifier@/: a string used to identify the saved filter
    -> b
    -- ^ /@file@/: a t'GI.Gio.Interfaces.File.File' containing the rule set in JSON format
    -> Maybe (c)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when saving is completed
    -> m ()
userContentFilterStoreSaveFromFile :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsUserContentFilterStore a, IsFile b,
 IsCancellable c) =>
a -> Text -> b -> Maybe c -> Maybe AsyncReadyCallback -> m ()
userContentFilterStoreSaveFromFile a
store Text
identifier b
file Maybe c
cancellable Maybe AsyncReadyCallback
callback = 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 UserContentFilterStore
store' <- a -> IO (Ptr UserContentFilterStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
store
    CString
identifier' <- Text -> IO CString
textToCString Text
identifier
    Ptr File
file' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
file
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr UserContentFilterStore
-> CString
-> Ptr File
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
webkit_user_content_filter_store_save_from_file Ptr UserContentFilterStore
store' CString
identifier' Ptr File
file' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
store
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
file
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
identifier'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data UserContentFilterStoreSaveFromFileMethodInfo
instance (signature ~ (T.Text -> b -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsUserContentFilterStore a, Gio.File.IsFile b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod UserContentFilterStoreSaveFromFileMethodInfo a signature where
    overloadedMethod = userContentFilterStoreSaveFromFile

instance O.OverloadedMethodInfo UserContentFilterStoreSaveFromFileMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreSaveFromFile",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-UserContentFilterStore.html#v:userContentFilterStoreSaveFromFile"
        }


#endif

-- method UserContentFilterStore::save_from_file_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "store"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "UserContentFilterStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitUserContentFilterStore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "WebKit2" , name = "UserContentFilter" })
-- throws : True
-- Skip return : False

foreign import ccall "webkit_user_content_filter_store_save_from_file_finish" webkit_user_content_filter_store_save_from_file_finish :: 
    Ptr UserContentFilterStore ->           -- store : TInterface (Name {namespace = "WebKit2", name = "UserContentFilterStore"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr WebKit2.UserContentFilter.UserContentFilter)

-- | Finishes and asynchronous filter save previously started with
-- 'GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreSaveFromFile'.
-- 
-- /Since: 2.24/
userContentFilterStoreSaveFromFileFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsUserContentFilterStore a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@store@/: a t'GI.WebKit2.Objects.UserContentFilterStore.UserContentFilterStore'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m WebKit2.UserContentFilter.UserContentFilter
    -- ^ __Returns:__ a t'GI.WebKit2.Structs.UserContentFilter.UserContentFilter', or 'P.Nothing' if saving failed. /(Can throw 'Data.GI.Base.GError.GError')/
userContentFilterStoreSaveFromFileFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsUserContentFilterStore a,
 IsAsyncResult b) =>
a -> b -> m UserContentFilter
userContentFilterStoreSaveFromFileFinish a
store b
result_ = IO UserContentFilter -> m UserContentFilter
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserContentFilter -> m UserContentFilter)
-> IO UserContentFilter -> m UserContentFilter
forall a b. (a -> b) -> a -> b
$ do
    Ptr UserContentFilterStore
store' <- a -> IO (Ptr UserContentFilterStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
store
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO UserContentFilter -> IO () -> IO UserContentFilter
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr UserContentFilter
result <- (Ptr (Ptr GError) -> IO (Ptr UserContentFilter))
-> IO (Ptr UserContentFilter)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr UserContentFilter))
 -> IO (Ptr UserContentFilter))
-> (Ptr (Ptr GError) -> IO (Ptr UserContentFilter))
-> IO (Ptr UserContentFilter)
forall a b. (a -> b) -> a -> b
$ Ptr UserContentFilterStore
-> Ptr AsyncResult
-> Ptr (Ptr GError)
-> IO (Ptr UserContentFilter)
webkit_user_content_filter_store_save_from_file_finish Ptr UserContentFilterStore
store' Ptr AsyncResult
result_'
        Text -> Ptr UserContentFilter -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"userContentFilterStoreSaveFromFileFinish" Ptr UserContentFilter
result
        UserContentFilter
result' <- ((ManagedPtr UserContentFilter -> UserContentFilter)
-> Ptr UserContentFilter -> IO UserContentFilter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr UserContentFilter -> UserContentFilter
WebKit2.UserContentFilter.UserContentFilter) Ptr UserContentFilter
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
store
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        UserContentFilter -> IO UserContentFilter
forall (m :: * -> *) a. Monad m => a -> m a
return UserContentFilter
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data UserContentFilterStoreSaveFromFileFinishMethodInfo
instance (signature ~ (b -> m WebKit2.UserContentFilter.UserContentFilter), MonadIO m, IsUserContentFilterStore a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod UserContentFilterStoreSaveFromFileFinishMethodInfo a signature where
    overloadedMethod = userContentFilterStoreSaveFromFileFinish

instance O.OverloadedMethodInfo UserContentFilterStoreSaveFromFileFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.UserContentFilterStore.userContentFilterStoreSaveFromFileFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-UserContentFilterStore.html#v:userContentFilterStoreSaveFromFileFinish"
        }


#endif