{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Opaque structure containing XML-RPC methodCall parameter values.
-- Can be parsed using 'GI.Soup.Structs.XMLRPCParams.xMLRPCParamsParse' and freed with
-- 'GI.Soup.Structs.XMLRPCParams.xMLRPCParamsFree'.
-- 
-- /Since: 2.52/

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

module GI.Soup.Structs.XMLRPCParams
    ( 

-- * Exported types
    XMLRPCParams(..)                        ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [free]("GI.Soup.Structs.XMLRPCParams#g:method:free"), [parse]("GI.Soup.Structs.XMLRPCParams#g:method:parse").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveXMLRPCParamsMethod               ,
#endif

-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    XMLRPCParamsFreeMethodInfo              ,
#endif
    xMLRPCParamsFree                        ,


-- ** parse #method:parse#

#if defined(ENABLE_OVERLOADING)
    XMLRPCParamsParseMethodInfo             ,
#endif
    xMLRPCParamsParse                       ,




    ) where

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

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


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

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

-- XXX Wrapping a foreign struct/union with no known destructor or size, leak?
instance BoxedPtr XMLRPCParams where
    boxedPtrCopy :: XMLRPCParams -> IO XMLRPCParams
boxedPtrCopy = XMLRPCParams -> IO XMLRPCParams
forall (m :: * -> *) a. Monad m => a -> m a
return
    boxedPtrFree :: XMLRPCParams -> IO ()
boxedPtrFree = \XMLRPCParams
_x -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList XMLRPCParams
type instance O.AttributeList XMLRPCParams = XMLRPCParamsAttributeList
type XMLRPCParamsAttributeList = ('[ ] :: [(Symbol, *)])
#endif

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

foreign import ccall "soup_xmlrpc_params_free" soup_xmlrpc_params_free :: 
    Ptr XMLRPCParams ->                     -- self : TInterface (Name {namespace = "Soup", name = "XMLRPCParams"})
    IO ()

-- | Free a t'GI.Soup.Structs.XMLRPCParams.XMLRPCParams' returned by 'GI.Soup.Functions.xmlrpcParseRequest'.
-- 
-- /Since: 2.52/
xMLRPCParamsFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    XMLRPCParams
    -- ^ /@self@/: a SoupXMLRPCParams
    -> m ()
xMLRPCParamsFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
XMLRPCParams -> m ()
xMLRPCParamsFree XMLRPCParams
self = 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 XMLRPCParams
self' <- XMLRPCParams -> IO (Ptr XMLRPCParams)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr XMLRPCParams
self
    Ptr XMLRPCParams -> IO ()
soup_xmlrpc_params_free Ptr XMLRPCParams
self'
    XMLRPCParams -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr XMLRPCParams
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data XMLRPCParamsFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod XMLRPCParamsFreeMethodInfo XMLRPCParams signature where
    overloadedMethod = xMLRPCParamsFree

instance O.OverloadedMethodInfo XMLRPCParamsFreeMethodInfo XMLRPCParams where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.XMLRPCParams.xMLRPCParamsFree",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-XMLRPCParams.html#v:xMLRPCParamsFree"
        }


#endif

-- method XMLRPCParams::parse
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "XMLRPCParams" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #SoupXMLRPCParams"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "signature"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A valid #GVariant type string, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TVariant
-- throws : True
-- Skip return : False

foreign import ccall "soup_xmlrpc_params_parse" soup_xmlrpc_params_parse :: 
    Ptr XMLRPCParams ->                     -- self : TInterface (Name {namespace = "Soup", name = "XMLRPCParams"})
    CString ->                              -- signature : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GVariant)

-- | Parse method parameters returned by 'GI.Soup.Functions.xmlrpcParseRequest'.
-- 
-- Deserialization details:
--  - If /@signature@/ is provided, &lt;int&gt; and &lt;i4&gt; can be deserialized
--    to byte, int16, uint16, int32, uint32, int64 or uint64. Otherwise
--    it will be deserialized to int32. If the value is out of range
--    for the target type it will return an error.
--  - &lt;struct&gt; will be deserialized to \"a{sv}\". /@signature@/ could define
--    another value type (e.g. \"a{ss}\").
--  - &lt;array&gt; will be deserialized to \"av\". /@signature@/ could define
--    another element type (e.g. \"as\") or could be a tuple (e.g. \"(ss)\").
--  - &lt;base64&gt; will be deserialized to \"ay\".
--  - &lt;string&gt; will be deserialized to \"s\".
--  - &lt;dateTime.iso8601&gt; will be deserialized to an unspecified variant
--    type. If /@signature@/ is provided it must have the generic \"v\" type, which
--    means there is no guarantee that it\'s actually a datetime that has been
--    received. 'GI.Soup.Functions.xmlrpcVariantGetDatetime' must be used to parse and
--    type check this special variant.
--  - /@signature@/ must not have maybes, otherwise an error is returned.
--  - Dictionaries must have string keys, otherwise an error is returned.
-- 
-- /Since: 2.52/
xMLRPCParamsParse ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    XMLRPCParams
    -- ^ /@self@/: A t'GI.Soup.Structs.XMLRPCParams.XMLRPCParams'
    -> Maybe (T.Text)
    -- ^ /@signature@/: A valid t'GVariant' type string, or 'P.Nothing'
    -> m GVariant
    -- ^ __Returns:__ a new (non-floating) t'GVariant', or 'P.Nothing' /(Can throw 'Data.GI.Base.GError.GError')/
xMLRPCParamsParse :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
XMLRPCParams -> Maybe Text -> m GVariant
xMLRPCParamsParse XMLRPCParams
self Maybe Text
signature = IO GVariant -> m GVariant
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
    Ptr XMLRPCParams
self' <- XMLRPCParams -> IO (Ptr XMLRPCParams)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr XMLRPCParams
self
    Ptr CChar
maybeSignature <- case Maybe Text
signature of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jSignature -> do
            Ptr CChar
jSignature' <- Text -> IO (Ptr CChar)
textToCString Text
jSignature
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jSignature'
    IO GVariant -> IO () -> IO GVariant
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr GVariant
result <- (Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant))
-> (Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant)
forall a b. (a -> b) -> a -> b
$ Ptr XMLRPCParams
-> Ptr CChar -> Ptr (Ptr GError) -> IO (Ptr GVariant)
soup_xmlrpc_params_parse Ptr XMLRPCParams
self' Ptr CChar
maybeSignature
        Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"xMLRPCParamsParse" Ptr GVariant
result
        GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
result
        XMLRPCParams -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr XMLRPCParams
self
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeSignature
        GVariant -> IO GVariant
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result'
     ) (do
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeSignature
     )

#if defined(ENABLE_OVERLOADING)
data XMLRPCParamsParseMethodInfo
instance (signature ~ (Maybe (T.Text) -> m GVariant), MonadIO m) => O.OverloadedMethod XMLRPCParamsParseMethodInfo XMLRPCParams signature where
    overloadedMethod = xMLRPCParamsParse

instance O.OverloadedMethodInfo XMLRPCParamsParseMethodInfo XMLRPCParams where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.XMLRPCParams.xMLRPCParamsParse",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-XMLRPCParams.html#v:xMLRPCParamsParse"
        }


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveXMLRPCParamsMethod (t :: Symbol) (o :: *) :: * where
    ResolveXMLRPCParamsMethod "free" o = XMLRPCParamsFreeMethodInfo
    ResolveXMLRPCParamsMethod "parse" o = XMLRPCParamsParseMethodInfo
    ResolveXMLRPCParamsMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif