{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Vte.Structs.Uuid
    ( 

-- * Exported types
    Uuid(..)                                ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [dup]("GI.Vte.Structs.Uuid#g:method:dup"), [equal]("GI.Vte.Structs.Uuid#g:method:equal"), [free]("GI.Vte.Structs.Uuid#g:method:free"), [freeToString]("GI.Vte.Structs.Uuid#g:method:freeToString"), [newV5]("GI.Vte.Structs.Uuid#g:method:newV5"), [toString]("GI.Vte.Structs.Uuid#g:method:toString").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveUuidMethod                       ,
#endif

-- ** dup #method:dup#

#if defined(ENABLE_OVERLOADING)
    UuidDupMethodInfo                       ,
#endif
    uuidDup                                 ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    UuidEqualMethodInfo                     ,
#endif
    uuidEqual                               ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    UuidFreeMethodInfo                      ,
#endif
    uuidFree                                ,


-- ** freeToString #method:freeToString#

#if defined(ENABLE_OVERLOADING)
    UuidFreeToStringMethodInfo              ,
#endif
    uuidFreeToString                        ,


-- ** newFromString #method:newFromString#

    uuidNewFromString                       ,


-- ** newV4 #method:newV4#

    uuidNewV4                               ,


-- ** newV5 #method:newV5#

#if defined(ENABLE_OVERLOADING)
    UuidNewV5MethodInfo                     ,
#endif
    uuidNewV5                               ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    UuidToStringMethodInfo                  ,
#endif
    uuidToString                            ,


-- ** validateString #method:validateString#

    uuidValidateString                      ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import {-# SOURCE #-} qualified GI.Vte.Flags as Vte.Flags

#else
import {-# SOURCE #-} qualified GI.Vte.Flags as Vte.Flags

#endif

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

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

foreign import ccall "vte_uuid_get_type" c_vte_uuid_get_type :: 
    IO GType

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

instance B.Types.TypedObject Uuid where
    glibType :: IO GType
glibType = IO GType
c_vte_uuid_get_type

instance B.Types.GBoxed Uuid

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


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

-- method Uuid::new_from_string
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "str"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "len"
--           , argType = TBasicType TSSize
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fmt"
--           , argType =
--               TInterface Name { namespace = "Vte" , name = "UuidFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vte" , name = "Uuid" })
-- throws : False
-- Skip return : False

foreign import ccall "vte_uuid_new_from_string" vte_uuid_new_from_string :: 
    CString ->                              -- str : TBasicType TUTF8
    DI.Int64 ->                             -- len : TBasicType TSSize
    CUInt ->                                -- fmt : TInterface (Name {namespace = "Vte", name = "UuidFormat"})
    IO (Ptr Uuid)

-- | /No description available in the introspection data./
uuidNewFromString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -> DI.Int64
    -> [Vte.Flags.UuidFormat]
    -> m Uuid
uuidNewFromString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Int64 -> [UuidFormat] -> m Uuid
uuidNewFromString Text
str Int64
len [UuidFormat]
fmt = IO Uuid -> m Uuid
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Uuid -> m Uuid) -> IO Uuid -> m Uuid
forall a b. (a -> b) -> a -> b
$ do
    str' <- Text -> IO CString
textToCString Text
str
    let fmt' = [UuidFormat] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [UuidFormat]
fmt
    result <- vte_uuid_new_from_string str' len fmt'
    checkUnexpectedReturnNULL "uuidNewFromString" result
    result' <- (wrapBoxed Uuid) result
    freeMem str'
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Uuid::new_v4
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vte" , name = "Uuid" })
-- throws : False
-- Skip return : False

foreign import ccall "vte_uuid_new_v4" vte_uuid_new_v4 :: 
    IO (Ptr Uuid)

-- | /No description available in the introspection data./
uuidNewV4 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Uuid
uuidNewV4 :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Uuid
uuidNewV4  = IO Uuid -> m Uuid
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Uuid -> m Uuid) -> IO Uuid -> m Uuid
forall a b. (a -> b) -> a -> b
$ do
    result <- IO (Ptr Uuid)
vte_uuid_new_v4
    checkUnexpectedReturnNULL "uuidNewV4" result
    result' <- (wrapBoxed Uuid) result
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Uuid::dup
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uuid"
--           , argType = TInterface Name { namespace = "Vte" , name = "Uuid" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vte" , name = "Uuid" })
-- throws : False
-- Skip return : False

foreign import ccall "vte_uuid_dup" vte_uuid_dup :: 
    Ptr Uuid ->                             -- uuid : TInterface (Name {namespace = "Vte", name = "Uuid"})
    IO (Ptr Uuid)

-- | /No description available in the introspection data./
uuidDup ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uuid
    -> m Uuid
uuidDup :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Uuid -> m Uuid
uuidDup Uuid
uuid = IO Uuid -> m Uuid
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Uuid -> m Uuid) -> IO Uuid -> m Uuid
forall a b. (a -> b) -> a -> b
$ do
    uuid' <- Uuid -> IO (Ptr Uuid)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Uuid
uuid
    result <- vte_uuid_dup uuid'
    checkUnexpectedReturnNULL "uuidDup" result
    result' <- (wrapBoxed Uuid) result
    touchManagedPtr uuid
    return result'

#if defined(ENABLE_OVERLOADING)
data UuidDupMethodInfo
instance (signature ~ (m Uuid), MonadIO m) => O.OverloadedMethod UuidDupMethodInfo Uuid signature where
    overloadedMethod = uuidDup

instance O.OverloadedMethodInfo UuidDupMethodInfo Uuid where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vte.Structs.Uuid.uuidDup",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vte-2.91.35/docs/GI-Vte-Structs-Uuid.html#v:uuidDup"
        })


#endif

-- method Uuid::equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uuid"
--           , argType = TInterface Name { namespace = "Vte" , name = "Uuid" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "other"
--           , argType = TInterface Name { namespace = "Vte" , name = "Uuid" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "vte_uuid_equal" vte_uuid_equal :: 
    Ptr Uuid ->                             -- uuid : TInterface (Name {namespace = "Vte", name = "Uuid"})
    Ptr Uuid ->                             -- other : TInterface (Name {namespace = "Vte", name = "Uuid"})
    IO CInt

-- | /No description available in the introspection data./
uuidEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uuid
    -> Uuid
    -> m Bool
uuidEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Uuid -> Uuid -> m Bool
uuidEqual Uuid
uuid Uuid
other = 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
    uuid' <- Uuid -> IO (Ptr Uuid)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Uuid
uuid
    other' <- unsafeManagedPtrGetPtr other
    result <- vte_uuid_equal uuid' other'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr uuid
    touchManagedPtr other
    return result'

#if defined(ENABLE_OVERLOADING)
data UuidEqualMethodInfo
instance (signature ~ (Uuid -> m Bool), MonadIO m) => O.OverloadedMethod UuidEqualMethodInfo Uuid signature where
    overloadedMethod = uuidEqual

instance O.OverloadedMethodInfo UuidEqualMethodInfo Uuid where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vte.Structs.Uuid.uuidEqual",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vte-2.91.35/docs/GI-Vte-Structs-Uuid.html#v:uuidEqual"
        })


#endif

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

foreign import ccall "vte_uuid_free" vte_uuid_free :: 
    Ptr Uuid ->                             -- uuid : TInterface (Name {namespace = "Vte", name = "Uuid"})
    IO ()

-- | /No description available in the introspection data./
uuidFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uuid
    -> m ()
uuidFree :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Uuid -> m ()
uuidFree Uuid
uuid = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    uuid' <- Uuid -> IO (Ptr Uuid)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Uuid
uuid
    vte_uuid_free uuid'
    touchManagedPtr uuid
    return ()

#if defined(ENABLE_OVERLOADING)
data UuidFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod UuidFreeMethodInfo Uuid signature where
    overloadedMethod = uuidFree

instance O.OverloadedMethodInfo UuidFreeMethodInfo Uuid where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vte.Structs.Uuid.uuidFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vte-2.91.35/docs/GI-Vte-Structs-Uuid.html#v:uuidFree"
        })


#endif

-- method Uuid::free_to_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uuid"
--           , argType = TInterface Name { namespace = "Vte" , name = "Uuid" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fmt"
--           , argType =
--               TInterface Name { namespace = "Vte" , name = "UuidFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "len"
--           , argType = TBasicType TSize
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "vte_uuid_free_to_string" vte_uuid_free_to_string :: 
    Ptr Uuid ->                             -- uuid : TInterface (Name {namespace = "Vte", name = "Uuid"})
    CUInt ->                                -- fmt : TInterface (Name {namespace = "Vte", name = "UuidFormat"})
    FCT.CSize ->                            -- len : TBasicType TSize
    IO CString

-- | /No description available in the introspection data./
uuidFreeToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uuid
    -> [Vte.Flags.UuidFormat]
    -> FCT.CSize
    -> m T.Text
uuidFreeToString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Uuid -> [UuidFormat] -> CSize -> m Text
uuidFreeToString Uuid
uuid [UuidFormat]
fmt CSize
len = 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
    uuid' <- Uuid -> IO (Ptr Uuid)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Uuid
uuid
    let fmt' = [UuidFormat] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [UuidFormat]
fmt
    result <- vte_uuid_free_to_string uuid' fmt' len
    checkUnexpectedReturnNULL "uuidFreeToString" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr uuid
    return result'

#if defined(ENABLE_OVERLOADING)
data UuidFreeToStringMethodInfo
instance (signature ~ ([Vte.Flags.UuidFormat] -> FCT.CSize -> m T.Text), MonadIO m) => O.OverloadedMethod UuidFreeToStringMethodInfo Uuid signature where
    overloadedMethod = uuidFreeToString

instance O.OverloadedMethodInfo UuidFreeToStringMethodInfo Uuid where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vte.Structs.Uuid.uuidFreeToString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vte-2.91.35/docs/GI-Vte-Structs-Uuid.html#v:uuidFreeToString"
        })


#endif

-- method Uuid::new_v5
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "ns"
--           , argType = TInterface Name { namespace = "Vte" , name = "Uuid" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "len"
--           , argType = TBasicType TSSize
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vte" , name = "Uuid" })
-- throws : False
-- Skip return : False

foreign import ccall "vte_uuid_new_v5" vte_uuid_new_v5 :: 
    Ptr Uuid ->                             -- ns : TInterface (Name {namespace = "Vte", name = "Uuid"})
    CString ->                              -- data : TBasicType TUTF8
    DI.Int64 ->                             -- len : TBasicType TSSize
    IO (Ptr Uuid)

-- | /No description available in the introspection data./
uuidNewV5 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uuid
    -> T.Text
    -> DI.Int64
    -> m Uuid
uuidNewV5 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Uuid -> Text -> Int64 -> m Uuid
uuidNewV5 Uuid
ns Text
data_ Int64
len = IO Uuid -> m Uuid
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Uuid -> m Uuid) -> IO Uuid -> m Uuid
forall a b. (a -> b) -> a -> b
$ do
    ns' <- Uuid -> IO (Ptr Uuid)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Uuid
ns
    data_' <- textToCString data_
    result <- vte_uuid_new_v5 ns' data_' len
    checkUnexpectedReturnNULL "uuidNewV5" result
    result' <- (wrapBoxed Uuid) result
    touchManagedPtr ns
    freeMem data_'
    return result'

#if defined(ENABLE_OVERLOADING)
data UuidNewV5MethodInfo
instance (signature ~ (T.Text -> DI.Int64 -> m Uuid), MonadIO m) => O.OverloadedMethod UuidNewV5MethodInfo Uuid signature where
    overloadedMethod = uuidNewV5

instance O.OverloadedMethodInfo UuidNewV5MethodInfo Uuid where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vte.Structs.Uuid.uuidNewV5",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vte-2.91.35/docs/GI-Vte-Structs-Uuid.html#v:uuidNewV5"
        })


#endif

-- method Uuid::to_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uuid"
--           , argType = TInterface Name { namespace = "Vte" , name = "Uuid" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fmt"
--           , argType =
--               TInterface Name { namespace = "Vte" , name = "UuidFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "len"
--           , argType = TBasicType TSize
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "vte_uuid_to_string" vte_uuid_to_string :: 
    Ptr Uuid ->                             -- uuid : TInterface (Name {namespace = "Vte", name = "Uuid"})
    CUInt ->                                -- fmt : TInterface (Name {namespace = "Vte", name = "UuidFormat"})
    FCT.CSize ->                            -- len : TBasicType TSize
    IO CString

-- | /No description available in the introspection data./
uuidToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uuid
    -> [Vte.Flags.UuidFormat]
    -> FCT.CSize
    -> m T.Text
uuidToString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Uuid -> [UuidFormat] -> CSize -> m Text
uuidToString Uuid
uuid [UuidFormat]
fmt CSize
len = 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
    uuid' <- Uuid -> IO (Ptr Uuid)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Uuid
uuid
    let fmt' = [UuidFormat] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [UuidFormat]
fmt
    result <- vte_uuid_to_string uuid' fmt' len
    checkUnexpectedReturnNULL "uuidToString" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr uuid
    return result'

#if defined(ENABLE_OVERLOADING)
data UuidToStringMethodInfo
instance (signature ~ ([Vte.Flags.UuidFormat] -> FCT.CSize -> m T.Text), MonadIO m) => O.OverloadedMethod UuidToStringMethodInfo Uuid signature where
    overloadedMethod = uuidToString

instance O.OverloadedMethodInfo UuidToStringMethodInfo Uuid where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vte.Structs.Uuid.uuidToString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vte-2.91.35/docs/GI-Vte-Structs-Uuid.html#v:uuidToString"
        })


#endif

-- method Uuid::validate_string
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "str"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "len"
--           , argType = TBasicType TSSize
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fmt"
--           , argType =
--               TInterface Name { namespace = "Vte" , name = "UuidFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "vte_uuid_validate_string" vte_uuid_validate_string :: 
    CString ->                              -- str : TBasicType TUTF8
    DI.Int64 ->                             -- len : TBasicType TSSize
    CUInt ->                                -- fmt : TInterface (Name {namespace = "Vte", name = "UuidFormat"})
    IO CInt

-- | /No description available in the introspection data./
uuidValidateString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -> DI.Int64
    -> [Vte.Flags.UuidFormat]
    -> m Bool
uuidValidateString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Int64 -> [UuidFormat] -> m Bool
uuidValidateString Text
str Int64
len [UuidFormat]
fmt = 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
    str' <- Text -> IO CString
textToCString Text
str
    let fmt' = [UuidFormat] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [UuidFormat]
fmt
    result <- vte_uuid_validate_string str' len fmt'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    freeMem str'
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveUuidMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveUuidMethod "dup" o = UuidDupMethodInfo
    ResolveUuidMethod "equal" o = UuidEqualMethodInfo
    ResolveUuidMethod "free" o = UuidFreeMethodInfo
    ResolveUuidMethod "freeToString" o = UuidFreeToStringMethodInfo
    ResolveUuidMethod "newV5" o = UuidNewV5MethodInfo
    ResolveUuidMethod "toString" o = UuidToStringMethodInfo
    ResolveUuidMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif