{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Many URI schemes include one or more attribute\/value pairs as part of the URI
-- value. For example @scheme:\/\/server\/path?query=string&is=there@ has two
-- attributes – @query=string@ and @is=there@ – in its query part.
-- 
-- A t'GI.GLib.Structs.UriParamsIter.UriParamsIter' structure represents an iterator that can be used to
-- iterate over the attribute\/value pairs of a URI query string. t'GI.GLib.Structs.UriParamsIter.UriParamsIter'
-- structures are typically allocated on the stack and then initialized with
-- 'GI.GLib.Structs.UriParamsIter.uriParamsIterInit'. See the documentation for 'GI.GLib.Structs.UriParamsIter.uriParamsIterInit'
-- for a usage example.
-- 
-- /Since: 2.66/

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.GLib.Structs.UriParamsIter
    ( 

-- * Exported types
    UriParamsIter(..)                       ,
    newZeroUriParamsIter                    ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [init]("GI.GLib.Structs.UriParamsIter#g:method:init"), [next]("GI.GLib.Structs.UriParamsIter#g:method:next").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveUriParamsIterMethod              ,
#endif

-- ** init #method:init#

#if defined(ENABLE_OVERLOADING)
    UriParamsIterInitMethodInfo             ,
#endif
    uriParamsIterInit                       ,


-- ** next #method:next#

#if defined(ENABLE_OVERLOADING)
    UriParamsIterNextMethodInfo             ,
#endif
    uriParamsIterNext                       ,




    ) 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.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import {-# SOURCE #-} qualified GI.GLib.Flags as GLib.Flags

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

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

instance BoxedPtr UriParamsIter where
    boxedPtrCopy :: UriParamsIter -> IO UriParamsIter
boxedPtrCopy = \UriParamsIter
p -> UriParamsIter
-> (Ptr UriParamsIter -> IO UriParamsIter) -> IO UriParamsIter
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr UriParamsIter
p (Int -> Ptr UriParamsIter -> IO (Ptr UriParamsIter)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
280 (Ptr UriParamsIter -> IO (Ptr UriParamsIter))
-> (Ptr UriParamsIter -> IO UriParamsIter)
-> Ptr UriParamsIter
-> IO UriParamsIter
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr UriParamsIter -> UriParamsIter)
-> Ptr UriParamsIter -> IO UriParamsIter
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr UriParamsIter -> UriParamsIter
UriParamsIter)
    boxedPtrFree :: UriParamsIter -> IO ()
boxedPtrFree = \UriParamsIter
x -> UriParamsIter -> (Ptr UriParamsIter -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr UriParamsIter
x Ptr UriParamsIter -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr UriParamsIter where
    boxedPtrCalloc :: IO (Ptr UriParamsIter)
boxedPtrCalloc = Int -> IO (Ptr UriParamsIter)
forall a. Int -> IO (Ptr a)
callocBytes Int
280


-- | Construct a `UriParamsIter` struct initialized to zero.
newZeroUriParamsIter :: MonadIO m => m UriParamsIter
newZeroUriParamsIter :: forall (m :: * -> *). MonadIO m => m UriParamsIter
newZeroUriParamsIter = IO UriParamsIter -> m UriParamsIter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UriParamsIter -> m UriParamsIter)
-> IO UriParamsIter -> m UriParamsIter
forall a b. (a -> b) -> a -> b
$ IO (Ptr UriParamsIter)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr UriParamsIter)
-> (Ptr UriParamsIter -> IO UriParamsIter) -> IO UriParamsIter
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr UriParamsIter -> UriParamsIter)
-> Ptr UriParamsIter -> IO UriParamsIter
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr UriParamsIter -> UriParamsIter
UriParamsIter

instance tag ~ 'AttrSet => Constructible UriParamsIter tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr UriParamsIter -> UriParamsIter)
-> [AttrOp UriParamsIter tag] -> m UriParamsIter
new ManagedPtr UriParamsIter -> UriParamsIter
_ [AttrOp UriParamsIter tag]
attrs = do
        UriParamsIter
o <- m UriParamsIter
forall (m :: * -> *). MonadIO m => m UriParamsIter
newZeroUriParamsIter
        UriParamsIter -> [AttrOp UriParamsIter 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set UriParamsIter
o [AttrOp UriParamsIter tag]
[AttrOp UriParamsIter 'AttrSet]
attrs
        UriParamsIter -> m UriParamsIter
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UriParamsIter
o



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList UriParamsIter
type instance O.AttributeList UriParamsIter = UriParamsIterAttributeList
type UriParamsIterAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

-- method UriParamsIter::init
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "UriParamsIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an uninitialized #GUriParamsIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "params"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a `%`-encoded string containing `attribute=value`\n  parameters"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the length of @params, or `-1` if it is nul-terminated"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "separators"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the separator byte character set between parameters. (usually\n  `&`, but sometimes `;` or both `&;`). Note that this function works on\n  bytes not characters, so it can't be used to delimit UTF-8 strings for\n  anything but ASCII characters. You may pass an empty set, in which case\n  no splitting will occur."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "UriParamsFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "flags to modify the way the parameters are handled."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_uri_params_iter_init" g_uri_params_iter_init :: 
    Ptr UriParamsIter ->                    -- iter : TInterface (Name {namespace = "GLib", name = "UriParamsIter"})
    CString ->                              -- params : TBasicType TUTF8
    Int64 ->                                -- length : TBasicType TInt64
    CString ->                              -- separators : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "GLib", name = "UriParamsFlags"})
    IO ()

-- | Initializes an attribute\/value pair iterator.
-- 
-- The iterator keeps pointers to the /@params@/ and /@separators@/ arguments, those
-- variables must thus outlive the iterator and not be modified during the
-- iteration.
-- 
-- If 'GI.GLib.Flags.UriParamsFlagsWwwForm' is passed in /@flags@/, @+@ characters in the param
-- string will be replaced with spaces in the output. For example, @foo=bar+baz@
-- will give attribute @foo@ with value @bar baz@. This is commonly used on the
-- web (the @https@ and @http@ schemes only), but is deprecated in favour of
-- the equivalent of encoding spaces as @%20@.
-- 
-- Unlike with 'GI.GLib.Functions.uriParseParams', 'GI.GLib.Flags.UriParamsFlagsCaseInsensitive' has no
-- effect if passed to /@flags@/ for 'GI.GLib.Structs.UriParamsIter.uriParamsIterInit'. The caller is
-- responsible for doing their own case-insensitive comparisons.
-- 
-- 
-- === /C code/
-- >
-- >GUriParamsIter iter;
-- >GError *error = NULL;
-- >gchar *unowned_attr, *unowned_value;
-- >
-- >g_uri_params_iter_init (&iter, "foo=bar&baz=bar&Foo=frob&baz=bar2", -1, "&", G_URI_PARAMS_NONE);
-- >while (g_uri_params_iter_next (&iter, &unowned_attr, &unowned_value, &error))
-- >  {
-- >    g_autofree gchar *attr = g_steal_pointer (&unowned_attr);
-- >    g_autofree gchar *value = g_steal_pointer (&unowned_value);
-- >    // do something with attr and value; this code will be called 4 times
-- >    // for the params string in this example: once with attr=foo and value=bar,
-- >    // then with baz/bar, then Foo/frob, then baz/bar2.
-- >  }
-- >if (error)
-- >  // handle parsing error
-- 
-- 
-- /Since: 2.66/
uriParamsIterInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UriParamsIter
    -- ^ /@iter@/: an uninitialized t'GI.GLib.Structs.UriParamsIter.UriParamsIter'
    -> T.Text
    -- ^ /@params@/: a @%@-encoded string containing @attribute=value@
    --   parameters
    -> Int64
    -- ^ /@length@/: the length of /@params@/, or @-1@ if it is nul-terminated
    -> T.Text
    -- ^ /@separators@/: the separator byte character set between parameters. (usually
    --   @&@, but sometimes @;@ or both @&;@). Note that this function works on
    --   bytes not characters, so it can\'t be used to delimit UTF-8 strings for
    --   anything but ASCII characters. You may pass an empty set, in which case
    --   no splitting will occur.
    -> [GLib.Flags.UriParamsFlags]
    -- ^ /@flags@/: flags to modify the way the parameters are handled.
    -> m ()
uriParamsIterInit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UriParamsIter -> Text -> Int64 -> Text -> [UriParamsFlags] -> m ()
uriParamsIterInit UriParamsIter
iter Text
params Int64
length_ Text
separators [UriParamsFlags]
flags = 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 UriParamsIter
iter' <- UriParamsIter -> IO (Ptr UriParamsIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UriParamsIter
iter
    CString
params' <- Text -> IO CString
textToCString Text
params
    CString
separators' <- Text -> IO CString
textToCString Text
separators
    let flags' :: CUInt
flags' = [UriParamsFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [UriParamsFlags]
flags
    Ptr UriParamsIter -> CString -> Int64 -> CString -> CUInt -> IO ()
g_uri_params_iter_init Ptr UriParamsIter
iter' CString
params' Int64
length_ CString
separators' CUInt
flags'
    UriParamsIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr UriParamsIter
iter
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
params'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
separators'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data UriParamsIterInitMethodInfo
instance (signature ~ (T.Text -> Int64 -> T.Text -> [GLib.Flags.UriParamsFlags] -> m ()), MonadIO m) => O.OverloadedMethod UriParamsIterInitMethodInfo UriParamsIter signature where
    overloadedMethod = uriParamsIterInit

instance O.OverloadedMethodInfo UriParamsIterInitMethodInfo UriParamsIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.UriParamsIter.uriParamsIterInit",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-UriParamsIter.html#v:uriParamsIterInit"
        })


#endif

-- method UriParamsIter::next
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "UriParamsIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an initialized #GUriParamsIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attribute"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "on return, contains\n    the attribute, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "on return, contains\n    the value, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_uri_params_iter_next" g_uri_params_iter_next :: 
    Ptr UriParamsIter ->                    -- iter : TInterface (Name {namespace = "GLib", name = "UriParamsIter"})
    Ptr CString ->                          -- attribute : TBasicType TUTF8
    Ptr CString ->                          -- value : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Advances /@iter@/ and retrieves the next attribute\/value. 'P.False' is returned if
-- an error has occurred (in which case /@error@/ is set), or if the end of the
-- iteration is reached (in which case /@attribute@/ and /@value@/ are set to 'P.Nothing'
-- and the iterator becomes invalid). If 'P.True' is returned,
-- 'GI.GLib.Structs.UriParamsIter.uriParamsIterNext' may be called again to receive another
-- attribute\/value pair.
-- 
-- Note that the same /@attribute@/ may be returned multiple times, since URIs
-- allow repeated attributes.
-- 
-- /Since: 2.66/
uriParamsIterNext ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UriParamsIter
    -- ^ /@iter@/: an initialized t'GI.GLib.Structs.UriParamsIter.UriParamsIter'
    -> m ((Maybe T.Text, Maybe T.Text))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
uriParamsIterNext :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UriParamsIter -> m (Maybe Text, Maybe Text)
uriParamsIterNext UriParamsIter
iter = IO (Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text))
-> IO (Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr UriParamsIter
iter' <- UriParamsIter -> IO (Ptr UriParamsIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UriParamsIter
iter
    Ptr CString
attribute <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Ptr CString
value <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    IO (Maybe Text, Maybe Text) -> IO () -> IO (Maybe Text, Maybe Text)
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr UriParamsIter
-> Ptr CString -> Ptr CString -> Ptr (Ptr GError) -> IO CInt
g_uri_params_iter_next Ptr UriParamsIter
iter' Ptr CString
attribute Ptr CString
value
        CString
attribute' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
attribute
        Maybe Text
maybeAttribute' <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
attribute' ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
attribute'' -> do
            Text
attribute''' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
attribute''
            Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
attribute'''
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attribute'
        CString
value' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
value
        Maybe Text
maybeValue' <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
value' ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
value'' -> do
            Text
value''' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
value''
            Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
value'''
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
        UriParamsIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr UriParamsIter
iter
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
attribute
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
value
        (Maybe Text, Maybe Text) -> IO (Maybe Text, Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text
maybeAttribute', Maybe Text
maybeValue')
     ) (do
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
attribute
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
value
     )

#if defined(ENABLE_OVERLOADING)
data UriParamsIterNextMethodInfo
instance (signature ~ (m ((Maybe T.Text, Maybe T.Text))), MonadIO m) => O.OverloadedMethod UriParamsIterNextMethodInfo UriParamsIter signature where
    overloadedMethod = uriParamsIterNext

instance O.OverloadedMethodInfo UriParamsIterNextMethodInfo UriParamsIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.UriParamsIter.uriParamsIterNext",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-UriParamsIter.html#v:uriParamsIterNext"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveUriParamsIterMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveUriParamsIterMethod "init" o = UriParamsIterInitMethodInfo
    ResolveUriParamsIterMethod "next" o = UriParamsIterNextMethodInfo
    ResolveUriParamsIterMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif