{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Like t'GI.Gio.Objects.NetworkAddress.NetworkAddress' does with hostnames, t'GI.Gio.Objects.NetworkService.NetworkService'
-- provides an easy way to resolve a SRV record, and then attempt to
-- connect to one of the hosts that implements that service, handling
-- service priority\/weighting, multiple IP addresses, and multiple
-- address families.
-- 
-- See t'GI.Gio.Structs.SrvTarget.SrvTarget' for more information about SRV records, and see
-- t'GI.Gio.Interfaces.SocketConnectable.SocketConnectable' for an example of using the connectable
-- interface.

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

module GI.Gio.Objects.NetworkService
    ( 

-- * Exported types
    NetworkService(..)                      ,
    IsNetworkService                        ,
    toNetworkService                        ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [enumerate]("GI.Gio.Interfaces.SocketConnectable#g:method:enumerate"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [proxyEnumerate]("GI.Gio.Interfaces.SocketConnectable#g:method:proxyEnumerate"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [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"), [toString]("GI.Gio.Interfaces.SocketConnectable#g:method:toString"), [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"), [getDomain]("GI.Gio.Objects.NetworkService#g:method:getDomain"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getProtocol]("GI.Gio.Objects.NetworkService#g:method:getProtocol"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getScheme]("GI.Gio.Objects.NetworkService#g:method:getScheme"), [getService]("GI.Gio.Objects.NetworkService#g:method:getService").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setScheme]("GI.Gio.Objects.NetworkService#g:method:setScheme").

#if defined(ENABLE_OVERLOADING)
    ResolveNetworkServiceMethod             ,
#endif

-- ** getDomain #method:getDomain#

#if defined(ENABLE_OVERLOADING)
    NetworkServiceGetDomainMethodInfo       ,
#endif
    networkServiceGetDomain                 ,


-- ** getProtocol #method:getProtocol#

#if defined(ENABLE_OVERLOADING)
    NetworkServiceGetProtocolMethodInfo     ,
#endif
    networkServiceGetProtocol               ,


-- ** getScheme #method:getScheme#

#if defined(ENABLE_OVERLOADING)
    NetworkServiceGetSchemeMethodInfo       ,
#endif
    networkServiceGetScheme                 ,


-- ** getService #method:getService#

#if defined(ENABLE_OVERLOADING)
    NetworkServiceGetServiceMethodInfo      ,
#endif
    networkServiceGetService                ,


-- ** new #method:new#

    networkServiceNew                       ,


-- ** setScheme #method:setScheme#

#if defined(ENABLE_OVERLOADING)
    NetworkServiceSetSchemeMethodInfo       ,
#endif
    networkServiceSetScheme                 ,




 -- * Properties


-- ** domain #attr:domain#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    NetworkServiceDomainPropertyInfo        ,
#endif
    constructNetworkServiceDomain           ,
    getNetworkServiceDomain                 ,
#if defined(ENABLE_OVERLOADING)
    networkServiceDomain                    ,
#endif


-- ** protocol #attr:protocol#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    NetworkServiceProtocolPropertyInfo      ,
#endif
    constructNetworkServiceProtocol         ,
    getNetworkServiceProtocol               ,
#if defined(ENABLE_OVERLOADING)
    networkServiceProtocol                  ,
#endif


-- ** scheme #attr:scheme#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    NetworkServiceSchemePropertyInfo        ,
#endif
    constructNetworkServiceScheme           ,
    getNetworkServiceScheme                 ,
#if defined(ENABLE_OVERLOADING)
    networkServiceScheme                    ,
#endif
    setNetworkServiceScheme                 ,


-- ** service #attr:service#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    NetworkServiceServicePropertyInfo       ,
#endif
    constructNetworkServiceService          ,
    getNetworkServiceService                ,
#if defined(ENABLE_OVERLOADING)
    networkServiceService                   ,
#endif




    ) 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.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.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gio.Interfaces.SocketConnectable as Gio.SocketConnectable

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

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

foreign import ccall "g_network_service_get_type"
    c_g_network_service_get_type :: IO B.Types.GType

instance B.Types.TypedObject NetworkService where
    glibType :: IO GType
glibType = IO GType
c_g_network_service_get_type

instance B.Types.GObject NetworkService

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

instance O.HasParentTypes NetworkService
type instance O.ParentTypes NetworkService = '[GObject.Object.Object, Gio.SocketConnectable.SocketConnectable]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveNetworkServiceMethod (t :: Symbol) (o :: *) :: * where
    ResolveNetworkServiceMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveNetworkServiceMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveNetworkServiceMethod "enumerate" o = Gio.SocketConnectable.SocketConnectableEnumerateMethodInfo
    ResolveNetworkServiceMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveNetworkServiceMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveNetworkServiceMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveNetworkServiceMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveNetworkServiceMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveNetworkServiceMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveNetworkServiceMethod "proxyEnumerate" o = Gio.SocketConnectable.SocketConnectableProxyEnumerateMethodInfo
    ResolveNetworkServiceMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveNetworkServiceMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveNetworkServiceMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveNetworkServiceMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveNetworkServiceMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveNetworkServiceMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveNetworkServiceMethod "toString" o = Gio.SocketConnectable.SocketConnectableToStringMethodInfo
    ResolveNetworkServiceMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveNetworkServiceMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveNetworkServiceMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveNetworkServiceMethod "getDomain" o = NetworkServiceGetDomainMethodInfo
    ResolveNetworkServiceMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveNetworkServiceMethod "getProtocol" o = NetworkServiceGetProtocolMethodInfo
    ResolveNetworkServiceMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveNetworkServiceMethod "getScheme" o = NetworkServiceGetSchemeMethodInfo
    ResolveNetworkServiceMethod "getService" o = NetworkServiceGetServiceMethodInfo
    ResolveNetworkServiceMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveNetworkServiceMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveNetworkServiceMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveNetworkServiceMethod "setScheme" o = NetworkServiceSetSchemeMethodInfo
    ResolveNetworkServiceMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "domain"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@domain@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructNetworkServiceDomain :: (IsNetworkService o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructNetworkServiceDomain :: forall o (m :: * -> *).
(IsNetworkService o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructNetworkServiceDomain Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
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 -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"domain" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data NetworkServiceDomainPropertyInfo
instance AttrInfo NetworkServiceDomainPropertyInfo where
    type AttrAllowedOps NetworkServiceDomainPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint NetworkServiceDomainPropertyInfo = IsNetworkService
    type AttrSetTypeConstraint NetworkServiceDomainPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint NetworkServiceDomainPropertyInfo = (~) T.Text
    type AttrTransferType NetworkServiceDomainPropertyInfo = T.Text
    type AttrGetType NetworkServiceDomainPropertyInfo = T.Text
    type AttrLabel NetworkServiceDomainPropertyInfo = "domain"
    type AttrOrigin NetworkServiceDomainPropertyInfo = NetworkService
    attrGet = getNetworkServiceDomain
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructNetworkServiceDomain
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.NetworkService.domain"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-NetworkService.html#g:attr:domain"
        })
#endif

-- VVV Prop "protocol"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@protocol@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructNetworkServiceProtocol :: (IsNetworkService o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructNetworkServiceProtocol :: forall o (m :: * -> *).
(IsNetworkService o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructNetworkServiceProtocol Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
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 -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"protocol" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data NetworkServiceProtocolPropertyInfo
instance AttrInfo NetworkServiceProtocolPropertyInfo where
    type AttrAllowedOps NetworkServiceProtocolPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint NetworkServiceProtocolPropertyInfo = IsNetworkService
    type AttrSetTypeConstraint NetworkServiceProtocolPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint NetworkServiceProtocolPropertyInfo = (~) T.Text
    type AttrTransferType NetworkServiceProtocolPropertyInfo = T.Text
    type AttrGetType NetworkServiceProtocolPropertyInfo = T.Text
    type AttrLabel NetworkServiceProtocolPropertyInfo = "protocol"
    type AttrOrigin NetworkServiceProtocolPropertyInfo = NetworkService
    attrGet = getNetworkServiceProtocol
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructNetworkServiceProtocol
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.NetworkService.protocol"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-NetworkService.html#g:attr:protocol"
        })
#endif

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

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

-- | Set the value of the “@scheme@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' networkService [ #scheme 'Data.GI.Base.Attributes.:=' value ]
-- @
setNetworkServiceScheme :: (MonadIO m, IsNetworkService o) => o -> T.Text -> m ()
setNetworkServiceScheme :: forall (m :: * -> *) o.
(MonadIO m, IsNetworkService o) =>
o -> Text -> m ()
setNetworkServiceScheme o
obj Text
val = IO () -> m ()
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 -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"scheme" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@scheme@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructNetworkServiceScheme :: (IsNetworkService o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructNetworkServiceScheme :: forall o (m :: * -> *).
(IsNetworkService o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructNetworkServiceScheme Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
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 -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"scheme" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data NetworkServiceSchemePropertyInfo
instance AttrInfo NetworkServiceSchemePropertyInfo where
    type AttrAllowedOps NetworkServiceSchemePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint NetworkServiceSchemePropertyInfo = IsNetworkService
    type AttrSetTypeConstraint NetworkServiceSchemePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint NetworkServiceSchemePropertyInfo = (~) T.Text
    type AttrTransferType NetworkServiceSchemePropertyInfo = T.Text
    type AttrGetType NetworkServiceSchemePropertyInfo = T.Text
    type AttrLabel NetworkServiceSchemePropertyInfo = "scheme"
    type AttrOrigin NetworkServiceSchemePropertyInfo = NetworkService
    attrGet = getNetworkServiceScheme
    attrSet = setNetworkServiceScheme
    attrTransfer _ v = do
        return v
    attrConstruct = constructNetworkServiceScheme
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.NetworkService.scheme"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-NetworkService.html#g:attr:scheme"
        })
#endif

-- VVV Prop "service"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@service@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructNetworkServiceService :: (IsNetworkService o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructNetworkServiceService :: forall o (m :: * -> *).
(IsNetworkService o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructNetworkServiceService Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
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 -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"service" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data NetworkServiceServicePropertyInfo
instance AttrInfo NetworkServiceServicePropertyInfo where
    type AttrAllowedOps NetworkServiceServicePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint NetworkServiceServicePropertyInfo = IsNetworkService
    type AttrSetTypeConstraint NetworkServiceServicePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint NetworkServiceServicePropertyInfo = (~) T.Text
    type AttrTransferType NetworkServiceServicePropertyInfo = T.Text
    type AttrGetType NetworkServiceServicePropertyInfo = T.Text
    type AttrLabel NetworkServiceServicePropertyInfo = "service"
    type AttrOrigin NetworkServiceServicePropertyInfo = NetworkService
    attrGet = getNetworkServiceService
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructNetworkServiceService
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.NetworkService.service"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-NetworkService.html#g:attr:service"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList NetworkService
type instance O.AttributeList NetworkService = NetworkServiceAttributeList
type NetworkServiceAttributeList = ('[ '("domain", NetworkServiceDomainPropertyInfo), '("protocol", NetworkServiceProtocolPropertyInfo), '("scheme", NetworkServiceSchemePropertyInfo), '("service", NetworkServiceServicePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
networkServiceDomain :: AttrLabelProxy "domain"
networkServiceDomain = AttrLabelProxy

networkServiceProtocol :: AttrLabelProxy "protocol"
networkServiceProtocol = AttrLabelProxy

networkServiceScheme :: AttrLabelProxy "scheme"
networkServiceScheme = AttrLabelProxy

networkServiceService :: AttrLabelProxy "service"
networkServiceService = AttrLabelProxy

#endif

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

#endif

-- method NetworkService::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "service"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the service type to look up (eg, \"ldap\")"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "protocol"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the networking protocol to use for @service (eg, \"tcp\")"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "domain"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the DNS domain to look up the service in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "NetworkService" })
-- throws : False
-- Skip return : False

foreign import ccall "g_network_service_new" g_network_service_new :: 
    CString ->                              -- service : TBasicType TUTF8
    CString ->                              -- protocol : TBasicType TUTF8
    CString ->                              -- domain : TBasicType TUTF8
    IO (Ptr NetworkService)

-- | Creates a new t'GI.Gio.Objects.NetworkService.NetworkService' representing the given /@service@/,
-- /@protocol@/, and /@domain@/. This will initially be unresolved; use the
-- t'GI.Gio.Interfaces.SocketConnectable.SocketConnectable' interface to resolve it.
-- 
-- /Since: 2.22/
networkServiceNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@service@/: the service type to look up (eg, \"ldap\")
    -> T.Text
    -- ^ /@protocol@/: the networking protocol to use for /@service@/ (eg, \"tcp\")
    -> T.Text
    -- ^ /@domain@/: the DNS domain to look up the service in
    -> m NetworkService
    -- ^ __Returns:__ a new t'GI.Gio.Objects.NetworkService.NetworkService'
networkServiceNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Text -> Text -> m NetworkService
networkServiceNew Text
service Text
protocol Text
domain = IO NetworkService -> m NetworkService
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NetworkService -> m NetworkService)
-> IO NetworkService -> m NetworkService
forall a b. (a -> b) -> a -> b
$ do
    CString
service' <- Text -> IO CString
textToCString Text
service
    CString
protocol' <- Text -> IO CString
textToCString Text
protocol
    CString
domain' <- Text -> IO CString
textToCString Text
domain
    Ptr NetworkService
result <- CString -> CString -> CString -> IO (Ptr NetworkService)
g_network_service_new CString
service' CString
protocol' CString
domain'
    Text -> Ptr NetworkService -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"networkServiceNew" Ptr NetworkService
result
    NetworkService
result' <- ((ManagedPtr NetworkService -> NetworkService)
-> Ptr NetworkService -> IO NetworkService
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr NetworkService -> NetworkService
NetworkService) Ptr NetworkService
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
service'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
protocol'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
domain'
    NetworkService -> IO NetworkService
forall (m :: * -> *) a. Monad m => a -> m a
return NetworkService
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method NetworkService::get_domain
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "srv"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "NetworkService" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GNetworkService" , 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_network_service_get_domain" g_network_service_get_domain :: 
    Ptr NetworkService ->                   -- srv : TInterface (Name {namespace = "Gio", name = "NetworkService"})
    IO CString

-- | Gets the domain that /@srv@/ serves. This might be either UTF-8 or
-- ASCII-encoded, depending on what /@srv@/ was created with.
-- 
-- /Since: 2.22/
networkServiceGetDomain ::
    (B.CallStack.HasCallStack, MonadIO m, IsNetworkService a) =>
    a
    -- ^ /@srv@/: a t'GI.Gio.Objects.NetworkService.NetworkService'
    -> m T.Text
    -- ^ __Returns:__ /@srv@/\'s domain name
networkServiceGetDomain :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNetworkService a) =>
a -> m Text
networkServiceGetDomain a
srv = IO Text -> m Text
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 NetworkService
srv' <- a -> IO (Ptr NetworkService)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
srv
    CString
result <- Ptr NetworkService -> IO CString
g_network_service_get_domain Ptr NetworkService
srv'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"networkServiceGetDomain" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
srv
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data NetworkServiceGetDomainMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsNetworkService a) => O.OverloadedMethod NetworkServiceGetDomainMethodInfo a signature where
    overloadedMethod = networkServiceGetDomain

instance O.OverloadedMethodInfo NetworkServiceGetDomainMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.NetworkService.networkServiceGetDomain",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-NetworkService.html#v:networkServiceGetDomain"
        })


#endif

-- method NetworkService::get_protocol
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "srv"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "NetworkService" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GNetworkService" , 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_network_service_get_protocol" g_network_service_get_protocol :: 
    Ptr NetworkService ->                   -- srv : TInterface (Name {namespace = "Gio", name = "NetworkService"})
    IO CString

-- | Gets /@srv@/\'s protocol name (eg, \"tcp\").
-- 
-- /Since: 2.22/
networkServiceGetProtocol ::
    (B.CallStack.HasCallStack, MonadIO m, IsNetworkService a) =>
    a
    -- ^ /@srv@/: a t'GI.Gio.Objects.NetworkService.NetworkService'
    -> m T.Text
    -- ^ __Returns:__ /@srv@/\'s protocol name
networkServiceGetProtocol :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNetworkService a) =>
a -> m Text
networkServiceGetProtocol a
srv = IO Text -> m Text
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 NetworkService
srv' <- a -> IO (Ptr NetworkService)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
srv
    CString
result <- Ptr NetworkService -> IO CString
g_network_service_get_protocol Ptr NetworkService
srv'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"networkServiceGetProtocol" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
srv
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data NetworkServiceGetProtocolMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsNetworkService a) => O.OverloadedMethod NetworkServiceGetProtocolMethodInfo a signature where
    overloadedMethod = networkServiceGetProtocol

instance O.OverloadedMethodInfo NetworkServiceGetProtocolMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.NetworkService.networkServiceGetProtocol",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-NetworkService.html#v:networkServiceGetProtocol"
        })


#endif

-- method NetworkService::get_scheme
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "srv"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "NetworkService" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GNetworkService" , 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_network_service_get_scheme" g_network_service_get_scheme :: 
    Ptr NetworkService ->                   -- srv : TInterface (Name {namespace = "Gio", name = "NetworkService"})
    IO CString

-- | Gets the URI scheme used to resolve proxies. By default, the service name
-- is used as scheme.
-- 
-- /Since: 2.26/
networkServiceGetScheme ::
    (B.CallStack.HasCallStack, MonadIO m, IsNetworkService a) =>
    a
    -- ^ /@srv@/: a t'GI.Gio.Objects.NetworkService.NetworkService'
    -> m T.Text
    -- ^ __Returns:__ /@srv@/\'s scheme name
networkServiceGetScheme :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNetworkService a) =>
a -> m Text
networkServiceGetScheme a
srv = IO Text -> m Text
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 NetworkService
srv' <- a -> IO (Ptr NetworkService)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
srv
    CString
result <- Ptr NetworkService -> IO CString
g_network_service_get_scheme Ptr NetworkService
srv'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"networkServiceGetScheme" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
srv
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data NetworkServiceGetSchemeMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsNetworkService a) => O.OverloadedMethod NetworkServiceGetSchemeMethodInfo a signature where
    overloadedMethod = networkServiceGetScheme

instance O.OverloadedMethodInfo NetworkServiceGetSchemeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.NetworkService.networkServiceGetScheme",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-NetworkService.html#v:networkServiceGetScheme"
        })


#endif

-- method NetworkService::get_service
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "srv"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "NetworkService" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GNetworkService" , 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_network_service_get_service" g_network_service_get_service :: 
    Ptr NetworkService ->                   -- srv : TInterface (Name {namespace = "Gio", name = "NetworkService"})
    IO CString

-- | Gets /@srv@/\'s service name (eg, \"ldap\").
-- 
-- /Since: 2.22/
networkServiceGetService ::
    (B.CallStack.HasCallStack, MonadIO m, IsNetworkService a) =>
    a
    -- ^ /@srv@/: a t'GI.Gio.Objects.NetworkService.NetworkService'
    -> m T.Text
    -- ^ __Returns:__ /@srv@/\'s service name
networkServiceGetService :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNetworkService a) =>
a -> m Text
networkServiceGetService a
srv = IO Text -> m Text
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 NetworkService
srv' <- a -> IO (Ptr NetworkService)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
srv
    CString
result <- Ptr NetworkService -> IO CString
g_network_service_get_service Ptr NetworkService
srv'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"networkServiceGetService" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
srv
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data NetworkServiceGetServiceMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsNetworkService a) => O.OverloadedMethod NetworkServiceGetServiceMethodInfo a signature where
    overloadedMethod = networkServiceGetService

instance O.OverloadedMethodInfo NetworkServiceGetServiceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.NetworkService.networkServiceGetService",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-NetworkService.html#v:networkServiceGetService"
        })


#endif

-- method NetworkService::set_scheme
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "srv"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "NetworkService" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GNetworkService" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scheme"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a URI scheme" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_network_service_set_scheme" g_network_service_set_scheme :: 
    Ptr NetworkService ->                   -- srv : TInterface (Name {namespace = "Gio", name = "NetworkService"})
    CString ->                              -- scheme : TBasicType TUTF8
    IO ()

-- | Set\'s the URI scheme used to resolve proxies. By default, the service name
-- is used as scheme.
-- 
-- /Since: 2.26/
networkServiceSetScheme ::
    (B.CallStack.HasCallStack, MonadIO m, IsNetworkService a) =>
    a
    -- ^ /@srv@/: a t'GI.Gio.Objects.NetworkService.NetworkService'
    -> T.Text
    -- ^ /@scheme@/: a URI scheme
    -> m ()
networkServiceSetScheme :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNetworkService a) =>
a -> Text -> m ()
networkServiceSetScheme a
srv Text
scheme = 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 NetworkService
srv' <- a -> IO (Ptr NetworkService)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
srv
    CString
scheme' <- Text -> IO CString
textToCString Text
scheme
    Ptr NetworkService -> CString -> IO ()
g_network_service_set_scheme Ptr NetworkService
srv' CString
scheme'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
srv
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
scheme'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NetworkServiceSetSchemeMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsNetworkService a) => O.OverloadedMethod NetworkServiceSetSchemeMethodInfo a signature where
    overloadedMethod = networkServiceSetScheme

instance O.OverloadedMethodInfo NetworkServiceSetSchemeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.NetworkService.networkServiceSetScheme",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-NetworkService.html#v:networkServiceSetScheme"
        })


#endif