{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Support for UNIX-domain (also known as local) sockets.
-- 
-- UNIX domain sockets are generally visible in the filesystem.
-- However, some systems support abstract socket names which are not
-- visible in the filesystem and not affected by the filesystem
-- permissions, visibility, etc. Currently this is only supported
-- under Linux. If you attempt to use abstract sockets on other
-- systems, function calls may return 'GI.Gio.Enums.IOErrorEnumNotSupported'
-- errors. You can use 'GI.Gio.Objects.UnixSocketAddress.unixSocketAddressAbstractNamesSupported'
-- to see if abstract names are supported.
-- 
-- Since GLib 2.72, t'GI.Gio.Objects.UnixSocketAddress.UnixSocketAddress' is available on all platforms. It
-- requires underlying system support (such as Windows 10 with @AF_UNIX@) at
-- run time.
-- 
-- Before GLib 2.72, @\<gio\/gunixsocketaddress.h>@ belonged to the UNIX-specific
-- GIO interfaces, thus you had to use the @gio-unix-2.0.pc@ pkg-config file
-- when using it. This is no longer necessary since GLib 2.72.

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

module GI.Gio.Objects.UnixSocketAddress
    ( 

-- * Exported types
    UnixSocketAddress(..)                   ,
    IsUnixSocketAddress                     ,
    toUnixSocketAddress                     ,


 -- * 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"), [toNative]("GI.Gio.Objects.SocketAddress#g:method:toNative"), [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
-- [getAddressType]("GI.Gio.Objects.UnixSocketAddress#g:method:getAddressType"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFamily]("GI.Gio.Objects.SocketAddress#g:method:getFamily"), [getIsAbstract]("GI.Gio.Objects.UnixSocketAddress#g:method:getIsAbstract"), [getNativeSize]("GI.Gio.Objects.SocketAddress#g:method:getNativeSize"), [getPath]("GI.Gio.Objects.UnixSocketAddress#g:method:getPath"), [getPathLen]("GI.Gio.Objects.UnixSocketAddress#g:method:getPathLen"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveUnixSocketAddressMethod          ,
#endif

-- ** abstractNamesSupported #method:abstractNamesSupported#

    unixSocketAddressAbstractNamesSupported ,


-- ** getAddressType #method:getAddressType#

#if defined(ENABLE_OVERLOADING)
    UnixSocketAddressGetAddressTypeMethodInfo,
#endif
    unixSocketAddressGetAddressType         ,


-- ** getIsAbstract #method:getIsAbstract#

#if defined(ENABLE_OVERLOADING)
    UnixSocketAddressGetIsAbstractMethodInfo,
#endif
    unixSocketAddressGetIsAbstract          ,


-- ** getPath #method:getPath#

#if defined(ENABLE_OVERLOADING)
    UnixSocketAddressGetPathMethodInfo      ,
#endif
    unixSocketAddressGetPath                ,


-- ** getPathLen #method:getPathLen#

#if defined(ENABLE_OVERLOADING)
    UnixSocketAddressGetPathLenMethodInfo   ,
#endif
    unixSocketAddressGetPathLen             ,


-- ** new #method:new#

    unixSocketAddressNew                    ,


-- ** newAbstract #method:newAbstract#

    unixSocketAddressNewAbstract            ,


-- ** newWithType #method:newWithType#

    unixSocketAddressNewWithType            ,




 -- * Properties


-- ** abstract #attr:abstract#
-- | Whether or not this is an abstract address

#if defined(ENABLE_OVERLOADING)
    UnixSocketAddressAbstractPropertyInfo   ,
#endif
    constructUnixSocketAddressAbstract      ,
    getUnixSocketAddressAbstract            ,
#if defined(ENABLE_OVERLOADING)
    unixSocketAddressAbstract               ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    UnixSocketAddressAddressTypePropertyInfo,
#endif
    constructUnixSocketAddressAddressType   ,
    getUnixSocketAddressAddressType         ,
#if defined(ENABLE_OVERLOADING)
    unixSocketAddressAddressType            ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    UnixSocketAddressPathPropertyInfo       ,
#endif
    constructUnixSocketAddressPath          ,
    getUnixSocketAddressPath                ,
#if defined(ENABLE_OVERLOADING)
    unixSocketAddressPath                   ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    UnixSocketAddressPathAsArrayPropertyInfo,
#endif
    constructUnixSocketAddressPathAsArray   ,
    getUnixSocketAddressPathAsArray         ,
#if defined(ENABLE_OVERLOADING)
    unixSocketAddressPathAsArray            ,
#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.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gio.Enums as Gio.Enums
import {-# SOURCE #-} qualified GI.Gio.Interfaces.SocketConnectable as Gio.SocketConnectable
import {-# SOURCE #-} qualified GI.Gio.Objects.SocketAddress as Gio.SocketAddress

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

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

foreign import ccall "g_unix_socket_address_get_type"
    c_g_unix_socket_address_get_type :: IO B.Types.GType

instance B.Types.TypedObject UnixSocketAddress where
    glibType :: IO GType
glibType = IO GType
c_g_unix_socket_address_get_type

instance B.Types.GObject UnixSocketAddress

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveUnixSocketAddressMethod (t :: Symbol) (o :: *) :: * where
    ResolveUnixSocketAddressMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveUnixSocketAddressMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveUnixSocketAddressMethod "enumerate" o = Gio.SocketConnectable.SocketConnectableEnumerateMethodInfo
    ResolveUnixSocketAddressMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveUnixSocketAddressMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveUnixSocketAddressMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveUnixSocketAddressMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveUnixSocketAddressMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveUnixSocketAddressMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveUnixSocketAddressMethod "proxyEnumerate" o = Gio.SocketConnectable.SocketConnectableProxyEnumerateMethodInfo
    ResolveUnixSocketAddressMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveUnixSocketAddressMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveUnixSocketAddressMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveUnixSocketAddressMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveUnixSocketAddressMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveUnixSocketAddressMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveUnixSocketAddressMethod "toNative" o = Gio.SocketAddress.SocketAddressToNativeMethodInfo
    ResolveUnixSocketAddressMethod "toString" o = Gio.SocketConnectable.SocketConnectableToStringMethodInfo
    ResolveUnixSocketAddressMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveUnixSocketAddressMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveUnixSocketAddressMethod "getAddressType" o = UnixSocketAddressGetAddressTypeMethodInfo
    ResolveUnixSocketAddressMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveUnixSocketAddressMethod "getFamily" o = Gio.SocketAddress.SocketAddressGetFamilyMethodInfo
    ResolveUnixSocketAddressMethod "getIsAbstract" o = UnixSocketAddressGetIsAbstractMethodInfo
    ResolveUnixSocketAddressMethod "getNativeSize" o = Gio.SocketAddress.SocketAddressGetNativeSizeMethodInfo
    ResolveUnixSocketAddressMethod "getPath" o = UnixSocketAddressGetPathMethodInfo
    ResolveUnixSocketAddressMethod "getPathLen" o = UnixSocketAddressGetPathLenMethodInfo
    ResolveUnixSocketAddressMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveUnixSocketAddressMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveUnixSocketAddressMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveUnixSocketAddressMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveUnixSocketAddressMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveUnixSocketAddressMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "abstract"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@abstract@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' unixSocketAddress #abstract
-- @
getUnixSocketAddressAbstract :: (MonadIO m, IsUnixSocketAddress o) => o -> m Bool
getUnixSocketAddressAbstract :: forall (m :: * -> *) o.
(MonadIO m, IsUnixSocketAddress o) =>
o -> m Bool
getUnixSocketAddressAbstract o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"abstract"

-- | Construct a `GValueConstruct` with valid value for the “@abstract@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructUnixSocketAddressAbstract :: (IsUnixSocketAddress o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructUnixSocketAddressAbstract :: forall o (m :: * -> *).
(IsUnixSocketAddress o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructUnixSocketAddressAbstract Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"abstract" Bool
val

#if defined(ENABLE_OVERLOADING)
data UnixSocketAddressAbstractPropertyInfo
instance AttrInfo UnixSocketAddressAbstractPropertyInfo where
    type AttrAllowedOps UnixSocketAddressAbstractPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint UnixSocketAddressAbstractPropertyInfo = IsUnixSocketAddress
    type AttrSetTypeConstraint UnixSocketAddressAbstractPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint UnixSocketAddressAbstractPropertyInfo = (~) Bool
    type AttrTransferType UnixSocketAddressAbstractPropertyInfo = Bool
    type AttrGetType UnixSocketAddressAbstractPropertyInfo = Bool
    type AttrLabel UnixSocketAddressAbstractPropertyInfo = "abstract"
    type AttrOrigin UnixSocketAddressAbstractPropertyInfo = UnixSocketAddress
    attrGet = getUnixSocketAddressAbstract
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructUnixSocketAddressAbstract
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.UnixSocketAddress.abstract"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Objects-UnixSocketAddress.html#g:attr:abstract"
        })
#endif

-- VVV Prop "address-type"
   -- Type: TInterface (Name {namespace = "Gio", name = "UnixSocketAddressType"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@address-type@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructUnixSocketAddressAddressType :: (IsUnixSocketAddress o, MIO.MonadIO m) => Gio.Enums.UnixSocketAddressType -> m (GValueConstruct o)
constructUnixSocketAddressAddressType :: forall o (m :: * -> *).
(IsUnixSocketAddress o, MonadIO m) =>
UnixSocketAddressType -> m (GValueConstruct o)
constructUnixSocketAddressAddressType UnixSocketAddressType
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> UnixSocketAddressType -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"address-type" UnixSocketAddressType
val

#if defined(ENABLE_OVERLOADING)
data UnixSocketAddressAddressTypePropertyInfo
instance AttrInfo UnixSocketAddressAddressTypePropertyInfo where
    type AttrAllowedOps UnixSocketAddressAddressTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint UnixSocketAddressAddressTypePropertyInfo = IsUnixSocketAddress
    type AttrSetTypeConstraint UnixSocketAddressAddressTypePropertyInfo = (~) Gio.Enums.UnixSocketAddressType
    type AttrTransferTypeConstraint UnixSocketAddressAddressTypePropertyInfo = (~) Gio.Enums.UnixSocketAddressType
    type AttrTransferType UnixSocketAddressAddressTypePropertyInfo = Gio.Enums.UnixSocketAddressType
    type AttrGetType UnixSocketAddressAddressTypePropertyInfo = Gio.Enums.UnixSocketAddressType
    type AttrLabel UnixSocketAddressAddressTypePropertyInfo = "address-type"
    type AttrOrigin UnixSocketAddressAddressTypePropertyInfo = UnixSocketAddress
    attrGet = getUnixSocketAddressAddressType
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructUnixSocketAddressAddressType
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.UnixSocketAddress.addressType"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Objects-UnixSocketAddress.html#g:attr:addressType"
        })
#endif

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

-- | Get the value of the “@path@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' unixSocketAddress #path
-- @
getUnixSocketAddressPath :: (MonadIO m, IsUnixSocketAddress o) => o -> m T.Text
getUnixSocketAddressPath :: forall (m :: * -> *) o.
(MonadIO m, IsUnixSocketAddress o) =>
o -> m Text
getUnixSocketAddressPath o
obj = IO Text -> m Text
forall a. IO a -> m a
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
"getUnixSocketAddressPath" (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
"path"

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

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

-- VVV Prop "path-as-array"
   -- Type: TByteArray
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@path-as-array@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' unixSocketAddress #pathAsArray
-- @
getUnixSocketAddressPathAsArray :: (MonadIO m, IsUnixSocketAddress o) => o -> m (Maybe ByteString)
getUnixSocketAddressPathAsArray :: forall (m :: * -> *) o.
(MonadIO m, IsUnixSocketAddress o) =>
o -> m (Maybe ByteString)
getUnixSocketAddressPathAsArray o
obj = IO (Maybe ByteString) -> m (Maybe ByteString)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe ByteString) -> m (Maybe ByteString))
-> IO (Maybe ByteString) -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe ByteString)
forall a. GObject a => a -> String -> IO (Maybe ByteString)
B.Properties.getObjectPropertyByteArray o
obj String
"path-as-array"

-- | Construct a `GValueConstruct` with valid value for the “@path-as-array@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructUnixSocketAddressPathAsArray :: (IsUnixSocketAddress o, MIO.MonadIO m) => ByteString -> m (GValueConstruct o)
constructUnixSocketAddressPathAsArray :: forall o (m :: * -> *).
(IsUnixSocketAddress o, MonadIO m) =>
ByteString -> m (GValueConstruct o)
constructUnixSocketAddressPathAsArray ByteString
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe ByteString -> IO (GValueConstruct o)
forall o. String -> Maybe ByteString -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyByteArray String
"path-as-array" (ByteString -> Maybe ByteString
forall a. a -> Maybe a
P.Just ByteString
val)

#if defined(ENABLE_OVERLOADING)
data UnixSocketAddressPathAsArrayPropertyInfo
instance AttrInfo UnixSocketAddressPathAsArrayPropertyInfo where
    type AttrAllowedOps UnixSocketAddressPathAsArrayPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint UnixSocketAddressPathAsArrayPropertyInfo = IsUnixSocketAddress
    type AttrSetTypeConstraint UnixSocketAddressPathAsArrayPropertyInfo = (~) ByteString
    type AttrTransferTypeConstraint UnixSocketAddressPathAsArrayPropertyInfo = (~) ByteString
    type AttrTransferType UnixSocketAddressPathAsArrayPropertyInfo = ByteString
    type AttrGetType UnixSocketAddressPathAsArrayPropertyInfo = (Maybe ByteString)
    type AttrLabel UnixSocketAddressPathAsArrayPropertyInfo = "path-as-array"
    type AttrOrigin UnixSocketAddressPathAsArrayPropertyInfo = UnixSocketAddress
    attrGet = getUnixSocketAddressPathAsArray
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructUnixSocketAddressPathAsArray
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.UnixSocketAddress.pathAsArray"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Objects-UnixSocketAddress.html#g:attr:pathAsArray"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList UnixSocketAddress
type instance O.AttributeList UnixSocketAddress = UnixSocketAddressAttributeList
type UnixSocketAddressAttributeList = ('[ '("abstract", UnixSocketAddressAbstractPropertyInfo), '("addressType", UnixSocketAddressAddressTypePropertyInfo), '("family", Gio.SocketAddress.SocketAddressFamilyPropertyInfo), '("path", UnixSocketAddressPathPropertyInfo), '("pathAsArray", UnixSocketAddressPathAsArrayPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
unixSocketAddressAbstract :: AttrLabelProxy "abstract"
unixSocketAddressAbstract = AttrLabelProxy

unixSocketAddressAddressType :: AttrLabelProxy "addressType"
unixSocketAddressAddressType = AttrLabelProxy

unixSocketAddressPath :: AttrLabelProxy "path"
unixSocketAddressPath = AttrLabelProxy

unixSocketAddressPathAsArray :: AttrLabelProxy "pathAsArray"
unixSocketAddressPathAsArray = AttrLabelProxy

#endif

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

#endif

-- method UnixSocketAddress::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the socket path" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "UnixSocketAddress" })
-- throws : False
-- Skip return : False

foreign import ccall "g_unix_socket_address_new" g_unix_socket_address_new :: 
    CString ->                              -- path : TBasicType TUTF8
    IO (Ptr UnixSocketAddress)

-- | Creates a new t'GI.Gio.Objects.UnixSocketAddress.UnixSocketAddress' for /@path@/.
-- 
-- To create abstract socket addresses, on systems that support that,
-- use 'GI.Gio.Objects.UnixSocketAddress.unixSocketAddressNewAbstract'.
-- 
-- /Since: 2.22/
unixSocketAddressNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@path@/: the socket path
    -> m UnixSocketAddress
    -- ^ __Returns:__ a new t'GI.Gio.Objects.UnixSocketAddress.UnixSocketAddress'
unixSocketAddressNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m UnixSocketAddress
unixSocketAddressNew Text
path = IO UnixSocketAddress -> m UnixSocketAddress
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UnixSocketAddress -> m UnixSocketAddress)
-> IO UnixSocketAddress -> m UnixSocketAddress
forall a b. (a -> b) -> a -> b
$ do
    CString
path' <- Text -> IO CString
textToCString Text
path
    Ptr UnixSocketAddress
result <- CString -> IO (Ptr UnixSocketAddress)
g_unix_socket_address_new CString
path'
    Text -> Ptr UnixSocketAddress -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"unixSocketAddressNew" Ptr UnixSocketAddress
result
    UnixSocketAddress
result' <- ((ManagedPtr UnixSocketAddress -> UnixSocketAddress)
-> Ptr UnixSocketAddress -> IO UnixSocketAddress
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr UnixSocketAddress -> UnixSocketAddress
UnixSocketAddress) Ptr UnixSocketAddress
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
    UnixSocketAddress -> IO UnixSocketAddress
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return UnixSocketAddress
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method UnixSocketAddress::new_abstract
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "path"
--           , argType = TCArray False (-1) 1 (TBasicType TInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the abstract name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path_len"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of @path, or -1"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "path_len"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the length of @path, or -1"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "UnixSocketAddress" })
-- throws : False
-- Skip return : False

foreign import ccall "g_unix_socket_address_new_abstract" g_unix_socket_address_new_abstract :: 
    Ptr Int8 ->                             -- path : TCArray False (-1) 1 (TBasicType TInt8)
    Int32 ->                                -- path_len : TBasicType TInt
    IO (Ptr UnixSocketAddress)

{-# DEPRECATED unixSocketAddressNewAbstract ["Use 'GI.Gio.Objects.UnixSocketAddress.unixSocketAddressNewWithType'."] #-}
-- | Creates a new 'GI.Gio.Enums.UnixSocketAddressTypeAbstractPadded'
-- t'GI.Gio.Objects.UnixSocketAddress.UnixSocketAddress' for /@path@/.
unixSocketAddressNewAbstract ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Int8]
    -- ^ /@path@/: the abstract name
    -> m UnixSocketAddress
    -- ^ __Returns:__ a new t'GI.Gio.Objects.UnixSocketAddress.UnixSocketAddress'
unixSocketAddressNewAbstract :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[Int8] -> m UnixSocketAddress
unixSocketAddressNewAbstract [Int8]
path = IO UnixSocketAddress -> m UnixSocketAddress
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UnixSocketAddress -> m UnixSocketAddress)
-> IO UnixSocketAddress -> m UnixSocketAddress
forall a b. (a -> b) -> a -> b
$ do
    let pathLen :: Int32
pathLen = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [Int8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Int8]
path
    Ptr Int8
path' <- [Int8] -> IO (Ptr Int8)
forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray [Int8]
path
    Ptr UnixSocketAddress
result <- Ptr Int8 -> Int32 -> IO (Ptr UnixSocketAddress)
g_unix_socket_address_new_abstract Ptr Int8
path' Int32
pathLen
    Text -> Ptr UnixSocketAddress -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"unixSocketAddressNewAbstract" Ptr UnixSocketAddress
result
    UnixSocketAddress
result' <- ((ManagedPtr UnixSocketAddress -> UnixSocketAddress)
-> Ptr UnixSocketAddress -> IO UnixSocketAddress
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr UnixSocketAddress -> UnixSocketAddress
UnixSocketAddress) Ptr UnixSocketAddress
result
    Ptr Int8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int8
path'
    UnixSocketAddress -> IO UnixSocketAddress
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return UnixSocketAddress
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method UnixSocketAddress::new_with_type
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "path"
--           , argType = TCArray False (-1) 1 (TBasicType TInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path_len"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of @path, or -1"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "UnixSocketAddressType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GUnixSocketAddressType"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "path_len"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the length of @path, or -1"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "UnixSocketAddress" })
-- throws : False
-- Skip return : False

foreign import ccall "g_unix_socket_address_new_with_type" g_unix_socket_address_new_with_type :: 
    Ptr Int8 ->                             -- path : TCArray False (-1) 1 (TBasicType TInt8)
    Int32 ->                                -- path_len : TBasicType TInt
    CUInt ->                                -- type : TInterface (Name {namespace = "Gio", name = "UnixSocketAddressType"})
    IO (Ptr UnixSocketAddress)

-- | Creates a new t'GI.Gio.Objects.UnixSocketAddress.UnixSocketAddress' of type /@type@/ with name /@path@/.
-- 
-- If /@type@/ is 'GI.Gio.Enums.UnixSocketAddressTypePath', this is equivalent to
-- calling 'GI.Gio.Objects.UnixSocketAddress.unixSocketAddressNew'.
-- 
-- If /@type@/ is 'GI.Gio.Enums.UnixSocketAddressTypeAnonymous', /@path@/ and /@pathLen@/ will be
-- ignored.
-- 
-- If /@pathType@/ is 'GI.Gio.Enums.UnixSocketAddressTypeAbstract', then /@pathLen@/
-- bytes of /@path@/ will be copied to the socket\'s path, and only those
-- bytes will be considered part of the name. (If /@pathLen@/ is -1,
-- then /@path@/ is assumed to be NUL-terminated.) For example, if /@path@/
-- was \"test\", then calling 'GI.Gio.Objects.SocketAddress.socketAddressGetNativeSize' on the
-- returned socket would return 7 (2 bytes of overhead, 1 byte for the
-- abstract-socket indicator byte, and 4 bytes for the name \"test\").
-- 
-- If /@pathType@/ is 'GI.Gio.Enums.UnixSocketAddressTypeAbstractPadded', then
-- /@pathLen@/ bytes of /@path@/ will be copied to the socket\'s path, the
-- rest of the path will be padded with 0 bytes, and the entire
-- zero-padded buffer will be considered the name. (As above, if
-- /@pathLen@/ is -1, then /@path@/ is assumed to be NUL-terminated.) In
-- this case, 'GI.Gio.Objects.SocketAddress.socketAddressGetNativeSize' will always return
-- the full size of a @struct sockaddr_un@, although
-- 'GI.Gio.Objects.UnixSocketAddress.unixSocketAddressGetPathLen' will still return just the
-- length of /@path@/.
-- 
-- 'GI.Gio.Enums.UnixSocketAddressTypeAbstract' is preferred over
-- 'GI.Gio.Enums.UnixSocketAddressTypeAbstractPadded' for new programs. Of course,
-- when connecting to a server created by another process, you must
-- use the appropriate type corresponding to how that process created
-- its listening socket.
-- 
-- /Since: 2.26/
unixSocketAddressNewWithType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Int8]
    -- ^ /@path@/: the name
    -> Gio.Enums.UnixSocketAddressType
    -- ^ /@type@/: a t'GI.Gio.Enums.UnixSocketAddressType'
    -> m UnixSocketAddress
    -- ^ __Returns:__ a new t'GI.Gio.Objects.UnixSocketAddress.UnixSocketAddress'
unixSocketAddressNewWithType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[Int8] -> UnixSocketAddressType -> m UnixSocketAddress
unixSocketAddressNewWithType [Int8]
path UnixSocketAddressType
type_ = IO UnixSocketAddress -> m UnixSocketAddress
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UnixSocketAddress -> m UnixSocketAddress)
-> IO UnixSocketAddress -> m UnixSocketAddress
forall a b. (a -> b) -> a -> b
$ do
    let pathLen :: Int32
pathLen = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [Int8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Int8]
path
    Ptr Int8
path' <- [Int8] -> IO (Ptr Int8)
forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray [Int8]
path
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (UnixSocketAddressType -> Int) -> UnixSocketAddressType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnixSocketAddressType -> Int
forall a. Enum a => a -> Int
fromEnum) UnixSocketAddressType
type_
    Ptr UnixSocketAddress
result <- Ptr Int8 -> Int32 -> CUInt -> IO (Ptr UnixSocketAddress)
g_unix_socket_address_new_with_type Ptr Int8
path' Int32
pathLen CUInt
type_'
    Text -> Ptr UnixSocketAddress -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"unixSocketAddressNewWithType" Ptr UnixSocketAddress
result
    UnixSocketAddress
result' <- ((ManagedPtr UnixSocketAddress -> UnixSocketAddress)
-> Ptr UnixSocketAddress -> IO UnixSocketAddress
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr UnixSocketAddress -> UnixSocketAddress
UnixSocketAddress) Ptr UnixSocketAddress
result
    Ptr Int8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int8
path'
    UnixSocketAddress -> IO UnixSocketAddress
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return UnixSocketAddress
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "g_unix_socket_address_get_address_type" g_unix_socket_address_get_address_type :: 
    Ptr UnixSocketAddress ->                -- address : TInterface (Name {namespace = "Gio", name = "UnixSocketAddress"})
    IO CUInt

-- | Gets /@address@/\'s type.
-- 
-- /Since: 2.26/
unixSocketAddressGetAddressType ::
    (B.CallStack.HasCallStack, MonadIO m, IsUnixSocketAddress a) =>
    a
    -- ^ /@address@/: a t'GI.Gio.Objects.InetSocketAddress.InetSocketAddress'
    -> m Gio.Enums.UnixSocketAddressType
    -- ^ __Returns:__ a t'GI.Gio.Enums.UnixSocketAddressType'
unixSocketAddressGetAddressType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsUnixSocketAddress a) =>
a -> m UnixSocketAddressType
unixSocketAddressGetAddressType a
address = IO UnixSocketAddressType -> m UnixSocketAddressType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UnixSocketAddressType -> m UnixSocketAddressType)
-> IO UnixSocketAddressType -> m UnixSocketAddressType
forall a b. (a -> b) -> a -> b
$ do
    Ptr UnixSocketAddress
address' <- a -> IO (Ptr UnixSocketAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
    CUInt
result <- Ptr UnixSocketAddress -> IO CUInt
g_unix_socket_address_get_address_type Ptr UnixSocketAddress
address'
    let result' :: UnixSocketAddressType
result' = (Int -> UnixSocketAddressType
forall a. Enum a => Int -> a
toEnum (Int -> UnixSocketAddressType)
-> (CUInt -> Int) -> CUInt -> UnixSocketAddressType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
address
    UnixSocketAddressType -> IO UnixSocketAddressType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return UnixSocketAddressType
result'

#if defined(ENABLE_OVERLOADING)
data UnixSocketAddressGetAddressTypeMethodInfo
instance (signature ~ (m Gio.Enums.UnixSocketAddressType), MonadIO m, IsUnixSocketAddress a) => O.OverloadedMethod UnixSocketAddressGetAddressTypeMethodInfo a signature where
    overloadedMethod = unixSocketAddressGetAddressType

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


#endif

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

foreign import ccall "g_unix_socket_address_get_is_abstract" g_unix_socket_address_get_is_abstract :: 
    Ptr UnixSocketAddress ->                -- address : TInterface (Name {namespace = "Gio", name = "UnixSocketAddress"})
    IO CInt

{-# DEPRECATED unixSocketAddressGetIsAbstract ["Use 'GI.Gio.Objects.UnixSocketAddress.unixSocketAddressGetAddressType'"] #-}
-- | Tests if /@address@/ is abstract.
-- 
-- /Since: 2.22/
unixSocketAddressGetIsAbstract ::
    (B.CallStack.HasCallStack, MonadIO m, IsUnixSocketAddress a) =>
    a
    -- ^ /@address@/: a t'GI.Gio.Objects.InetSocketAddress.InetSocketAddress'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the address is abstract, 'P.False' otherwise
unixSocketAddressGetIsAbstract :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsUnixSocketAddress a) =>
a -> m Bool
unixSocketAddressGetIsAbstract a
address = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr UnixSocketAddress
address' <- a -> IO (Ptr UnixSocketAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
    CInt
result <- Ptr UnixSocketAddress -> IO CInt
g_unix_socket_address_get_is_abstract Ptr UnixSocketAddress
address'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
address
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data UnixSocketAddressGetIsAbstractMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsUnixSocketAddress a) => O.OverloadedMethod UnixSocketAddressGetIsAbstractMethodInfo a signature where
    overloadedMethod = unixSocketAddressGetIsAbstract

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


#endif

-- method UnixSocketAddress::get_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "address"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixSocketAddress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GInetSocketAddress"
--                 , 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_unix_socket_address_get_path" g_unix_socket_address_get_path :: 
    Ptr UnixSocketAddress ->                -- address : TInterface (Name {namespace = "Gio", name = "UnixSocketAddress"})
    IO CString

-- | Gets /@address@/\'s path, or for abstract sockets the \"name\".
-- 
-- Guaranteed to be zero-terminated, but an abstract socket
-- may contain embedded zeros, and thus you should use
-- 'GI.Gio.Objects.UnixSocketAddress.unixSocketAddressGetPathLen' to get the true length
-- of this string.
-- 
-- /Since: 2.22/
unixSocketAddressGetPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsUnixSocketAddress a) =>
    a
    -- ^ /@address@/: a t'GI.Gio.Objects.InetSocketAddress.InetSocketAddress'
    -> m T.Text
    -- ^ __Returns:__ the path for /@address@/
unixSocketAddressGetPath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsUnixSocketAddress a) =>
a -> m Text
unixSocketAddressGetPath a
address = 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 UnixSocketAddress
address' <- a -> IO (Ptr UnixSocketAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
    CString
result <- Ptr UnixSocketAddress -> IO CString
g_unix_socket_address_get_path Ptr UnixSocketAddress
address'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"unixSocketAddressGetPath" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
address
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data UnixSocketAddressGetPathMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsUnixSocketAddress a) => O.OverloadedMethod UnixSocketAddressGetPathMethodInfo a signature where
    overloadedMethod = unixSocketAddressGetPath

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


#endif

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

foreign import ccall "g_unix_socket_address_get_path_len" g_unix_socket_address_get_path_len :: 
    Ptr UnixSocketAddress ->                -- address : TInterface (Name {namespace = "Gio", name = "UnixSocketAddress"})
    IO Word64

-- | Gets the length of /@address@/\'s path.
-- 
-- For details, see 'GI.Gio.Objects.UnixSocketAddress.unixSocketAddressGetPath'.
-- 
-- /Since: 2.22/
unixSocketAddressGetPathLen ::
    (B.CallStack.HasCallStack, MonadIO m, IsUnixSocketAddress a) =>
    a
    -- ^ /@address@/: a t'GI.Gio.Objects.InetSocketAddress.InetSocketAddress'
    -> m Word64
    -- ^ __Returns:__ the length of the path
unixSocketAddressGetPathLen :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsUnixSocketAddress a) =>
a -> m Word64
unixSocketAddressGetPathLen a
address = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr UnixSocketAddress
address' <- a -> IO (Ptr UnixSocketAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
    Word64
result <- Ptr UnixSocketAddress -> IO Word64
g_unix_socket_address_get_path_len Ptr UnixSocketAddress
address'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
address
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data UnixSocketAddressGetPathLenMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsUnixSocketAddress a) => O.OverloadedMethod UnixSocketAddressGetPathLenMethodInfo a signature where
    overloadedMethod = unixSocketAddressGetPathLen

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


#endif

-- method UnixSocketAddress::abstract_names_supported
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_unix_socket_address_abstract_names_supported" g_unix_socket_address_abstract_names_supported :: 
    IO CInt

-- | Checks if abstract UNIX domain socket names are supported.
-- 
-- /Since: 2.22/
unixSocketAddressAbstractNamesSupported ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Bool
    -- ^ __Returns:__ 'P.True' if supported, 'P.False' otherwise
unixSocketAddressAbstractNamesSupported :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Bool
unixSocketAddressAbstractNamesSupported  = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    CInt
result <- IO CInt
g_unix_socket_address_abstract_names_supported
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif