{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- 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.Soup.Objects.Logger
    ( 

-- * Exported types
    Logger(..)                              ,
    IsLogger                                ,
    toLogger                                ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addFeature]("GI.Soup.Interfaces.SessionFeature#g:method:addFeature"), [attach]("GI.Soup.Objects.Logger#g:method:attach"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [detach]("GI.Soup.Objects.Logger#g:method:detach"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasFeature]("GI.Soup.Interfaces.SessionFeature#g:method:hasFeature"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [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"), [removeFeature]("GI.Soup.Interfaces.SessionFeature#g:method:removeFeature"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [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"), [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"), [setPrinter]("GI.Soup.Objects.Logger#g:method:setPrinter"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setRequestFilter]("GI.Soup.Objects.Logger#g:method:setRequestFilter"), [setResponseFilter]("GI.Soup.Objects.Logger#g:method:setResponseFilter").

#if defined(ENABLE_OVERLOADING)
    ResolveLoggerMethod                     ,
#endif

-- ** attach #method:attach#

#if defined(ENABLE_OVERLOADING)
    LoggerAttachMethodInfo                  ,
#endif
    loggerAttach                            ,


-- ** detach #method:detach#

#if defined(ENABLE_OVERLOADING)
    LoggerDetachMethodInfo                  ,
#endif
    loggerDetach                            ,


-- ** new #method:new#

    loggerNew                               ,


-- ** setPrinter #method:setPrinter#

#if defined(ENABLE_OVERLOADING)
    LoggerSetPrinterMethodInfo              ,
#endif
    loggerSetPrinter                        ,


-- ** setRequestFilter #method:setRequestFilter#

#if defined(ENABLE_OVERLOADING)
    LoggerSetRequestFilterMethodInfo        ,
#endif
    loggerSetRequestFilter                  ,


-- ** setResponseFilter #method:setResponseFilter#

#if defined(ENABLE_OVERLOADING)
    LoggerSetResponseFilterMethodInfo       ,
#endif
    loggerSetResponseFilter                 ,




 -- * Properties


-- ** level #attr:level#
-- | The level of logging output
-- 
-- /Since: 2.56/

#if defined(ENABLE_OVERLOADING)
    LoggerLevelPropertyInfo                 ,
#endif
    constructLoggerLevel                    ,
    getLoggerLevel                          ,
#if defined(ENABLE_OVERLOADING)
    loggerLevel                             ,
#endif
    setLoggerLevel                          ,


-- ** maxBodySize #attr:maxBodySize#
-- | If [Logger:level]("GI.Soup.Objects.Logger#g:attr:level") is 'GI.Soup.Enums.LoggerLogLevelBody', this gives
-- the maximum number of bytes of the body that will be logged.
-- (-1 means \"no limit\".)
-- 
-- /Since: 2.56/

#if defined(ENABLE_OVERLOADING)
    LoggerMaxBodySizePropertyInfo           ,
#endif
    constructLoggerMaxBodySize              ,
    getLoggerMaxBodySize                    ,
#if defined(ENABLE_OVERLOADING)
    loggerMaxBodySize                       ,
#endif
    setLoggerMaxBodySize                    ,




    ) 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.GHashTable as B.GHT
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.Coerce as Coerce
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.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Soup.Callbacks as Soup.Callbacks
import {-# SOURCE #-} qualified GI.Soup.Enums as Soup.Enums
import {-# SOURCE #-} qualified GI.Soup.Interfaces.SessionFeature as Soup.SessionFeature
import {-# SOURCE #-} qualified GI.Soup.Objects.Session as Soup.Session

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

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

foreign import ccall "soup_logger_get_type"
    c_soup_logger_get_type :: IO B.Types.GType

instance B.Types.TypedObject Logger where
    glibType :: IO GType
glibType = IO GType
c_soup_logger_get_type

instance B.Types.GObject Logger

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

instance O.HasParentTypes Logger
type instance O.ParentTypes Logger = '[GObject.Object.Object, Soup.SessionFeature.SessionFeature]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveLoggerMethod (t :: Symbol) (o :: *) :: * where
    ResolveLoggerMethod "addFeature" o = Soup.SessionFeature.SessionFeatureAddFeatureMethodInfo
    ResolveLoggerMethod "attach" o = LoggerAttachMethodInfo
    ResolveLoggerMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveLoggerMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveLoggerMethod "detach" o = LoggerDetachMethodInfo
    ResolveLoggerMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveLoggerMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveLoggerMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveLoggerMethod "hasFeature" o = Soup.SessionFeature.SessionFeatureHasFeatureMethodInfo
    ResolveLoggerMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveLoggerMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveLoggerMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveLoggerMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveLoggerMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveLoggerMethod "removeFeature" o = Soup.SessionFeature.SessionFeatureRemoveFeatureMethodInfo
    ResolveLoggerMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveLoggerMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveLoggerMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveLoggerMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveLoggerMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveLoggerMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveLoggerMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveLoggerMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveLoggerMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveLoggerMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveLoggerMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveLoggerMethod "setPrinter" o = LoggerSetPrinterMethodInfo
    ResolveLoggerMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveLoggerMethod "setRequestFilter" o = LoggerSetRequestFilterMethodInfo
    ResolveLoggerMethod "setResponseFilter" o = LoggerSetResponseFilterMethodInfo
    ResolveLoggerMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "level"
   -- Type: TInterface (Name {namespace = "Soup", name = "LoggerLogLevel"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@level@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' logger #level
-- @
getLoggerLevel :: (MonadIO m, IsLogger o) => o -> m Soup.Enums.LoggerLogLevel
getLoggerLevel :: forall (m :: * -> *) o.
(MonadIO m, IsLogger o) =>
o -> m LoggerLogLevel
getLoggerLevel o
obj = IO LoggerLogLevel -> m LoggerLogLevel
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO LoggerLogLevel -> m LoggerLogLevel)
-> IO LoggerLogLevel -> m LoggerLogLevel
forall a b. (a -> b) -> a -> b
$ o -> String -> IO LoggerLogLevel
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"level"

-- | Set the value of the “@level@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' logger [ #level 'Data.GI.Base.Attributes.:=' value ]
-- @
setLoggerLevel :: (MonadIO m, IsLogger o) => o -> Soup.Enums.LoggerLogLevel -> m ()
setLoggerLevel :: forall (m :: * -> *) o.
(MonadIO m, IsLogger o) =>
o -> LoggerLogLevel -> m ()
setLoggerLevel o
obj LoggerLogLevel
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> LoggerLogLevel -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"level" LoggerLogLevel
val

-- | Construct a `GValueConstruct` with valid value for the “@level@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructLoggerLevel :: (IsLogger o, MIO.MonadIO m) => Soup.Enums.LoggerLogLevel -> m (GValueConstruct o)
constructLoggerLevel :: forall o (m :: * -> *).
(IsLogger o, MonadIO m) =>
LoggerLogLevel -> m (GValueConstruct o)
constructLoggerLevel LoggerLogLevel
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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 -> LoggerLogLevel -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"level" LoggerLogLevel
val

#if defined(ENABLE_OVERLOADING)
data LoggerLevelPropertyInfo
instance AttrInfo LoggerLevelPropertyInfo where
    type AttrAllowedOps LoggerLevelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint LoggerLevelPropertyInfo = IsLogger
    type AttrSetTypeConstraint LoggerLevelPropertyInfo = (~) Soup.Enums.LoggerLogLevel
    type AttrTransferTypeConstraint LoggerLevelPropertyInfo = (~) Soup.Enums.LoggerLogLevel
    type AttrTransferType LoggerLevelPropertyInfo = Soup.Enums.LoggerLogLevel
    type AttrGetType LoggerLevelPropertyInfo = Soup.Enums.LoggerLogLevel
    type AttrLabel LoggerLevelPropertyInfo = "level"
    type AttrOrigin LoggerLevelPropertyInfo = Logger
    attrGet = getLoggerLevel
    attrSet = setLoggerLevel
    attrTransfer _ v = do
        return v
    attrConstruct = constructLoggerLevel
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Logger.level"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Logger.html#g:attr:level"
        })
#endif

-- VVV Prop "max-body-size"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@max-body-size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' logger #maxBodySize
-- @
getLoggerMaxBodySize :: (MonadIO m, IsLogger o) => o -> m Int32
getLoggerMaxBodySize :: forall (m :: * -> *) o. (MonadIO m, IsLogger o) => o -> m Int32
getLoggerMaxBodySize o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"max-body-size"

-- | Set the value of the “@max-body-size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' logger [ #maxBodySize 'Data.GI.Base.Attributes.:=' value ]
-- @
setLoggerMaxBodySize :: (MonadIO m, IsLogger o) => o -> Int32 -> m ()
setLoggerMaxBodySize :: forall (m :: * -> *) o.
(MonadIO m, IsLogger o) =>
o -> Int32 -> m ()
setLoggerMaxBodySize o
obj Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"max-body-size" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@max-body-size@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructLoggerMaxBodySize :: (IsLogger o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructLoggerMaxBodySize :: forall o (m :: * -> *).
(IsLogger o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructLoggerMaxBodySize Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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 -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"max-body-size" Int32
val

#if defined(ENABLE_OVERLOADING)
data LoggerMaxBodySizePropertyInfo
instance AttrInfo LoggerMaxBodySizePropertyInfo where
    type AttrAllowedOps LoggerMaxBodySizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint LoggerMaxBodySizePropertyInfo = IsLogger
    type AttrSetTypeConstraint LoggerMaxBodySizePropertyInfo = (~) Int32
    type AttrTransferTypeConstraint LoggerMaxBodySizePropertyInfo = (~) Int32
    type AttrTransferType LoggerMaxBodySizePropertyInfo = Int32
    type AttrGetType LoggerMaxBodySizePropertyInfo = Int32
    type AttrLabel LoggerMaxBodySizePropertyInfo = "max-body-size"
    type AttrOrigin LoggerMaxBodySizePropertyInfo = Logger
    attrGet = getLoggerMaxBodySize
    attrSet = setLoggerMaxBodySize
    attrTransfer _ v = do
        return v
    attrConstruct = constructLoggerMaxBodySize
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Logger.maxBodySize"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Logger.html#g:attr:maxBodySize"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Logger
type instance O.AttributeList Logger = LoggerAttributeList
type LoggerAttributeList = ('[ '("level", LoggerLevelPropertyInfo), '("maxBodySize", LoggerMaxBodySizePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
loggerLevel :: AttrLabelProxy "level"
loggerLevel = AttrLabelProxy

loggerMaxBodySize :: AttrLabelProxy "maxBodySize"
loggerMaxBodySize = AttrLabelProxy

#endif

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

#endif

-- method Logger::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "level"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "LoggerLogLevel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the debug level" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "max_body_size"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the maximum body size to output, or -1"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Soup" , name = "Logger" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_logger_new" soup_logger_new :: 
    CUInt ->                                -- level : TInterface (Name {namespace = "Soup", name = "LoggerLogLevel"})
    Int32 ->                                -- max_body_size : TBasicType TInt
    IO (Ptr Logger)

-- | Creates a new t'GI.Soup.Objects.Logger.Logger' with the given debug level. If /@level@/ is
-- 'GI.Soup.Enums.LoggerLogLevelBody', /@maxBodySize@/ gives the maximum number of
-- bytes of the body that will be logged. (-1 means \"no limit\".)
-- 
-- If you need finer control over what message parts are and aren\'t
-- logged, use 'GI.Soup.Objects.Logger.loggerSetRequestFilter' and
-- 'GI.Soup.Objects.Logger.loggerSetResponseFilter'.
loggerNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Soup.Enums.LoggerLogLevel
    -- ^ /@level@/: the debug level
    -> Int32
    -- ^ /@maxBodySize@/: the maximum body size to output, or -1
    -> m Logger
    -- ^ __Returns:__ a new t'GI.Soup.Objects.Logger.Logger'
loggerNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LoggerLogLevel -> Int32 -> m Logger
loggerNew LoggerLogLevel
level Int32
maxBodySize = IO Logger -> m Logger
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Logger -> m Logger) -> IO Logger -> m Logger
forall a b. (a -> b) -> a -> b
$ do
    let level' :: CUInt
level' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (LoggerLogLevel -> Int) -> LoggerLogLevel -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoggerLogLevel -> Int
forall a. Enum a => a -> Int
fromEnum) LoggerLogLevel
level
    Ptr Logger
result <- CUInt -> Int32 -> IO (Ptr Logger)
soup_logger_new CUInt
level' Int32
maxBodySize
    Text -> Ptr Logger -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"loggerNew" Ptr Logger
result
    Logger
result' <- ((ManagedPtr Logger -> Logger) -> Ptr Logger -> IO Logger
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Logger -> Logger
Logger) Ptr Logger
result
    Logger -> IO Logger
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Logger
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Logger::attach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "logger"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Logger" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupLogger" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_logger_attach" soup_logger_attach :: 
    Ptr Logger ->                           -- logger : TInterface (Name {namespace = "Soup", name = "Logger"})
    Ptr Soup.Session.Session ->             -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    IO ()

{-# DEPRECATED loggerAttach ["Use 'GI.Soup.Objects.Session.sessionAddFeature' instead."] #-}
-- | Sets /@logger@/ to watch /@session@/ and print debug information for
-- its messages.
-- 
-- (The session will take a reference on /@logger@/, which will be
-- removed when you call 'GI.Soup.Objects.Logger.loggerDetach', or when the session is
-- destroyed.)
loggerAttach ::
    (B.CallStack.HasCallStack, MonadIO m, IsLogger a, Soup.Session.IsSession b) =>
    a
    -- ^ /@logger@/: a t'GI.Soup.Objects.Logger.Logger'
    -> b
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> m ()
loggerAttach :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsLogger a, IsSession b) =>
a -> b -> m ()
loggerAttach a
logger b
session = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Logger
logger' <- a -> IO (Ptr Logger)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
logger
    Ptr Session
session' <- b -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
session
    Ptr Logger -> Ptr Session -> IO ()
soup_logger_attach Ptr Logger
logger' Ptr Session
session'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
logger
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
session
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data LoggerAttachMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsLogger a, Soup.Session.IsSession b) => O.OverloadedMethod LoggerAttachMethodInfo a signature where
    overloadedMethod = loggerAttach

instance O.OverloadedMethodInfo LoggerAttachMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Logger.loggerAttach",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Logger.html#v:loggerAttach"
        })


#endif

-- method Logger::detach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "logger"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Logger" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupLogger" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_logger_detach" soup_logger_detach :: 
    Ptr Logger ->                           -- logger : TInterface (Name {namespace = "Soup", name = "Logger"})
    Ptr Soup.Session.Session ->             -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    IO ()

{-# DEPRECATED loggerDetach ["Use 'GI.Soup.Objects.Session.sessionRemoveFeature' instead."] #-}
-- | Stops /@logger@/ from watching /@session@/.
loggerDetach ::
    (B.CallStack.HasCallStack, MonadIO m, IsLogger a, Soup.Session.IsSession b) =>
    a
    -- ^ /@logger@/: a t'GI.Soup.Objects.Logger.Logger'
    -> b
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> m ()
loggerDetach :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsLogger a, IsSession b) =>
a -> b -> m ()
loggerDetach a
logger b
session = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Logger
logger' <- a -> IO (Ptr Logger)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
logger
    Ptr Session
session' <- b -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
session
    Ptr Logger -> Ptr Session -> IO ()
soup_logger_detach Ptr Logger
logger' Ptr Session
session'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
logger
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
session
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data LoggerDetachMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsLogger a, Soup.Session.IsSession b) => O.OverloadedMethod LoggerDetachMethodInfo a signature where
    overloadedMethod = loggerDetach

instance O.OverloadedMethodInfo LoggerDetachMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Logger.loggerDetach",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Logger.html#v:loggerDetach"
        })


#endif

-- method Logger::set_printer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "logger"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Logger" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupLogger" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "printer"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "LoggerPrinter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the callback for printing logging output"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "printer_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destroy"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GDestroyNotify to free @printer_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_logger_set_printer" soup_logger_set_printer :: 
    Ptr Logger ->                           -- logger : TInterface (Name {namespace = "Soup", name = "Logger"})
    FunPtr Soup.Callbacks.C_LoggerPrinter -> -- printer : TInterface (Name {namespace = "Soup", name = "LoggerPrinter"})
    Ptr () ->                               -- printer_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Sets up an alternate log printing routine, if you don\'t want
-- the log to go to \<literal>stdout\<\/literal>.
loggerSetPrinter ::
    (B.CallStack.HasCallStack, MonadIO m, IsLogger a) =>
    a
    -- ^ /@logger@/: a t'GI.Soup.Objects.Logger.Logger'
    -> Soup.Callbacks.LoggerPrinter
    -- ^ /@printer@/: the callback for printing logging output
    -> m ()
loggerSetPrinter :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLogger a) =>
a -> LoggerPrinter -> m ()
loggerSetPrinter a
logger LoggerPrinter
printer = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Logger
logger' <- a -> IO (Ptr Logger)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
logger
    FunPtr C_LoggerPrinter
printer' <- C_LoggerPrinter -> IO (FunPtr C_LoggerPrinter)
Soup.Callbacks.mk_LoggerPrinter (Maybe (Ptr (FunPtr C_LoggerPrinter))
-> LoggerPrinter_WithClosures -> C_LoggerPrinter
Soup.Callbacks.wrap_LoggerPrinter Maybe (Ptr (FunPtr C_LoggerPrinter))
forall a. Maybe a
Nothing (LoggerPrinter -> LoggerPrinter_WithClosures
Soup.Callbacks.drop_closures_LoggerPrinter LoggerPrinter
printer))
    let printerData :: Ptr ()
printerData = FunPtr C_LoggerPrinter -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_LoggerPrinter
printer'
    let destroy :: FunPtr (Ptr a -> IO ())
destroy = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr Logger
-> FunPtr C_LoggerPrinter
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
soup_logger_set_printer Ptr Logger
logger' FunPtr C_LoggerPrinter
printer' Ptr ()
printerData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
destroy
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
logger
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data LoggerSetPrinterMethodInfo
instance (signature ~ (Soup.Callbacks.LoggerPrinter -> m ()), MonadIO m, IsLogger a) => O.OverloadedMethod LoggerSetPrinterMethodInfo a signature where
    overloadedMethod = loggerSetPrinter

instance O.OverloadedMethodInfo LoggerSetPrinterMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Logger.loggerSetPrinter",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Logger.html#v:loggerSetPrinter"
        })


#endif

-- method Logger::set_request_filter
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "logger"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Logger" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupLogger" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "request_filter"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "LoggerFilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the callback for request debugging"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filter_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destroy"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GDestroyNotify to free @filter_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_logger_set_request_filter" soup_logger_set_request_filter :: 
    Ptr Logger ->                           -- logger : TInterface (Name {namespace = "Soup", name = "Logger"})
    FunPtr Soup.Callbacks.C_LoggerFilter -> -- request_filter : TInterface (Name {namespace = "Soup", name = "LoggerFilter"})
    Ptr () ->                               -- filter_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Sets up a filter to determine the log level for a given request.
-- For each HTTP request /@logger@/ will invoke /@requestFilter@/ to
-- determine how much (if any) of that request to log. (If you do not
-- set a request filter, /@logger@/ will just always log requests at the
-- level passed to 'GI.Soup.Objects.Logger.loggerNew'.)
loggerSetRequestFilter ::
    (B.CallStack.HasCallStack, MonadIO m, IsLogger a) =>
    a
    -- ^ /@logger@/: a t'GI.Soup.Objects.Logger.Logger'
    -> Soup.Callbacks.LoggerFilter
    -- ^ /@requestFilter@/: the callback for request debugging
    -> m ()
loggerSetRequestFilter :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLogger a) =>
a -> LoggerFilter -> m ()
loggerSetRequestFilter a
logger LoggerFilter
requestFilter = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Logger
logger' <- a -> IO (Ptr Logger)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
logger
    FunPtr C_LoggerFilter
requestFilter' <- C_LoggerFilter -> IO (FunPtr C_LoggerFilter)
Soup.Callbacks.mk_LoggerFilter (Maybe (Ptr (FunPtr C_LoggerFilter))
-> LoggerFilter_WithClosures -> C_LoggerFilter
Soup.Callbacks.wrap_LoggerFilter Maybe (Ptr (FunPtr C_LoggerFilter))
forall a. Maybe a
Nothing (LoggerFilter -> LoggerFilter_WithClosures
Soup.Callbacks.drop_closures_LoggerFilter LoggerFilter
requestFilter))
    let filterData :: Ptr ()
filterData = FunPtr C_LoggerFilter -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_LoggerFilter
requestFilter'
    let destroy :: FunPtr (Ptr a -> IO ())
destroy = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr Logger
-> FunPtr C_LoggerFilter
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
soup_logger_set_request_filter Ptr Logger
logger' FunPtr C_LoggerFilter
requestFilter' Ptr ()
filterData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
destroy
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
logger
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data LoggerSetRequestFilterMethodInfo
instance (signature ~ (Soup.Callbacks.LoggerFilter -> m ()), MonadIO m, IsLogger a) => O.OverloadedMethod LoggerSetRequestFilterMethodInfo a signature where
    overloadedMethod = loggerSetRequestFilter

instance O.OverloadedMethodInfo LoggerSetRequestFilterMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Logger.loggerSetRequestFilter",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Logger.html#v:loggerSetRequestFilter"
        })


#endif

-- method Logger::set_response_filter
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "logger"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Logger" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupLogger" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "response_filter"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "LoggerFilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the callback for response debugging"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filter_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destroy"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GDestroyNotify to free @filter_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_logger_set_response_filter" soup_logger_set_response_filter :: 
    Ptr Logger ->                           -- logger : TInterface (Name {namespace = "Soup", name = "Logger"})
    FunPtr Soup.Callbacks.C_LoggerFilter -> -- response_filter : TInterface (Name {namespace = "Soup", name = "LoggerFilter"})
    Ptr () ->                               -- filter_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Sets up a filter to determine the log level for a given response.
-- For each HTTP response /@logger@/ will invoke /@responseFilter@/ to
-- determine how much (if any) of that response to log. (If you do not
-- set a response filter, /@logger@/ will just always log responses at
-- the level passed to 'GI.Soup.Objects.Logger.loggerNew'.)
loggerSetResponseFilter ::
    (B.CallStack.HasCallStack, MonadIO m, IsLogger a) =>
    a
    -- ^ /@logger@/: a t'GI.Soup.Objects.Logger.Logger'
    -> Soup.Callbacks.LoggerFilter
    -- ^ /@responseFilter@/: the callback for response debugging
    -> m ()
loggerSetResponseFilter :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLogger a) =>
a -> LoggerFilter -> m ()
loggerSetResponseFilter a
logger LoggerFilter
responseFilter = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Logger
logger' <- a -> IO (Ptr Logger)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
logger
    FunPtr C_LoggerFilter
responseFilter' <- C_LoggerFilter -> IO (FunPtr C_LoggerFilter)
Soup.Callbacks.mk_LoggerFilter (Maybe (Ptr (FunPtr C_LoggerFilter))
-> LoggerFilter_WithClosures -> C_LoggerFilter
Soup.Callbacks.wrap_LoggerFilter Maybe (Ptr (FunPtr C_LoggerFilter))
forall a. Maybe a
Nothing (LoggerFilter -> LoggerFilter_WithClosures
Soup.Callbacks.drop_closures_LoggerFilter LoggerFilter
responseFilter))
    let filterData :: Ptr ()
filterData = FunPtr C_LoggerFilter -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_LoggerFilter
responseFilter'
    let destroy :: FunPtr (Ptr a -> IO ())
destroy = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr Logger
-> FunPtr C_LoggerFilter
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
soup_logger_set_response_filter Ptr Logger
logger' FunPtr C_LoggerFilter
responseFilter' Ptr ()
filterData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
destroy
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
logger
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data LoggerSetResponseFilterMethodInfo
instance (signature ~ (Soup.Callbacks.LoggerFilter -> m ()), MonadIO m, IsLogger a) => O.OverloadedMethod LoggerSetResponseFilterMethodInfo a signature where
    overloadedMethod = loggerSetResponseFilter

instance O.OverloadedMethodInfo LoggerSetResponseFilterMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Logger.loggerSetResponseFilter",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Logger.html#v:loggerSetResponseFilter"
        })


#endif