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

-- * Exported types
    Download(..)                            ,
    IsDownload                              ,
    toDownload                              ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveDownloadMethod                   ,
#endif


-- ** cancel #method:cancel#

#if defined(ENABLE_OVERLOADING)
    DownloadCancelMethodInfo                ,
#endif
    downloadCancel                          ,


-- ** getAllowOverwrite #method:getAllowOverwrite#

#if defined(ENABLE_OVERLOADING)
    DownloadGetAllowOverwriteMethodInfo     ,
#endif
    downloadGetAllowOverwrite               ,


-- ** getDestination #method:getDestination#

#if defined(ENABLE_OVERLOADING)
    DownloadGetDestinationMethodInfo        ,
#endif
    downloadGetDestination                  ,


-- ** getElapsedTime #method:getElapsedTime#

#if defined(ENABLE_OVERLOADING)
    DownloadGetElapsedTimeMethodInfo        ,
#endif
    downloadGetElapsedTime                  ,


-- ** getEstimatedProgress #method:getEstimatedProgress#

#if defined(ENABLE_OVERLOADING)
    DownloadGetEstimatedProgressMethodInfo  ,
#endif
    downloadGetEstimatedProgress            ,


-- ** getReceivedDataLength #method:getReceivedDataLength#

#if defined(ENABLE_OVERLOADING)
    DownloadGetReceivedDataLengthMethodInfo ,
#endif
    downloadGetReceivedDataLength           ,


-- ** getRequest #method:getRequest#

#if defined(ENABLE_OVERLOADING)
    DownloadGetRequestMethodInfo            ,
#endif
    downloadGetRequest                      ,


-- ** getResponse #method:getResponse#

#if defined(ENABLE_OVERLOADING)
    DownloadGetResponseMethodInfo           ,
#endif
    downloadGetResponse                     ,


-- ** getWebView #method:getWebView#

#if defined(ENABLE_OVERLOADING)
    DownloadGetWebViewMethodInfo            ,
#endif
    downloadGetWebView                      ,


-- ** setAllowOverwrite #method:setAllowOverwrite#

#if defined(ENABLE_OVERLOADING)
    DownloadSetAllowOverwriteMethodInfo     ,
#endif
    downloadSetAllowOverwrite               ,


-- ** setDestination #method:setDestination#

#if defined(ENABLE_OVERLOADING)
    DownloadSetDestinationMethodInfo        ,
#endif
    downloadSetDestination                  ,




 -- * Properties
-- ** allowOverwrite #attr:allowOverwrite#
-- | Whether or not the download is allowed to overwrite an existing file on
-- disk. If this property is 'P.False' and the destination already exists,
-- the download will fail.
-- 
-- /Since: 2.6/

#if defined(ENABLE_OVERLOADING)
    DownloadAllowOverwritePropertyInfo      ,
#endif
    constructDownloadAllowOverwrite         ,
#if defined(ENABLE_OVERLOADING)
    downloadAllowOverwrite                  ,
#endif
    getDownloadAllowOverwrite               ,
    setDownloadAllowOverwrite               ,


-- ** destination #attr:destination#
-- | The local URI to where the download will be saved.

#if defined(ENABLE_OVERLOADING)
    DownloadDestinationPropertyInfo         ,
#endif
#if defined(ENABLE_OVERLOADING)
    downloadDestination                     ,
#endif
    getDownloadDestination                  ,


-- ** estimatedProgress #attr:estimatedProgress#
-- | An estimate of the percent completion for the download operation.
-- This value will range from 0.0 to 1.0. The value is an estimate
-- based on the total number of bytes expected to be received for
-- a download.
-- If you need a more accurate progress information you can connect to
-- [receivedData]("GI.WebKit2.Objects.Download#g:signal:receivedData") signal to track the progress.

#if defined(ENABLE_OVERLOADING)
    DownloadEstimatedProgressPropertyInfo   ,
#endif
#if defined(ENABLE_OVERLOADING)
    downloadEstimatedProgress               ,
#endif
    getDownloadEstimatedProgress            ,


-- ** response #attr:response#
-- | The t'GI.WebKit2.Objects.URIResponse.URIResponse' associated with this download.

#if defined(ENABLE_OVERLOADING)
    DownloadResponsePropertyInfo            ,
#endif
#if defined(ENABLE_OVERLOADING)
    downloadResponse                        ,
#endif
    getDownloadResponse                     ,




 -- * Signals
-- ** createdDestination #signal:createdDestination#

    C_DownloadCreatedDestinationCallback    ,
    DownloadCreatedDestinationCallback      ,
#if defined(ENABLE_OVERLOADING)
    DownloadCreatedDestinationSignalInfo    ,
#endif
    afterDownloadCreatedDestination         ,
    genClosure_DownloadCreatedDestination   ,
    mk_DownloadCreatedDestinationCallback   ,
    noDownloadCreatedDestinationCallback    ,
    onDownloadCreatedDestination            ,
    wrap_DownloadCreatedDestinationCallback ,


-- ** decideDestination #signal:decideDestination#

    C_DownloadDecideDestinationCallback     ,
    DownloadDecideDestinationCallback       ,
#if defined(ENABLE_OVERLOADING)
    DownloadDecideDestinationSignalInfo     ,
#endif
    afterDownloadDecideDestination          ,
    genClosure_DownloadDecideDestination    ,
    mk_DownloadDecideDestinationCallback    ,
    noDownloadDecideDestinationCallback     ,
    onDownloadDecideDestination             ,
    wrap_DownloadDecideDestinationCallback  ,


-- ** failed #signal:failed#

    C_DownloadFailedCallback                ,
    DownloadFailedCallback                  ,
#if defined(ENABLE_OVERLOADING)
    DownloadFailedSignalInfo                ,
#endif
    afterDownloadFailed                     ,
    genClosure_DownloadFailed               ,
    mk_DownloadFailedCallback               ,
    noDownloadFailedCallback                ,
    onDownloadFailed                        ,
    wrap_DownloadFailedCallback             ,


-- ** finished #signal:finished#

    C_DownloadFinishedCallback              ,
    DownloadFinishedCallback                ,
#if defined(ENABLE_OVERLOADING)
    DownloadFinishedSignalInfo              ,
#endif
    afterDownloadFinished                   ,
    genClosure_DownloadFinished             ,
    mk_DownloadFinishedCallback             ,
    noDownloadFinishedCallback              ,
    onDownloadFinished                      ,
    wrap_DownloadFinishedCallback           ,


-- ** receivedData #signal:receivedData#

    C_DownloadReceivedDataCallback          ,
    DownloadReceivedDataCallback            ,
#if defined(ENABLE_OVERLOADING)
    DownloadReceivedDataSignalInfo          ,
#endif
    afterDownloadReceivedData               ,
    genClosure_DownloadReceivedData         ,
    mk_DownloadReceivedDataCallback         ,
    noDownloadReceivedDataCallback          ,
    onDownloadReceivedData                  ,
    wrap_DownloadReceivedDataCallback       ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.WebKit2.Objects.URIRequest as WebKit2.URIRequest
import {-# SOURCE #-} qualified GI.WebKit2.Objects.URIResponse as WebKit2.URIResponse
import {-# SOURCE #-} qualified GI.WebKit2.Objects.WebView as WebKit2.WebView

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

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

foreign import ccall "webkit_download_get_type"
    c_webkit_download_get_type :: IO B.Types.GType

instance B.Types.TypedObject Download where
    glibType :: IO GType
glibType = IO GType
c_webkit_download_get_type

instance B.Types.GObject Download

-- | Convert 'Download' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Download where
    toGValue :: Download -> IO GValue
toGValue Download
o = do
        GType
gtype <- IO GType
c_webkit_download_get_type
        Download -> (Ptr Download -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Download
o (GType
-> (GValue -> Ptr Download -> IO ()) -> Ptr Download -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Download -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO Download
fromGValue GValue
gv = do
        Ptr Download
ptr <- GValue -> IO (Ptr Download)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr Download)
        (ManagedPtr Download -> Download) -> Ptr Download -> IO Download
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Download -> Download
Download Ptr Download
ptr
        
    

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveDownloadMethod (t :: Symbol) (o :: *) :: * where
    ResolveDownloadMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDownloadMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDownloadMethod "cancel" o = DownloadCancelMethodInfo
    ResolveDownloadMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDownloadMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDownloadMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDownloadMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDownloadMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDownloadMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDownloadMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDownloadMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDownloadMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDownloadMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDownloadMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDownloadMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDownloadMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDownloadMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDownloadMethod "getAllowOverwrite" o = DownloadGetAllowOverwriteMethodInfo
    ResolveDownloadMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDownloadMethod "getDestination" o = DownloadGetDestinationMethodInfo
    ResolveDownloadMethod "getElapsedTime" o = DownloadGetElapsedTimeMethodInfo
    ResolveDownloadMethod "getEstimatedProgress" o = DownloadGetEstimatedProgressMethodInfo
    ResolveDownloadMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDownloadMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDownloadMethod "getReceivedDataLength" o = DownloadGetReceivedDataLengthMethodInfo
    ResolveDownloadMethod "getRequest" o = DownloadGetRequestMethodInfo
    ResolveDownloadMethod "getResponse" o = DownloadGetResponseMethodInfo
    ResolveDownloadMethod "getWebView" o = DownloadGetWebViewMethodInfo
    ResolveDownloadMethod "setAllowOverwrite" o = DownloadSetAllowOverwriteMethodInfo
    ResolveDownloadMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDownloadMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDownloadMethod "setDestination" o = DownloadSetDestinationMethodInfo
    ResolveDownloadMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDownloadMethod l o = O.MethodResolutionFailed l o

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

#endif

-- signal Download::created-destination
-- | This signal is emitted after [decideDestination]("GI.WebKit2.Objects.Download#g:signal:decideDestination") and before
-- [receivedData]("GI.WebKit2.Objects.Download#g:signal:receivedData") to notify that destination file has been
-- created successfully at /@destination@/.
type DownloadCreatedDestinationCallback =
    T.Text
    -- ^ /@destination@/: the destination URI
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `DownloadCreatedDestinationCallback`@.
noDownloadCreatedDestinationCallback :: Maybe DownloadCreatedDestinationCallback
noDownloadCreatedDestinationCallback :: Maybe DownloadCreatedDestinationCallback
noDownloadCreatedDestinationCallback = Maybe DownloadCreatedDestinationCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_DownloadCreatedDestinationCallback =
    Ptr () ->                               -- object
    CString ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_DownloadCreatedDestinationCallback`.
foreign import ccall "wrapper"
    mk_DownloadCreatedDestinationCallback :: C_DownloadCreatedDestinationCallback -> IO (FunPtr C_DownloadCreatedDestinationCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_DownloadCreatedDestination :: MonadIO m => DownloadCreatedDestinationCallback -> m (GClosure C_DownloadCreatedDestinationCallback)
genClosure_DownloadCreatedDestination :: DownloadCreatedDestinationCallback
-> m (GClosure C_DownloadCreatedDestinationCallback)
genClosure_DownloadCreatedDestination DownloadCreatedDestinationCallback
cb = IO (GClosure C_DownloadCreatedDestinationCallback)
-> m (GClosure C_DownloadCreatedDestinationCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_DownloadCreatedDestinationCallback)
 -> m (GClosure C_DownloadCreatedDestinationCallback))
-> IO (GClosure C_DownloadCreatedDestinationCallback)
-> m (GClosure C_DownloadCreatedDestinationCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DownloadCreatedDestinationCallback
cb' = DownloadCreatedDestinationCallback
-> C_DownloadCreatedDestinationCallback
wrap_DownloadCreatedDestinationCallback DownloadCreatedDestinationCallback
cb
    C_DownloadCreatedDestinationCallback
-> IO (FunPtr C_DownloadCreatedDestinationCallback)
mk_DownloadCreatedDestinationCallback C_DownloadCreatedDestinationCallback
cb' IO (FunPtr C_DownloadCreatedDestinationCallback)
-> (FunPtr C_DownloadCreatedDestinationCallback
    -> IO (GClosure C_DownloadCreatedDestinationCallback))
-> IO (GClosure C_DownloadCreatedDestinationCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_DownloadCreatedDestinationCallback
-> IO (GClosure C_DownloadCreatedDestinationCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `DownloadCreatedDestinationCallback` into a `C_DownloadCreatedDestinationCallback`.
wrap_DownloadCreatedDestinationCallback ::
    DownloadCreatedDestinationCallback ->
    C_DownloadCreatedDestinationCallback
wrap_DownloadCreatedDestinationCallback :: DownloadCreatedDestinationCallback
-> C_DownloadCreatedDestinationCallback
wrap_DownloadCreatedDestinationCallback DownloadCreatedDestinationCallback
_cb Ptr ()
_ CString
destination Ptr ()
_ = do
    Text
destination' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
destination
    DownloadCreatedDestinationCallback
_cb  Text
destination'


-- | Connect a signal handler for the [createdDestination](#signal:createdDestination) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' download #createdDestination callback
-- @
-- 
-- 
onDownloadCreatedDestination :: (IsDownload a, MonadIO m) => a -> DownloadCreatedDestinationCallback -> m SignalHandlerId
onDownloadCreatedDestination :: a -> DownloadCreatedDestinationCallback -> m SignalHandlerId
onDownloadCreatedDestination a
obj DownloadCreatedDestinationCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DownloadCreatedDestinationCallback
cb' = DownloadCreatedDestinationCallback
-> C_DownloadCreatedDestinationCallback
wrap_DownloadCreatedDestinationCallback DownloadCreatedDestinationCallback
cb
    FunPtr C_DownloadCreatedDestinationCallback
cb'' <- C_DownloadCreatedDestinationCallback
-> IO (FunPtr C_DownloadCreatedDestinationCallback)
mk_DownloadCreatedDestinationCallback C_DownloadCreatedDestinationCallback
cb'
    a
-> Text
-> FunPtr C_DownloadCreatedDestinationCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"created-destination" FunPtr C_DownloadCreatedDestinationCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [createdDestination](#signal:createdDestination) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' download #createdDestination callback
-- @
-- 
-- 
afterDownloadCreatedDestination :: (IsDownload a, MonadIO m) => a -> DownloadCreatedDestinationCallback -> m SignalHandlerId
afterDownloadCreatedDestination :: a -> DownloadCreatedDestinationCallback -> m SignalHandlerId
afterDownloadCreatedDestination a
obj DownloadCreatedDestinationCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DownloadCreatedDestinationCallback
cb' = DownloadCreatedDestinationCallback
-> C_DownloadCreatedDestinationCallback
wrap_DownloadCreatedDestinationCallback DownloadCreatedDestinationCallback
cb
    FunPtr C_DownloadCreatedDestinationCallback
cb'' <- C_DownloadCreatedDestinationCallback
-> IO (FunPtr C_DownloadCreatedDestinationCallback)
mk_DownloadCreatedDestinationCallback C_DownloadCreatedDestinationCallback
cb'
    a
-> Text
-> FunPtr C_DownloadCreatedDestinationCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"created-destination" FunPtr C_DownloadCreatedDestinationCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DownloadCreatedDestinationSignalInfo
instance SignalInfo DownloadCreatedDestinationSignalInfo where
    type HaskellCallbackType DownloadCreatedDestinationSignalInfo = DownloadCreatedDestinationCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DownloadCreatedDestinationCallback cb
        cb'' <- mk_DownloadCreatedDestinationCallback cb'
        connectSignalFunPtr obj "created-destination" cb'' connectMode detail

#endif

-- signal Download::decide-destination
-- | This signal is emitted after response is received to
-- decide a destination URI for the download. If this signal is not
-- handled the file will be downloaded to 'GI.GLib.Enums.UserDirectoryDirectoryDownload'
-- directory using /@suggestedFilename@/.
type DownloadDecideDestinationCallback =
    T.Text
    -- ^ /@suggestedFilename@/: the filename suggested for the download
    -> IO Bool
    -- ^ __Returns:__ 'P.True' to stop other handlers from being invoked for the event.
    --   'P.False' to propagate the event further.

-- | A convenience synonym for @`Nothing` :: `Maybe` `DownloadDecideDestinationCallback`@.
noDownloadDecideDestinationCallback :: Maybe DownloadDecideDestinationCallback
noDownloadDecideDestinationCallback :: Maybe DownloadDecideDestinationCallback
noDownloadDecideDestinationCallback = Maybe DownloadDecideDestinationCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_DownloadDecideDestinationCallback =
    Ptr () ->                               -- object
    CString ->
    Ptr () ->                               -- user_data
    IO CInt

-- | Generate a function pointer callable from C code, from a `C_DownloadDecideDestinationCallback`.
foreign import ccall "wrapper"
    mk_DownloadDecideDestinationCallback :: C_DownloadDecideDestinationCallback -> IO (FunPtr C_DownloadDecideDestinationCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_DownloadDecideDestination :: MonadIO m => DownloadDecideDestinationCallback -> m (GClosure C_DownloadDecideDestinationCallback)
genClosure_DownloadDecideDestination :: DownloadDecideDestinationCallback
-> m (GClosure C_DownloadDecideDestinationCallback)
genClosure_DownloadDecideDestination DownloadDecideDestinationCallback
cb = IO (GClosure C_DownloadDecideDestinationCallback)
-> m (GClosure C_DownloadDecideDestinationCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_DownloadDecideDestinationCallback)
 -> m (GClosure C_DownloadDecideDestinationCallback))
-> IO (GClosure C_DownloadDecideDestinationCallback)
-> m (GClosure C_DownloadDecideDestinationCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DownloadDecideDestinationCallback
cb' = DownloadDecideDestinationCallback
-> C_DownloadDecideDestinationCallback
wrap_DownloadDecideDestinationCallback DownloadDecideDestinationCallback
cb
    C_DownloadDecideDestinationCallback
-> IO (FunPtr C_DownloadDecideDestinationCallback)
mk_DownloadDecideDestinationCallback C_DownloadDecideDestinationCallback
cb' IO (FunPtr C_DownloadDecideDestinationCallback)
-> (FunPtr C_DownloadDecideDestinationCallback
    -> IO (GClosure C_DownloadDecideDestinationCallback))
-> IO (GClosure C_DownloadDecideDestinationCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_DownloadDecideDestinationCallback
-> IO (GClosure C_DownloadDecideDestinationCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `DownloadDecideDestinationCallback` into a `C_DownloadDecideDestinationCallback`.
wrap_DownloadDecideDestinationCallback ::
    DownloadDecideDestinationCallback ->
    C_DownloadDecideDestinationCallback
wrap_DownloadDecideDestinationCallback :: DownloadDecideDestinationCallback
-> C_DownloadDecideDestinationCallback
wrap_DownloadDecideDestinationCallback DownloadDecideDestinationCallback
_cb Ptr ()
_ CString
suggestedFilename Ptr ()
_ = do
    Text
suggestedFilename' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
suggestedFilename
    Bool
result <- DownloadDecideDestinationCallback
_cb  Text
suggestedFilename'
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [decideDestination](#signal:decideDestination) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' download #decideDestination callback
-- @
-- 
-- 
onDownloadDecideDestination :: (IsDownload a, MonadIO m) => a -> DownloadDecideDestinationCallback -> m SignalHandlerId
onDownloadDecideDestination :: a -> DownloadDecideDestinationCallback -> m SignalHandlerId
onDownloadDecideDestination a
obj DownloadDecideDestinationCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DownloadDecideDestinationCallback
cb' = DownloadDecideDestinationCallback
-> C_DownloadDecideDestinationCallback
wrap_DownloadDecideDestinationCallback DownloadDecideDestinationCallback
cb
    FunPtr C_DownloadDecideDestinationCallback
cb'' <- C_DownloadDecideDestinationCallback
-> IO (FunPtr C_DownloadDecideDestinationCallback)
mk_DownloadDecideDestinationCallback C_DownloadDecideDestinationCallback
cb'
    a
-> Text
-> FunPtr C_DownloadDecideDestinationCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"decide-destination" FunPtr C_DownloadDecideDestinationCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [decideDestination](#signal:decideDestination) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' download #decideDestination callback
-- @
-- 
-- 
afterDownloadDecideDestination :: (IsDownload a, MonadIO m) => a -> DownloadDecideDestinationCallback -> m SignalHandlerId
afterDownloadDecideDestination :: a -> DownloadDecideDestinationCallback -> m SignalHandlerId
afterDownloadDecideDestination a
obj DownloadDecideDestinationCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DownloadDecideDestinationCallback
cb' = DownloadDecideDestinationCallback
-> C_DownloadDecideDestinationCallback
wrap_DownloadDecideDestinationCallback DownloadDecideDestinationCallback
cb
    FunPtr C_DownloadDecideDestinationCallback
cb'' <- C_DownloadDecideDestinationCallback
-> IO (FunPtr C_DownloadDecideDestinationCallback)
mk_DownloadDecideDestinationCallback C_DownloadDecideDestinationCallback
cb'
    a
-> Text
-> FunPtr C_DownloadDecideDestinationCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"decide-destination" FunPtr C_DownloadDecideDestinationCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DownloadDecideDestinationSignalInfo
instance SignalInfo DownloadDecideDestinationSignalInfo where
    type HaskellCallbackType DownloadDecideDestinationSignalInfo = DownloadDecideDestinationCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DownloadDecideDestinationCallback cb
        cb'' <- mk_DownloadDecideDestinationCallback cb'
        connectSignalFunPtr obj "decide-destination" cb'' connectMode detail

#endif

-- signal Download::failed
-- | This signal is emitted when an error occurs during the download
-- operation. The given /@error@/, of the domain @/WEBKIT_DOWNLOAD_ERROR/@,
-- contains further details of the failure. If the download is cancelled
-- with 'GI.WebKit2.Objects.Download.downloadCancel', this signal is emitted with error
-- 'GI.WebKit2.Enums.DownloadErrorCancelledByUser'. The download operation finishes
-- after an error and [finished]("GI.WebKit2.Objects.Download#g:signal:finished") signal is emitted after this one.
type DownloadFailedCallback =
    GError
    -- ^ /@error@/: the t'GError' that was triggered
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `DownloadFailedCallback`@.
noDownloadFailedCallback :: Maybe DownloadFailedCallback
noDownloadFailedCallback :: Maybe DownloadFailedCallback
noDownloadFailedCallback = Maybe DownloadFailedCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_DownloadFailedCallback =
    Ptr () ->                               -- object
    Ptr GError ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_DownloadFailedCallback`.
foreign import ccall "wrapper"
    mk_DownloadFailedCallback :: C_DownloadFailedCallback -> IO (FunPtr C_DownloadFailedCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_DownloadFailed :: MonadIO m => DownloadFailedCallback -> m (GClosure C_DownloadFailedCallback)
genClosure_DownloadFailed :: DownloadFailedCallback -> m (GClosure C_DownloadFailedCallback)
genClosure_DownloadFailed DownloadFailedCallback
cb = IO (GClosure C_DownloadFailedCallback)
-> m (GClosure C_DownloadFailedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_DownloadFailedCallback)
 -> m (GClosure C_DownloadFailedCallback))
-> IO (GClosure C_DownloadFailedCallback)
-> m (GClosure C_DownloadFailedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DownloadFailedCallback
cb' = DownloadFailedCallback -> C_DownloadFailedCallback
wrap_DownloadFailedCallback DownloadFailedCallback
cb
    C_DownloadFailedCallback -> IO (FunPtr C_DownloadFailedCallback)
mk_DownloadFailedCallback C_DownloadFailedCallback
cb' IO (FunPtr C_DownloadFailedCallback)
-> (FunPtr C_DownloadFailedCallback
    -> IO (GClosure C_DownloadFailedCallback))
-> IO (GClosure C_DownloadFailedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_DownloadFailedCallback
-> IO (GClosure C_DownloadFailedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `DownloadFailedCallback` into a `C_DownloadFailedCallback`.
wrap_DownloadFailedCallback ::
    DownloadFailedCallback ->
    C_DownloadFailedCallback
wrap_DownloadFailedCallback :: DownloadFailedCallback -> C_DownloadFailedCallback
wrap_DownloadFailedCallback DownloadFailedCallback
_cb Ptr ()
_ Ptr GError
error_ Ptr ()
_ = do
    GError
error_' <- ((ManagedPtr GError -> GError) -> Ptr GError -> IO GError
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr GError -> GError
GError) Ptr GError
error_
    DownloadFailedCallback
_cb  GError
error_'


-- | Connect a signal handler for the [failed](#signal:failed) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' download #failed callback
-- @
-- 
-- 
onDownloadFailed :: (IsDownload a, MonadIO m) => a -> DownloadFailedCallback -> m SignalHandlerId
onDownloadFailed :: a -> DownloadFailedCallback -> m SignalHandlerId
onDownloadFailed a
obj DownloadFailedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DownloadFailedCallback
cb' = DownloadFailedCallback -> C_DownloadFailedCallback
wrap_DownloadFailedCallback DownloadFailedCallback
cb
    FunPtr C_DownloadFailedCallback
cb'' <- C_DownloadFailedCallback -> IO (FunPtr C_DownloadFailedCallback)
mk_DownloadFailedCallback C_DownloadFailedCallback
cb'
    a
-> Text
-> FunPtr C_DownloadFailedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"failed" FunPtr C_DownloadFailedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [failed](#signal:failed) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' download #failed callback
-- @
-- 
-- 
afterDownloadFailed :: (IsDownload a, MonadIO m) => a -> DownloadFailedCallback -> m SignalHandlerId
afterDownloadFailed :: a -> DownloadFailedCallback -> m SignalHandlerId
afterDownloadFailed a
obj DownloadFailedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DownloadFailedCallback
cb' = DownloadFailedCallback -> C_DownloadFailedCallback
wrap_DownloadFailedCallback DownloadFailedCallback
cb
    FunPtr C_DownloadFailedCallback
cb'' <- C_DownloadFailedCallback -> IO (FunPtr C_DownloadFailedCallback)
mk_DownloadFailedCallback C_DownloadFailedCallback
cb'
    a
-> Text
-> FunPtr C_DownloadFailedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"failed" FunPtr C_DownloadFailedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DownloadFailedSignalInfo
instance SignalInfo DownloadFailedSignalInfo where
    type HaskellCallbackType DownloadFailedSignalInfo = DownloadFailedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DownloadFailedCallback cb
        cb'' <- mk_DownloadFailedCallback cb'
        connectSignalFunPtr obj "failed" cb'' connectMode detail

#endif

-- signal Download::finished
-- | This signal is emitted when download finishes successfully or due to an error.
-- In case of errors [failed]("GI.WebKit2.Objects.Download#g:signal:failed") signal is emitted before this one.
type DownloadFinishedCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `DownloadFinishedCallback`@.
noDownloadFinishedCallback :: Maybe DownloadFinishedCallback
noDownloadFinishedCallback :: Maybe (IO ())
noDownloadFinishedCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_DownloadFinishedCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_DownloadFinishedCallback`.
foreign import ccall "wrapper"
    mk_DownloadFinishedCallback :: C_DownloadFinishedCallback -> IO (FunPtr C_DownloadFinishedCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_DownloadFinished :: MonadIO m => DownloadFinishedCallback -> m (GClosure C_DownloadFinishedCallback)
genClosure_DownloadFinished :: IO () -> m (GClosure C_DownloadFinishedCallback)
genClosure_DownloadFinished IO ()
cb = IO (GClosure C_DownloadFinishedCallback)
-> m (GClosure C_DownloadFinishedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_DownloadFinishedCallback)
 -> m (GClosure C_DownloadFinishedCallback))
-> IO (GClosure C_DownloadFinishedCallback)
-> m (GClosure C_DownloadFinishedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DownloadFinishedCallback
cb' = IO () -> C_DownloadFinishedCallback
wrap_DownloadFinishedCallback IO ()
cb
    C_DownloadFinishedCallback
-> IO (FunPtr C_DownloadFinishedCallback)
mk_DownloadFinishedCallback C_DownloadFinishedCallback
cb' IO (FunPtr C_DownloadFinishedCallback)
-> (FunPtr C_DownloadFinishedCallback
    -> IO (GClosure C_DownloadFinishedCallback))
-> IO (GClosure C_DownloadFinishedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_DownloadFinishedCallback
-> IO (GClosure C_DownloadFinishedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `DownloadFinishedCallback` into a `C_DownloadFinishedCallback`.
wrap_DownloadFinishedCallback ::
    DownloadFinishedCallback ->
    C_DownloadFinishedCallback
wrap_DownloadFinishedCallback :: IO () -> C_DownloadFinishedCallback
wrap_DownloadFinishedCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [finished](#signal:finished) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' download #finished callback
-- @
-- 
-- 
onDownloadFinished :: (IsDownload a, MonadIO m) => a -> DownloadFinishedCallback -> m SignalHandlerId
onDownloadFinished :: a -> IO () -> m SignalHandlerId
onDownloadFinished a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DownloadFinishedCallback
cb' = IO () -> C_DownloadFinishedCallback
wrap_DownloadFinishedCallback IO ()
cb
    FunPtr C_DownloadFinishedCallback
cb'' <- C_DownloadFinishedCallback
-> IO (FunPtr C_DownloadFinishedCallback)
mk_DownloadFinishedCallback C_DownloadFinishedCallback
cb'
    a
-> Text
-> FunPtr C_DownloadFinishedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"finished" FunPtr C_DownloadFinishedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [finished](#signal:finished) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' download #finished callback
-- @
-- 
-- 
afterDownloadFinished :: (IsDownload a, MonadIO m) => a -> DownloadFinishedCallback -> m SignalHandlerId
afterDownloadFinished :: a -> IO () -> m SignalHandlerId
afterDownloadFinished a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DownloadFinishedCallback
cb' = IO () -> C_DownloadFinishedCallback
wrap_DownloadFinishedCallback IO ()
cb
    FunPtr C_DownloadFinishedCallback
cb'' <- C_DownloadFinishedCallback
-> IO (FunPtr C_DownloadFinishedCallback)
mk_DownloadFinishedCallback C_DownloadFinishedCallback
cb'
    a
-> Text
-> FunPtr C_DownloadFinishedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"finished" FunPtr C_DownloadFinishedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DownloadFinishedSignalInfo
instance SignalInfo DownloadFinishedSignalInfo where
    type HaskellCallbackType DownloadFinishedSignalInfo = DownloadFinishedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DownloadFinishedCallback cb
        cb'' <- mk_DownloadFinishedCallback cb'
        connectSignalFunPtr obj "finished" cb'' connectMode detail

#endif

-- signal Download::received-data
-- | This signal is emitted after response is received,
-- every time new data has been written to the destination. It\'s
-- useful to know the progress of the download operation.
type DownloadReceivedDataCallback =
    Word64
    -- ^ /@dataLength@/: the length of data received in bytes
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `DownloadReceivedDataCallback`@.
noDownloadReceivedDataCallback :: Maybe DownloadReceivedDataCallback
noDownloadReceivedDataCallback :: Maybe DownloadReceivedDataCallback
noDownloadReceivedDataCallback = Maybe DownloadReceivedDataCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_DownloadReceivedDataCallback =
    Ptr () ->                               -- object
    Word64 ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_DownloadReceivedDataCallback`.
foreign import ccall "wrapper"
    mk_DownloadReceivedDataCallback :: C_DownloadReceivedDataCallback -> IO (FunPtr C_DownloadReceivedDataCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_DownloadReceivedData :: MonadIO m => DownloadReceivedDataCallback -> m (GClosure C_DownloadReceivedDataCallback)
genClosure_DownloadReceivedData :: DownloadReceivedDataCallback
-> m (GClosure C_DownloadReceivedDataCallback)
genClosure_DownloadReceivedData DownloadReceivedDataCallback
cb = IO (GClosure C_DownloadReceivedDataCallback)
-> m (GClosure C_DownloadReceivedDataCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_DownloadReceivedDataCallback)
 -> m (GClosure C_DownloadReceivedDataCallback))
-> IO (GClosure C_DownloadReceivedDataCallback)
-> m (GClosure C_DownloadReceivedDataCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DownloadReceivedDataCallback
cb' = DownloadReceivedDataCallback -> C_DownloadReceivedDataCallback
wrap_DownloadReceivedDataCallback DownloadReceivedDataCallback
cb
    C_DownloadReceivedDataCallback
-> IO (FunPtr C_DownloadReceivedDataCallback)
mk_DownloadReceivedDataCallback C_DownloadReceivedDataCallback
cb' IO (FunPtr C_DownloadReceivedDataCallback)
-> (FunPtr C_DownloadReceivedDataCallback
    -> IO (GClosure C_DownloadReceivedDataCallback))
-> IO (GClosure C_DownloadReceivedDataCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_DownloadReceivedDataCallback
-> IO (GClosure C_DownloadReceivedDataCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `DownloadReceivedDataCallback` into a `C_DownloadReceivedDataCallback`.
wrap_DownloadReceivedDataCallback ::
    DownloadReceivedDataCallback ->
    C_DownloadReceivedDataCallback
wrap_DownloadReceivedDataCallback :: DownloadReceivedDataCallback -> C_DownloadReceivedDataCallback
wrap_DownloadReceivedDataCallback DownloadReceivedDataCallback
_cb Ptr ()
_ Word64
dataLength Ptr ()
_ = do
    DownloadReceivedDataCallback
_cb  Word64
dataLength


-- | Connect a signal handler for the [receivedData](#signal:receivedData) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' download #receivedData callback
-- @
-- 
-- 
onDownloadReceivedData :: (IsDownload a, MonadIO m) => a -> DownloadReceivedDataCallback -> m SignalHandlerId
onDownloadReceivedData :: a -> DownloadReceivedDataCallback -> m SignalHandlerId
onDownloadReceivedData a
obj DownloadReceivedDataCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DownloadReceivedDataCallback
cb' = DownloadReceivedDataCallback -> C_DownloadReceivedDataCallback
wrap_DownloadReceivedDataCallback DownloadReceivedDataCallback
cb
    FunPtr C_DownloadReceivedDataCallback
cb'' <- C_DownloadReceivedDataCallback
-> IO (FunPtr C_DownloadReceivedDataCallback)
mk_DownloadReceivedDataCallback C_DownloadReceivedDataCallback
cb'
    a
-> Text
-> FunPtr C_DownloadReceivedDataCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"received-data" FunPtr C_DownloadReceivedDataCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [receivedData](#signal:receivedData) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' download #receivedData callback
-- @
-- 
-- 
afterDownloadReceivedData :: (IsDownload a, MonadIO m) => a -> DownloadReceivedDataCallback -> m SignalHandlerId
afterDownloadReceivedData :: a -> DownloadReceivedDataCallback -> m SignalHandlerId
afterDownloadReceivedData a
obj DownloadReceivedDataCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DownloadReceivedDataCallback
cb' = DownloadReceivedDataCallback -> C_DownloadReceivedDataCallback
wrap_DownloadReceivedDataCallback DownloadReceivedDataCallback
cb
    FunPtr C_DownloadReceivedDataCallback
cb'' <- C_DownloadReceivedDataCallback
-> IO (FunPtr C_DownloadReceivedDataCallback)
mk_DownloadReceivedDataCallback C_DownloadReceivedDataCallback
cb'
    a
-> Text
-> FunPtr C_DownloadReceivedDataCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"received-data" FunPtr C_DownloadReceivedDataCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DownloadReceivedDataSignalInfo
instance SignalInfo DownloadReceivedDataSignalInfo where
    type HaskellCallbackType DownloadReceivedDataSignalInfo = DownloadReceivedDataCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DownloadReceivedDataCallback cb
        cb'' <- mk_DownloadReceivedDataCallback cb'
        connectSignalFunPtr obj "received-data" cb'' connectMode detail

#endif

-- VVV Prop "allow-overwrite"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@allow-overwrite@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' download #allowOverwrite
-- @
getDownloadAllowOverwrite :: (MonadIO m, IsDownload o) => o -> m Bool
getDownloadAllowOverwrite :: o -> m Bool
getDownloadAllowOverwrite o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"allow-overwrite"

-- | Set the value of the “@allow-overwrite@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' download [ #allowOverwrite 'Data.GI.Base.Attributes.:=' value ]
-- @
setDownloadAllowOverwrite :: (MonadIO m, IsDownload o) => o -> Bool -> m ()
setDownloadAllowOverwrite :: o -> Bool -> m ()
setDownloadAllowOverwrite o
obj Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"allow-overwrite" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@allow-overwrite@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDownloadAllowOverwrite :: (IsDownload o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructDownloadAllowOverwrite :: Bool -> m (GValueConstruct o)
constructDownloadAllowOverwrite Bool
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
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"allow-overwrite" Bool
val

#if defined(ENABLE_OVERLOADING)
data DownloadAllowOverwritePropertyInfo
instance AttrInfo DownloadAllowOverwritePropertyInfo where
    type AttrAllowedOps DownloadAllowOverwritePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DownloadAllowOverwritePropertyInfo = IsDownload
    type AttrSetTypeConstraint DownloadAllowOverwritePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint DownloadAllowOverwritePropertyInfo = (~) Bool
    type AttrTransferType DownloadAllowOverwritePropertyInfo = Bool
    type AttrGetType DownloadAllowOverwritePropertyInfo = Bool
    type AttrLabel DownloadAllowOverwritePropertyInfo = "allow-overwrite"
    type AttrOrigin DownloadAllowOverwritePropertyInfo = Download
    attrGet = getDownloadAllowOverwrite
    attrSet = setDownloadAllowOverwrite
    attrTransfer _ v = do
        return v
    attrConstruct = constructDownloadAllowOverwrite
    attrClear = undefined
#endif

-- VVV Prop "destination"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Just True,Just False)

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

#if defined(ENABLE_OVERLOADING)
data DownloadDestinationPropertyInfo
instance AttrInfo DownloadDestinationPropertyInfo where
    type AttrAllowedOps DownloadDestinationPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DownloadDestinationPropertyInfo = IsDownload
    type AttrSetTypeConstraint DownloadDestinationPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DownloadDestinationPropertyInfo = (~) ()
    type AttrTransferType DownloadDestinationPropertyInfo = ()
    type AttrGetType DownloadDestinationPropertyInfo = (Maybe T.Text)
    type AttrLabel DownloadDestinationPropertyInfo = "destination"
    type AttrOrigin DownloadDestinationPropertyInfo = Download
    attrGet = getDownloadDestination
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "estimated-progress"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@estimated-progress@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' download #estimatedProgress
-- @
getDownloadEstimatedProgress :: (MonadIO m, IsDownload o) => o -> m Double
getDownloadEstimatedProgress :: o -> m Double
getDownloadEstimatedProgress o
obj = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Double
forall a. GObject a => a -> String -> IO Double
B.Properties.getObjectPropertyDouble o
obj String
"estimated-progress"

#if defined(ENABLE_OVERLOADING)
data DownloadEstimatedProgressPropertyInfo
instance AttrInfo DownloadEstimatedProgressPropertyInfo where
    type AttrAllowedOps DownloadEstimatedProgressPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DownloadEstimatedProgressPropertyInfo = IsDownload
    type AttrSetTypeConstraint DownloadEstimatedProgressPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DownloadEstimatedProgressPropertyInfo = (~) ()
    type AttrTransferType DownloadEstimatedProgressPropertyInfo = ()
    type AttrGetType DownloadEstimatedProgressPropertyInfo = Double
    type AttrLabel DownloadEstimatedProgressPropertyInfo = "estimated-progress"
    type AttrOrigin DownloadEstimatedProgressPropertyInfo = Download
    attrGet = getDownloadEstimatedProgress
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "response"
   -- Type: TInterface (Name {namespace = "WebKit2", name = "URIResponse"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just True,Nothing)

-- | Get the value of the “@response@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' download #response
-- @
getDownloadResponse :: (MonadIO m, IsDownload o) => o -> m (Maybe WebKit2.URIResponse.URIResponse)
getDownloadResponse :: o -> m (Maybe URIResponse)
getDownloadResponse o
obj = IO (Maybe URIResponse) -> m (Maybe URIResponse)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe URIResponse) -> m (Maybe URIResponse))
-> IO (Maybe URIResponse) -> m (Maybe URIResponse)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr URIResponse -> URIResponse)
-> IO (Maybe URIResponse)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"response" ManagedPtr URIResponse -> URIResponse
WebKit2.URIResponse.URIResponse

#if defined(ENABLE_OVERLOADING)
data DownloadResponsePropertyInfo
instance AttrInfo DownloadResponsePropertyInfo where
    type AttrAllowedOps DownloadResponsePropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DownloadResponsePropertyInfo = IsDownload
    type AttrSetTypeConstraint DownloadResponsePropertyInfo = (~) ()
    type AttrTransferTypeConstraint DownloadResponsePropertyInfo = (~) ()
    type AttrTransferType DownloadResponsePropertyInfo = ()
    type AttrGetType DownloadResponsePropertyInfo = (Maybe WebKit2.URIResponse.URIResponse)
    type AttrLabel DownloadResponsePropertyInfo = "response"
    type AttrOrigin DownloadResponsePropertyInfo = Download
    attrGet = getDownloadResponse
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Download
type instance O.AttributeList Download = DownloadAttributeList
type DownloadAttributeList = ('[ '("allowOverwrite", DownloadAllowOverwritePropertyInfo), '("destination", DownloadDestinationPropertyInfo), '("estimatedProgress", DownloadEstimatedProgressPropertyInfo), '("response", DownloadResponsePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
downloadAllowOverwrite :: AttrLabelProxy "allowOverwrite"
downloadAllowOverwrite = AttrLabelProxy

downloadDestination :: AttrLabelProxy "destination"
downloadDestination = AttrLabelProxy

downloadEstimatedProgress :: AttrLabelProxy "estimatedProgress"
downloadEstimatedProgress = AttrLabelProxy

downloadResponse :: AttrLabelProxy "response"
downloadResponse = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Download = DownloadSignalList
type DownloadSignalList = ('[ '("createdDestination", DownloadCreatedDestinationSignalInfo), '("decideDestination", DownloadDecideDestinationSignalInfo), '("failed", DownloadFailedSignalInfo), '("finished", DownloadFinishedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("receivedData", DownloadReceivedDataSignalInfo)] :: [(Symbol, *)])

#endif

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

foreign import ccall "webkit_download_cancel" webkit_download_cancel :: 
    Ptr Download ->                         -- download : TInterface (Name {namespace = "WebKit2", name = "Download"})
    IO ()

-- | Cancels the download. When the ongoing download
-- operation is effectively cancelled the signal
-- [failed]("GI.WebKit2.Objects.Download#g:signal:failed") is emitted with
-- 'GI.WebKit2.Enums.DownloadErrorCancelledByUser' error.
downloadCancel ::
    (B.CallStack.HasCallStack, MonadIO m, IsDownload a) =>
    a
    -- ^ /@download@/: a t'GI.WebKit2.Objects.Download.Download'
    -> m ()
downloadCancel :: a -> m ()
downloadCancel a
download = 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 Download
download' <- a -> IO (Ptr Download)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
download
    Ptr Download -> IO ()
webkit_download_cancel Ptr Download
download'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
download
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DownloadCancelMethodInfo
instance (signature ~ (m ()), MonadIO m, IsDownload a) => O.MethodInfo DownloadCancelMethodInfo a signature where
    overloadedMethod = downloadCancel

#endif

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

foreign import ccall "webkit_download_get_allow_overwrite" webkit_download_get_allow_overwrite :: 
    Ptr Download ->                         -- download : TInterface (Name {namespace = "WebKit2", name = "Download"})
    IO CInt

-- | Returns the current value of the t'GI.WebKit2.Objects.Download.Download':@/allow-overwrite/@ property,
-- which determines whether the download will overwrite an existing file on
-- disk, or if it will fail if the destination already exists.
-- 
-- /Since: 2.6/
downloadGetAllowOverwrite ::
    (B.CallStack.HasCallStack, MonadIO m, IsDownload a) =>
    a
    -- ^ /@download@/: a t'GI.WebKit2.Objects.Download.Download'
    -> m Bool
    -- ^ __Returns:__ the current value of the t'GI.WebKit2.Objects.Download.Download':@/allow-overwrite/@ property
downloadGetAllowOverwrite :: a -> m Bool
downloadGetAllowOverwrite a
download = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Download
download' <- a -> IO (Ptr Download)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
download
    CInt
result <- Ptr Download -> IO CInt
webkit_download_get_allow_overwrite Ptr Download
download'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
download
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DownloadGetAllowOverwriteMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDownload a) => O.MethodInfo DownloadGetAllowOverwriteMethodInfo a signature where
    overloadedMethod = downloadGetAllowOverwrite

#endif

-- method Download::get_destination
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "download"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "Download" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitDownload" , 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_download_get_destination" webkit_download_get_destination :: 
    Ptr Download ->                         -- download : TInterface (Name {namespace = "WebKit2", name = "Download"})
    IO CString

-- | Obtains the URI to which the downloaded file will be written. You
-- can connect to [createdDestination]("GI.WebKit2.Objects.Download#g:signal:createdDestination") to make
-- sure this method returns a valid destination.
downloadGetDestination ::
    (B.CallStack.HasCallStack, MonadIO m, IsDownload a) =>
    a
    -- ^ /@download@/: a t'GI.WebKit2.Objects.Download.Download'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the destination URI or 'P.Nothing'
downloadGetDestination :: a -> m (Maybe Text)
downloadGetDestination a
download = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Download
download' <- a -> IO (Ptr Download)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
download
    CString
result <- Ptr Download -> IO CString
webkit_download_get_destination Ptr Download
download'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
download
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data DownloadGetDestinationMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsDownload a) => O.MethodInfo DownloadGetDestinationMethodInfo a signature where
    overloadedMethod = downloadGetDestination

#endif

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

foreign import ccall "webkit_download_get_elapsed_time" webkit_download_get_elapsed_time :: 
    Ptr Download ->                         -- download : TInterface (Name {namespace = "WebKit2", name = "Download"})
    IO CDouble

-- | Gets the elapsed time in seconds, including any fractional part.
-- If the download finished, had an error or was cancelled this is
-- the time between its start and the event.
downloadGetElapsedTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsDownload a) =>
    a
    -- ^ /@download@/: a t'GI.WebKit2.Objects.Download.Download'
    -> m Double
    -- ^ __Returns:__ seconds since the download was started
downloadGetElapsedTime :: a -> m Double
downloadGetElapsedTime a
download = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr Download
download' <- a -> IO (Ptr Download)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
download
    CDouble
result <- Ptr Download -> IO CDouble
webkit_download_get_elapsed_time Ptr Download
download'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
download
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data DownloadGetElapsedTimeMethodInfo
instance (signature ~ (m Double), MonadIO m, IsDownload a) => O.MethodInfo DownloadGetElapsedTimeMethodInfo a signature where
    overloadedMethod = downloadGetElapsedTime

#endif

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

foreign import ccall "webkit_download_get_estimated_progress" webkit_download_get_estimated_progress :: 
    Ptr Download ->                         -- download : TInterface (Name {namespace = "WebKit2", name = "Download"})
    IO CDouble

-- | Gets the value of the t'GI.WebKit2.Objects.Download.Download':@/estimated-progress/@ property.
-- You can monitor the estimated progress of the download operation by
-- connecting to the notify[estimatedProgress](#g:signal:estimatedProgress) signal of /@download@/.
downloadGetEstimatedProgress ::
    (B.CallStack.HasCallStack, MonadIO m, IsDownload a) =>
    a
    -- ^ /@download@/: a t'GI.WebKit2.Objects.Download.Download'
    -> m Double
    -- ^ __Returns:__ an estimate of the of the percent complete for a download
    --     as a range from 0.0 to 1.0.
downloadGetEstimatedProgress :: a -> m Double
downloadGetEstimatedProgress a
download = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr Download
download' <- a -> IO (Ptr Download)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
download
    CDouble
result <- Ptr Download -> IO CDouble
webkit_download_get_estimated_progress Ptr Download
download'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
download
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data DownloadGetEstimatedProgressMethodInfo
instance (signature ~ (m Double), MonadIO m, IsDownload a) => O.MethodInfo DownloadGetEstimatedProgressMethodInfo a signature where
    overloadedMethod = downloadGetEstimatedProgress

#endif

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

foreign import ccall "webkit_download_get_received_data_length" webkit_download_get_received_data_length :: 
    Ptr Download ->                         -- download : TInterface (Name {namespace = "WebKit2", name = "Download"})
    IO Word64

-- | Gets the length of the data already downloaded for /@download@/
-- in bytes.
downloadGetReceivedDataLength ::
    (B.CallStack.HasCallStack, MonadIO m, IsDownload a) =>
    a
    -- ^ /@download@/: a t'GI.WebKit2.Objects.Download.Download'
    -> m Word64
    -- ^ __Returns:__ the amount of bytes already downloaded.
downloadGetReceivedDataLength :: a -> m Word64
downloadGetReceivedDataLength a
download = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Download
download' <- a -> IO (Ptr Download)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
download
    Word64
result <- Ptr Download -> IO Word64
webkit_download_get_received_data_length Ptr Download
download'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
download
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data DownloadGetReceivedDataLengthMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsDownload a) => O.MethodInfo DownloadGetReceivedDataLengthMethodInfo a signature where
    overloadedMethod = downloadGetReceivedDataLength

#endif

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

foreign import ccall "webkit_download_get_request" webkit_download_get_request :: 
    Ptr Download ->                         -- download : TInterface (Name {namespace = "WebKit2", name = "Download"})
    IO (Ptr WebKit2.URIRequest.URIRequest)

-- | Retrieves the t'GI.WebKit2.Objects.URIRequest.URIRequest' object that backs the download
-- process.
downloadGetRequest ::
    (B.CallStack.HasCallStack, MonadIO m, IsDownload a) =>
    a
    -- ^ /@download@/: a t'GI.WebKit2.Objects.Download.Download'
    -> m WebKit2.URIRequest.URIRequest
    -- ^ __Returns:__ the t'GI.WebKit2.Objects.URIRequest.URIRequest' of /@download@/
downloadGetRequest :: a -> m URIRequest
downloadGetRequest a
download = IO URIRequest -> m URIRequest
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO URIRequest -> m URIRequest) -> IO URIRequest -> m URIRequest
forall a b. (a -> b) -> a -> b
$ do
    Ptr Download
download' <- a -> IO (Ptr Download)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
download
    Ptr URIRequest
result <- Ptr Download -> IO (Ptr URIRequest)
webkit_download_get_request Ptr Download
download'
    Text -> Ptr URIRequest -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"downloadGetRequest" Ptr URIRequest
result
    URIRequest
result' <- ((ManagedPtr URIRequest -> URIRequest)
-> Ptr URIRequest -> IO URIRequest
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr URIRequest -> URIRequest
WebKit2.URIRequest.URIRequest) Ptr URIRequest
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
download
    URIRequest -> IO URIRequest
forall (m :: * -> *) a. Monad m => a -> m a
return URIRequest
result'

#if defined(ENABLE_OVERLOADING)
data DownloadGetRequestMethodInfo
instance (signature ~ (m WebKit2.URIRequest.URIRequest), MonadIO m, IsDownload a) => O.MethodInfo DownloadGetRequestMethodInfo a signature where
    overloadedMethod = downloadGetRequest

#endif

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

foreign import ccall "webkit_download_get_response" webkit_download_get_response :: 
    Ptr Download ->                         -- download : TInterface (Name {namespace = "WebKit2", name = "Download"})
    IO (Ptr WebKit2.URIResponse.URIResponse)

-- | Retrieves the t'GI.WebKit2.Objects.URIResponse.URIResponse' object that backs the download
-- process. This method returns 'P.Nothing' if called before the response
-- is received from the server. You can connect to notify[response](#g:signal:response)
-- signal to be notified when the response is received.
downloadGetResponse ::
    (B.CallStack.HasCallStack, MonadIO m, IsDownload a) =>
    a
    -- ^ /@download@/: a t'GI.WebKit2.Objects.Download.Download'
    -> m (Maybe WebKit2.URIResponse.URIResponse)
    -- ^ __Returns:__ the t'GI.WebKit2.Objects.URIResponse.URIResponse', or 'P.Nothing' if
    --     the response hasn\'t been received yet.
downloadGetResponse :: a -> m (Maybe URIResponse)
downloadGetResponse a
download = IO (Maybe URIResponse) -> m (Maybe URIResponse)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe URIResponse) -> m (Maybe URIResponse))
-> IO (Maybe URIResponse) -> m (Maybe URIResponse)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Download
download' <- a -> IO (Ptr Download)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
download
    Ptr URIResponse
result <- Ptr Download -> IO (Ptr URIResponse)
webkit_download_get_response Ptr Download
download'
    Maybe URIResponse
maybeResult <- Ptr URIResponse
-> (Ptr URIResponse -> IO URIResponse) -> IO (Maybe URIResponse)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr URIResponse
result ((Ptr URIResponse -> IO URIResponse) -> IO (Maybe URIResponse))
-> (Ptr URIResponse -> IO URIResponse) -> IO (Maybe URIResponse)
forall a b. (a -> b) -> a -> b
$ \Ptr URIResponse
result' -> do
        URIResponse
result'' <- ((ManagedPtr URIResponse -> URIResponse)
-> Ptr URIResponse -> IO URIResponse
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr URIResponse -> URIResponse
WebKit2.URIResponse.URIResponse) Ptr URIResponse
result'
        URIResponse -> IO URIResponse
forall (m :: * -> *) a. Monad m => a -> m a
return URIResponse
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
download
    Maybe URIResponse -> IO (Maybe URIResponse)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe URIResponse
maybeResult

#if defined(ENABLE_OVERLOADING)
data DownloadGetResponseMethodInfo
instance (signature ~ (m (Maybe WebKit2.URIResponse.URIResponse)), MonadIO m, IsDownload a) => O.MethodInfo DownloadGetResponseMethodInfo a signature where
    overloadedMethod = downloadGetResponse

#endif

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

foreign import ccall "webkit_download_get_web_view" webkit_download_get_web_view :: 
    Ptr Download ->                         -- download : TInterface (Name {namespace = "WebKit2", name = "Download"})
    IO (Ptr WebKit2.WebView.WebView)

-- | Get the t'GI.WebKit2.Objects.WebView.WebView' that initiated the download.
downloadGetWebView ::
    (B.CallStack.HasCallStack, MonadIO m, IsDownload a) =>
    a
    -- ^ /@download@/: a t'GI.WebKit2.Objects.Download.Download'
    -> m (Maybe WebKit2.WebView.WebView)
    -- ^ __Returns:__ the t'GI.WebKit2.Objects.WebView.WebView' that initiated /@download@/,
    --    or 'P.Nothing' if /@download@/ was not initiated by a t'GI.WebKit2.Objects.WebView.WebView'.
downloadGetWebView :: a -> m (Maybe WebView)
downloadGetWebView a
download = IO (Maybe WebView) -> m (Maybe WebView)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe WebView) -> m (Maybe WebView))
-> IO (Maybe WebView) -> m (Maybe WebView)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Download
download' <- a -> IO (Ptr Download)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
download
    Ptr WebView
result <- Ptr Download -> IO (Ptr WebView)
webkit_download_get_web_view Ptr Download
download'
    Maybe WebView
maybeResult <- Ptr WebView -> (Ptr WebView -> IO WebView) -> IO (Maybe WebView)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr WebView
result ((Ptr WebView -> IO WebView) -> IO (Maybe WebView))
-> (Ptr WebView -> IO WebView) -> IO (Maybe WebView)
forall a b. (a -> b) -> a -> b
$ \Ptr WebView
result' -> do
        WebView
result'' <- ((ManagedPtr WebView -> WebView) -> Ptr WebView -> IO WebView
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr WebView -> WebView
WebKit2.WebView.WebView) Ptr WebView
result'
        WebView -> IO WebView
forall (m :: * -> *) a. Monad m => a -> m a
return WebView
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
download
    Maybe WebView -> IO (Maybe WebView)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe WebView
maybeResult

#if defined(ENABLE_OVERLOADING)
data DownloadGetWebViewMethodInfo
instance (signature ~ (m (Maybe WebKit2.WebView.WebView)), MonadIO m, IsDownload a) => O.MethodInfo DownloadGetWebViewMethodInfo a signature where
    overloadedMethod = downloadGetWebView

#endif

-- method Download::set_allow_overwrite
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "download"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "Download" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitDownload" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "allowed"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the new value for the #WebKitDownload:allow-overwrite property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_download_set_allow_overwrite" webkit_download_set_allow_overwrite :: 
    Ptr Download ->                         -- download : TInterface (Name {namespace = "WebKit2", name = "Download"})
    CInt ->                                 -- allowed : TBasicType TBoolean
    IO ()

-- | Sets the t'GI.WebKit2.Objects.Download.Download':@/allow-overwrite/@ property, which determines whether
-- the download may overwrite an existing file on disk, or if it will fail if
-- the destination already exists.
-- 
-- /Since: 2.6/
downloadSetAllowOverwrite ::
    (B.CallStack.HasCallStack, MonadIO m, IsDownload a) =>
    a
    -- ^ /@download@/: a t'GI.WebKit2.Objects.Download.Download'
    -> Bool
    -- ^ /@allowed@/: the new value for the t'GI.WebKit2.Objects.Download.Download':@/allow-overwrite/@ property
    -> m ()
downloadSetAllowOverwrite :: a -> Bool -> m ()
downloadSetAllowOverwrite a
download Bool
allowed = 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 Download
download' <- a -> IO (Ptr Download)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
download
    let allowed' :: CInt
allowed' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
allowed
    Ptr Download -> CInt -> IO ()
webkit_download_set_allow_overwrite Ptr Download
download' CInt
allowed'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
download
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DownloadSetAllowOverwriteMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsDownload a) => O.MethodInfo DownloadSetAllowOverwriteMethodInfo a signature where
    overloadedMethod = downloadSetAllowOverwrite

#endif

-- method Download::set_destination
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "download"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "Download" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitDownload" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the destination URI"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_download_set_destination" webkit_download_set_destination :: 
    Ptr Download ->                         -- download : TInterface (Name {namespace = "WebKit2", name = "Download"})
    CString ->                              -- uri : TBasicType TUTF8
    IO ()

-- | Sets the URI to which the downloaded file will be written.
-- This method should be called before the download transfer
-- starts or it will not have any effect on the ongoing download
-- operation. To set the destination using the filename suggested
-- by the server connect to [decideDestination]("GI.WebKit2.Objects.Download#g:signal:decideDestination")
-- signal and call 'GI.WebKit2.Objects.Download.downloadSetDestination'. If you want to
-- set a fixed destination URI that doesn\'t depend on the suggested
-- filename you can connect to notify[response](#g:signal:response) signal and call
-- 'GI.WebKit2.Objects.Download.downloadSetDestination'.
-- If [decideDestination]("GI.WebKit2.Objects.Download#g:signal:decideDestination") signal is not handled
-- and destination URI is not set when the download transfer starts,
-- the file will be saved with the filename suggested by the server in
-- 'GI.GLib.Enums.UserDirectoryDirectoryDownload' directory.
downloadSetDestination ::
    (B.CallStack.HasCallStack, MonadIO m, IsDownload a) =>
    a
    -- ^ /@download@/: a t'GI.WebKit2.Objects.Download.Download'
    -> T.Text
    -- ^ /@uri@/: the destination URI
    -> m ()
downloadSetDestination :: a -> Text -> m ()
downloadSetDestination a
download Text
uri = 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 Download
download' <- a -> IO (Ptr Download)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
download
    CString
uri' <- Text -> IO CString
textToCString Text
uri
    Ptr Download -> CString -> IO ()
webkit_download_set_destination Ptr Download
download' CString
uri'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
download
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DownloadSetDestinationMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsDownload a) => O.MethodInfo DownloadSetDestinationMethodInfo a signature where
    overloadedMethod = downloadSetDestination

#endif