{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- SRV (service) records are used by some network protocols to provide
-- service-specific aliasing and load-balancing. For example, XMPP
-- (Jabber) uses SRV records to locate the XMPP server for a domain;
-- rather than connecting directly to \"example.com\" or assuming a
-- specific server hostname like \"xmpp.example.com\", an XMPP client
-- would look up the \"xmpp-client\" SRV record for \"example.com\", and
-- then connect to whatever host was pointed to by that record.
-- 
-- You can use 'GI.Gio.Objects.Resolver.resolverLookupService' or
-- 'GI.Gio.Objects.Resolver.resolverLookupServiceAsync' to find the @/GSrvTargets/@
-- for a given service. However, if you are simply planning to connect
-- to the remote service, you can use t'GI.Gio.Objects.NetworkService.NetworkService'\'s
-- t'GI.Gio.Interfaces.SocketConnectable.SocketConnectable' interface and not need to worry about
-- t'GI.Gio.Structs.SrvTarget.SrvTarget' at all.

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

module GI.Gio.Structs.SrvTarget
    ( 

-- * Exported types
    SrvTarget(..)                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copy]("GI.Gio.Structs.SrvTarget#g:method:copy"), [free]("GI.Gio.Structs.SrvTarget#g:method:free").
-- 
-- ==== Getters
-- [getHostname]("GI.Gio.Structs.SrvTarget#g:method:getHostname"), [getPort]("GI.Gio.Structs.SrvTarget#g:method:getPort"), [getPriority]("GI.Gio.Structs.SrvTarget#g:method:getPriority"), [getWeight]("GI.Gio.Structs.SrvTarget#g:method:getWeight").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveSrvTargetMethod                  ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    SrvTargetCopyMethodInfo                 ,
#endif
    srvTargetCopy                           ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    SrvTargetFreeMethodInfo                 ,
#endif
    srvTargetFree                           ,


-- ** getHostname #method:getHostname#

#if defined(ENABLE_OVERLOADING)
    SrvTargetGetHostnameMethodInfo          ,
#endif
    srvTargetGetHostname                    ,


-- ** getPort #method:getPort#

#if defined(ENABLE_OVERLOADING)
    SrvTargetGetPortMethodInfo              ,
#endif
    srvTargetGetPort                        ,


-- ** getPriority #method:getPriority#

#if defined(ENABLE_OVERLOADING)
    SrvTargetGetPriorityMethodInfo          ,
#endif
    srvTargetGetPriority                    ,


-- ** getWeight #method:getWeight#

#if defined(ENABLE_OVERLOADING)
    SrvTargetGetWeightMethodInfo            ,
#endif
    srvTargetGetWeight                      ,


-- ** new #method:new#

    srvTargetNew                            ,




    ) 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


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

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

foreign import ccall "g_srv_target_get_type" c_g_srv_target_get_type :: 
    IO GType

type instance O.ParentTypes SrvTarget = '[]
instance O.HasParentTypes SrvTarget

instance B.Types.TypedObject SrvTarget where
    glibType :: IO GType
glibType = IO GType
c_g_srv_target_get_type

instance B.Types.GBoxed SrvTarget

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


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

-- method SrvTarget::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "hostname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the host that the service is running on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "port"
--           , argType = TBasicType TUInt16
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the port that the service is running on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "priority"
--           , argType = TBasicType TUInt16
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the target's priority"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "weight"
--           , argType = TBasicType TUInt16
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the target's weight"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "SrvTarget" })
-- throws : False
-- Skip return : False

foreign import ccall "g_srv_target_new" g_srv_target_new :: 
    CString ->                              -- hostname : TBasicType TUTF8
    Word16 ->                               -- port : TBasicType TUInt16
    Word16 ->                               -- priority : TBasicType TUInt16
    Word16 ->                               -- weight : TBasicType TUInt16
    IO (Ptr SrvTarget)

-- | Creates a new t'GI.Gio.Structs.SrvTarget.SrvTarget' with the given parameters.
-- 
-- You should not need to use this; normally @/GSrvTargets/@ are
-- created by t'GI.Gio.Objects.Resolver.Resolver'.
-- 
-- /Since: 2.22/
srvTargetNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@hostname@/: the host that the service is running on
    -> Word16
    -- ^ /@port@/: the port that the service is running on
    -> Word16
    -- ^ /@priority@/: the target\'s priority
    -> Word16
    -- ^ /@weight@/: the target\'s weight
    -> m SrvTarget
    -- ^ __Returns:__ a new t'GI.Gio.Structs.SrvTarget.SrvTarget'.
srvTargetNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Word16 -> Word16 -> Word16 -> m SrvTarget
srvTargetNew Text
hostname Word16
port Word16
priority Word16
weight = IO SrvTarget -> m SrvTarget
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SrvTarget -> m SrvTarget) -> IO SrvTarget -> m SrvTarget
forall a b. (a -> b) -> a -> b
$ do
    CString
hostname' <- Text -> IO CString
textToCString Text
hostname
    Ptr SrvTarget
result <- CString -> Word16 -> Word16 -> Word16 -> IO (Ptr SrvTarget)
g_srv_target_new CString
hostname' Word16
port Word16
priority Word16
weight
    Text -> Ptr SrvTarget -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"srvTargetNew" Ptr SrvTarget
result
    SrvTarget
result' <- ((ManagedPtr SrvTarget -> SrvTarget)
-> Ptr SrvTarget -> IO SrvTarget
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr SrvTarget -> SrvTarget
SrvTarget) Ptr SrvTarget
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
hostname'
    SrvTarget -> IO SrvTarget
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SrvTarget
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "g_srv_target_copy" g_srv_target_copy :: 
    Ptr SrvTarget ->                        -- target : TInterface (Name {namespace = "Gio", name = "SrvTarget"})
    IO (Ptr SrvTarget)

-- | Copies /@target@/
-- 
-- /Since: 2.22/
srvTargetCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SrvTarget
    -- ^ /@target@/: a t'GI.Gio.Structs.SrvTarget.SrvTarget'
    -> m SrvTarget
    -- ^ __Returns:__ a copy of /@target@/
srvTargetCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SrvTarget -> m SrvTarget
srvTargetCopy SrvTarget
target = IO SrvTarget -> m SrvTarget
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SrvTarget -> m SrvTarget) -> IO SrvTarget -> m SrvTarget
forall a b. (a -> b) -> a -> b
$ do
    Ptr SrvTarget
target' <- SrvTarget -> IO (Ptr SrvTarget)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SrvTarget
target
    Ptr SrvTarget
result <- Ptr SrvTarget -> IO (Ptr SrvTarget)
g_srv_target_copy Ptr SrvTarget
target'
    Text -> Ptr SrvTarget -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"srvTargetCopy" Ptr SrvTarget
result
    SrvTarget
result' <- ((ManagedPtr SrvTarget -> SrvTarget)
-> Ptr SrvTarget -> IO SrvTarget
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr SrvTarget -> SrvTarget
SrvTarget) Ptr SrvTarget
result
    SrvTarget -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SrvTarget
target
    SrvTarget -> IO SrvTarget
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SrvTarget
result'

#if defined(ENABLE_OVERLOADING)
data SrvTargetCopyMethodInfo
instance (signature ~ (m SrvTarget), MonadIO m) => O.OverloadedMethod SrvTargetCopyMethodInfo SrvTarget signature where
    overloadedMethod = srvTargetCopy

instance O.OverloadedMethodInfo SrvTargetCopyMethodInfo SrvTarget where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.SrvTarget.srvTargetCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Structs-SrvTarget.html#v:srvTargetCopy"
        })


#endif

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

foreign import ccall "g_srv_target_free" g_srv_target_free :: 
    Ptr SrvTarget ->                        -- target : TInterface (Name {namespace = "Gio", name = "SrvTarget"})
    IO ()

-- | Frees /@target@/
-- 
-- /Since: 2.22/
srvTargetFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SrvTarget
    -- ^ /@target@/: a t'GI.Gio.Structs.SrvTarget.SrvTarget'
    -> m ()
srvTargetFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SrvTarget -> m ()
srvTargetFree SrvTarget
target = 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 SrvTarget
target' <- SrvTarget -> IO (Ptr SrvTarget)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SrvTarget
target
    Ptr SrvTarget -> IO ()
g_srv_target_free Ptr SrvTarget
target'
    SrvTarget -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SrvTarget
target
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SrvTargetFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod SrvTargetFreeMethodInfo SrvTarget signature where
    overloadedMethod = srvTargetFree

instance O.OverloadedMethodInfo SrvTargetFreeMethodInfo SrvTarget where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.SrvTarget.srvTargetFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Structs-SrvTarget.html#v:srvTargetFree"
        })


#endif

-- method SrvTarget::get_hostname
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "target"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SrvTarget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSrvTarget" , 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 "g_srv_target_get_hostname" g_srv_target_get_hostname :: 
    Ptr SrvTarget ->                        -- target : TInterface (Name {namespace = "Gio", name = "SrvTarget"})
    IO CString

-- | Gets /@target@/\'s hostname (in ASCII form; if you are going to present
-- this to the user, you should use 'GI.GLib.Functions.hostnameIsAsciiEncoded' to
-- check if it contains encoded Unicode segments, and use
-- 'GI.GLib.Functions.hostnameToUnicode' to convert it if it does.)
-- 
-- /Since: 2.22/
srvTargetGetHostname ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SrvTarget
    -- ^ /@target@/: a t'GI.Gio.Structs.SrvTarget.SrvTarget'
    -> m T.Text
    -- ^ __Returns:__ /@target@/\'s hostname
srvTargetGetHostname :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SrvTarget -> m Text
srvTargetGetHostname SrvTarget
target = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr SrvTarget
target' <- SrvTarget -> IO (Ptr SrvTarget)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SrvTarget
target
    CString
result <- Ptr SrvTarget -> IO CString
g_srv_target_get_hostname Ptr SrvTarget
target'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"srvTargetGetHostname" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    SrvTarget -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SrvTarget
target
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data SrvTargetGetHostnameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod SrvTargetGetHostnameMethodInfo SrvTarget signature where
    overloadedMethod = srvTargetGetHostname

instance O.OverloadedMethodInfo SrvTargetGetHostnameMethodInfo SrvTarget where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.SrvTarget.srvTargetGetHostname",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Structs-SrvTarget.html#v:srvTargetGetHostname"
        })


#endif

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

foreign import ccall "g_srv_target_get_port" g_srv_target_get_port :: 
    Ptr SrvTarget ->                        -- target : TInterface (Name {namespace = "Gio", name = "SrvTarget"})
    IO Word16

-- | Gets /@target@/\'s port
-- 
-- /Since: 2.22/
srvTargetGetPort ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SrvTarget
    -- ^ /@target@/: a t'GI.Gio.Structs.SrvTarget.SrvTarget'
    -> m Word16
    -- ^ __Returns:__ /@target@/\'s port
srvTargetGetPort :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SrvTarget -> m Word16
srvTargetGetPort SrvTarget
target = IO Word16 -> m Word16
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> m Word16) -> IO Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ do
    Ptr SrvTarget
target' <- SrvTarget -> IO (Ptr SrvTarget)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SrvTarget
target
    Word16
result <- Ptr SrvTarget -> IO Word16
g_srv_target_get_port Ptr SrvTarget
target'
    SrvTarget -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SrvTarget
target
    Word16 -> IO Word16
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result

#if defined(ENABLE_OVERLOADING)
data SrvTargetGetPortMethodInfo
instance (signature ~ (m Word16), MonadIO m) => O.OverloadedMethod SrvTargetGetPortMethodInfo SrvTarget signature where
    overloadedMethod = srvTargetGetPort

instance O.OverloadedMethodInfo SrvTargetGetPortMethodInfo SrvTarget where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.SrvTarget.srvTargetGetPort",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Structs-SrvTarget.html#v:srvTargetGetPort"
        })


#endif

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

foreign import ccall "g_srv_target_get_priority" g_srv_target_get_priority :: 
    Ptr SrvTarget ->                        -- target : TInterface (Name {namespace = "Gio", name = "SrvTarget"})
    IO Word16

-- | Gets /@target@/\'s priority. You should not need to look at this;
-- t'GI.Gio.Objects.Resolver.Resolver' already sorts the targets according to the algorithm in
-- RFC 2782.
-- 
-- /Since: 2.22/
srvTargetGetPriority ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SrvTarget
    -- ^ /@target@/: a t'GI.Gio.Structs.SrvTarget.SrvTarget'
    -> m Word16
    -- ^ __Returns:__ /@target@/\'s priority
srvTargetGetPriority :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SrvTarget -> m Word16
srvTargetGetPriority SrvTarget
target = IO Word16 -> m Word16
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> m Word16) -> IO Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ do
    Ptr SrvTarget
target' <- SrvTarget -> IO (Ptr SrvTarget)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SrvTarget
target
    Word16
result <- Ptr SrvTarget -> IO Word16
g_srv_target_get_priority Ptr SrvTarget
target'
    SrvTarget -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SrvTarget
target
    Word16 -> IO Word16
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result

#if defined(ENABLE_OVERLOADING)
data SrvTargetGetPriorityMethodInfo
instance (signature ~ (m Word16), MonadIO m) => O.OverloadedMethod SrvTargetGetPriorityMethodInfo SrvTarget signature where
    overloadedMethod = srvTargetGetPriority

instance O.OverloadedMethodInfo SrvTargetGetPriorityMethodInfo SrvTarget where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.SrvTarget.srvTargetGetPriority",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Structs-SrvTarget.html#v:srvTargetGetPriority"
        })


#endif

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

foreign import ccall "g_srv_target_get_weight" g_srv_target_get_weight :: 
    Ptr SrvTarget ->                        -- target : TInterface (Name {namespace = "Gio", name = "SrvTarget"})
    IO Word16

-- | Gets /@target@/\'s weight. You should not need to look at this;
-- t'GI.Gio.Objects.Resolver.Resolver' already sorts the targets according to the algorithm in
-- RFC 2782.
-- 
-- /Since: 2.22/
srvTargetGetWeight ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SrvTarget
    -- ^ /@target@/: a t'GI.Gio.Structs.SrvTarget.SrvTarget'
    -> m Word16
    -- ^ __Returns:__ /@target@/\'s weight
srvTargetGetWeight :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SrvTarget -> m Word16
srvTargetGetWeight SrvTarget
target = IO Word16 -> m Word16
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> m Word16) -> IO Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ do
    Ptr SrvTarget
target' <- SrvTarget -> IO (Ptr SrvTarget)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SrvTarget
target
    Word16
result <- Ptr SrvTarget -> IO Word16
g_srv_target_get_weight Ptr SrvTarget
target'
    SrvTarget -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SrvTarget
target
    Word16 -> IO Word16
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result

#if defined(ENABLE_OVERLOADING)
data SrvTargetGetWeightMethodInfo
instance (signature ~ (m Word16), MonadIO m) => O.OverloadedMethod SrvTargetGetWeightMethodInfo SrvTarget signature where
    overloadedMethod = srvTargetGetWeight

instance O.OverloadedMethodInfo SrvTargetGetWeightMethodInfo SrvTarget where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.SrvTarget.srvTargetGetWeight",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Structs-SrvTarget.html#v:srvTargetGetWeight"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveSrvTargetMethod (t :: Symbol) (o :: *) :: * where
    ResolveSrvTargetMethod "copy" o = SrvTargetCopyMethodInfo
    ResolveSrvTargetMethod "free" o = SrvTargetFreeMethodInfo
    ResolveSrvTargetMethod "getHostname" o = SrvTargetGetHostnameMethodInfo
    ResolveSrvTargetMethod "getPort" o = SrvTargetGetPortMethodInfo
    ResolveSrvTargetMethod "getPriority" o = SrvTargetGetPriorityMethodInfo
    ResolveSrvTargetMethod "getWeight" o = SrvTargetGetWeightMethodInfo
    ResolveSrvTargetMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif