{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Represents a unique ID of any object.

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

module GI.Ggit.Structs.OId
    ( 

-- * Exported types
    OId(..)                                 ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [compare]("GI.Ggit.Structs.OId#g:method:compare"), [copy]("GI.Ggit.Structs.OId#g:method:copy"), [equal]("GI.Ggit.Structs.OId#g:method:equal"), [free]("GI.Ggit.Structs.OId#g:method:free"), [hasPrefix]("GI.Ggit.Structs.OId#g:method:hasPrefix"), [hash]("GI.Ggit.Structs.OId#g:method:hash"), [isZero]("GI.Ggit.Structs.OId#g:method:isZero"), [toString]("GI.Ggit.Structs.OId#g:method:toString").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveOIdMethod                        ,
#endif

-- ** compare #method:compare#

#if defined(ENABLE_OVERLOADING)
    OIdCompareMethodInfo                    ,
#endif
    oIdCompare                              ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    OIdCopyMethodInfo                       ,
#endif
    oIdCopy                                 ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    OIdEqualMethodInfo                      ,
#endif
    oIdEqual                                ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    OIdFreeMethodInfo                       ,
#endif
    oIdFree                                 ,


-- ** hasPrefix #method:hasPrefix#

#if defined(ENABLE_OVERLOADING)
    OIdHasPrefixMethodInfo                  ,
#endif
    oIdHasPrefix                            ,


-- ** hash #method:hash#

#if defined(ENABLE_OVERLOADING)
    OIdHashMethodInfo                       ,
#endif
    oIdHash                                 ,


-- ** isZero #method:isZero#

#if defined(ENABLE_OVERLOADING)
    OIdIsZeroMethodInfo                     ,
#endif
    oIdIsZero                               ,


-- ** newFromRaw #method:newFromRaw#

    oIdNewFromRaw                           ,


-- ** newFromString #method:newFromString#

    oIdNewFromString                        ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    OIdToStringMethodInfo                   ,
#endif
    oIdToString                             ,




    ) where

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

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


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

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

foreign import ccall "ggit_oid_get_type" c_ggit_oid_get_type :: 
    IO GType

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

instance B.Types.TypedObject OId where
    glibType :: IO GType
glibType = IO GType
c_ggit_oid_get_type

instance B.Types.GBoxed OId

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


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

-- method OId::new_from_raw
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "raw"
--           , argType = TCArray True (-1) (-1) (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the raw input bytes to be copied."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Ggit" , name = "OId" })
-- throws : False
-- Skip return : False

foreign import ccall "ggit_oid_new_from_raw" ggit_oid_new_from_raw :: 
    Ptr Word8 ->                            -- raw : TCArray True (-1) (-1) (TBasicType TUInt8)
    IO (Ptr OId)

-- | Creates a new t'GI.Ggit.Structs.OId.OId' from a raw oid.
oIdNewFromRaw ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@raw@/: the raw input bytes to be copied.
    -> m (Maybe OId)
    -- ^ __Returns:__ a newly allocated t'GI.Ggit.Structs.OId.OId' or 'P.Nothing' on error.
oIdNewFromRaw :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> m (Maybe OId)
oIdNewFromRaw ByteString
raw = IO (Maybe OId) -> m (Maybe OId)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe OId) -> m (Maybe OId))
-> IO (Maybe OId) -> m (Maybe OId)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Word8
raw' <- ByteString -> IO (Ptr Word8)
packZeroTerminatedByteString ByteString
raw
    Ptr OId
result <- Ptr Word8 -> IO (Ptr OId)
ggit_oid_new_from_raw Ptr Word8
raw'
    Maybe OId
maybeResult <- Ptr OId -> (Ptr OId -> IO OId) -> IO (Maybe OId)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr OId
result ((Ptr OId -> IO OId) -> IO (Maybe OId))
-> (Ptr OId -> IO OId) -> IO (Maybe OId)
forall a b. (a -> b) -> a -> b
$ \Ptr OId
result' -> do
        OId
result'' <- ((ManagedPtr OId -> OId) -> Ptr OId -> IO OId
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr OId -> OId
OId) Ptr OId
result'
        OId -> IO OId
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return OId
result''
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
raw'
    Maybe OId -> IO (Maybe OId)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe OId
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method OId::new_from_string
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "str"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "input hex string; must be pointing at the start of\n      the hex sequence and have at least the number of bytes\n      needed for an oid encoded in hex (40 bytes)."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Ggit" , name = "OId" })
-- throws : False
-- Skip return : False

foreign import ccall "ggit_oid_new_from_string" ggit_oid_new_from_string :: 
    CString ->                              -- str : TBasicType TUTF8
    IO (Ptr OId)

-- | Parses a hex formatted object id into a t'GI.Ggit.Structs.OId.OId'.
oIdNewFromString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@str@/: input hex string; must be pointing at the start of
    --       the hex sequence and have at least the number of bytes
    --       needed for an oid encoded in hex (40 bytes).
    -> m (Maybe OId)
    -- ^ __Returns:__ a newly allocated t'GI.Ggit.Structs.OId.OId' or 'P.Nothing' on error.
oIdNewFromString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m (Maybe OId)
oIdNewFromString Text
str = IO (Maybe OId) -> m (Maybe OId)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe OId) -> m (Maybe OId))
-> IO (Maybe OId) -> m (Maybe OId)
forall a b. (a -> b) -> a -> b
$ do
    CString
str' <- Text -> IO CString
textToCString Text
str
    Ptr OId
result <- CString -> IO (Ptr OId)
ggit_oid_new_from_string CString
str'
    Maybe OId
maybeResult <- Ptr OId -> (Ptr OId -> IO OId) -> IO (Maybe OId)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr OId
result ((Ptr OId -> IO OId) -> IO (Maybe OId))
-> (Ptr OId -> IO OId) -> IO (Maybe OId)
forall a b. (a -> b) -> a -> b
$ \Ptr OId
result' -> do
        OId
result'' <- ((ManagedPtr OId -> OId) -> Ptr OId -> IO OId
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr OId -> OId
OId) Ptr OId
result'
        OId -> IO OId
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return OId
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
str'
    Maybe OId -> IO (Maybe OId)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe OId
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method OId::compare
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "a"
--           , argType = TInterface Name { namespace = "Ggit" , name = "OId" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "first #GgitOId." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType = TInterface Name { namespace = "Ggit" , name = "OId" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "second #GgitOId." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "ggit_oid_compare" ggit_oid_compare :: 
    Ptr OId ->                              -- a : TInterface (Name {namespace = "Ggit", name = "OId"})
    Ptr OId ->                              -- b : TInterface (Name {namespace = "Ggit", name = "OId"})
    IO Int32

-- | Compare two t'GI.Ggit.Structs.OId.OId' structures.
oIdCompare ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    OId
    -- ^ /@a@/: first t'GI.Ggit.Structs.OId.OId'.
    -> OId
    -- ^ /@b@/: second t'GI.Ggit.Structs.OId.OId'.
    -> m Int32
    -- ^ __Returns:__ \<0, 0, >0 if a \< b, a == b, a > b.
oIdCompare :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
OId -> OId -> m Int32
oIdCompare OId
a OId
b = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr OId
a' <- OId -> IO (Ptr OId)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr OId
a
    Ptr OId
b' <- OId -> IO (Ptr OId)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr OId
b
    Int32
result <- Ptr OId -> Ptr OId -> IO Int32
ggit_oid_compare Ptr OId
a' Ptr OId
b'
    OId -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr OId
a
    OId -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr OId
b
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data OIdCompareMethodInfo
instance (signature ~ (OId -> m Int32), MonadIO m) => O.OverloadedMethod OIdCompareMethodInfo OId signature where
    overloadedMethod = oIdCompare

instance O.OverloadedMethodInfo OIdCompareMethodInfo OId where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.OId.oIdCompare",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.12/docs/GI-Ggit-Structs-OId.html#v:oIdCompare"
        })


#endif

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

foreign import ccall "ggit_oid_copy" ggit_oid_copy :: 
    Ptr OId ->                              -- oid : TInterface (Name {namespace = "Ggit", name = "OId"})
    IO (Ptr OId)

-- | Copies /@oid@/ into a newly allocated t'GI.Ggit.Structs.OId.OId'.
oIdCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    OId
    -- ^ /@oid@/: a t'GI.Ggit.Structs.OId.OId'.
    -> m (Maybe OId)
    -- ^ __Returns:__ a newly allocated t'GI.Ggit.Structs.OId.OId'.
oIdCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
OId -> m (Maybe OId)
oIdCopy OId
oid = IO (Maybe OId) -> m (Maybe OId)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe OId) -> m (Maybe OId))
-> IO (Maybe OId) -> m (Maybe OId)
forall a b. (a -> b) -> a -> b
$ do
    Ptr OId
oid' <- OId -> IO (Ptr OId)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr OId
oid
    Ptr OId
result <- Ptr OId -> IO (Ptr OId)
ggit_oid_copy Ptr OId
oid'
    Maybe OId
maybeResult <- Ptr OId -> (Ptr OId -> IO OId) -> IO (Maybe OId)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr OId
result ((Ptr OId -> IO OId) -> IO (Maybe OId))
-> (Ptr OId -> IO OId) -> IO (Maybe OId)
forall a b. (a -> b) -> a -> b
$ \Ptr OId
result' -> do
        OId
result'' <- ((ManagedPtr OId -> OId) -> Ptr OId -> IO OId
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr OId -> OId
OId) Ptr OId
result'
        OId -> IO OId
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return OId
result''
    OId -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr OId
oid
    Maybe OId -> IO (Maybe OId)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe OId
maybeResult

#if defined(ENABLE_OVERLOADING)
data OIdCopyMethodInfo
instance (signature ~ (m (Maybe OId)), MonadIO m) => O.OverloadedMethod OIdCopyMethodInfo OId signature where
    overloadedMethod = oIdCopy

instance O.OverloadedMethodInfo OIdCopyMethodInfo OId where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.OId.oIdCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.12/docs/GI-Ggit-Structs-OId.html#v:oIdCopy"
        })


#endif

-- method OId::equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "a"
--           , argType = TInterface Name { namespace = "Ggit" , name = "OId" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitOId." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType = TInterface Name { namespace = "Ggit" , name = "OId" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitOId." , 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 "ggit_oid_equal" ggit_oid_equal :: 
    Ptr OId ->                              -- a : TInterface (Name {namespace = "Ggit", name = "OId"})
    Ptr OId ->                              -- b : TInterface (Name {namespace = "Ggit", name = "OId"})
    IO CInt

-- | Compares two t'GI.Ggit.Structs.OId.OId' for equality.
oIdEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    OId
    -- ^ /@a@/: a t'GI.Ggit.Structs.OId.OId'.
    -> OId
    -- ^ /@b@/: a t'GI.Ggit.Structs.OId.OId'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@a@/ and /@b@/ are equal, 'P.False' otherwise
oIdEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
OId -> OId -> m Bool
oIdEqual OId
a OId
b = 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 OId
a' <- OId -> IO (Ptr OId)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr OId
a
    Ptr OId
b' <- OId -> IO (Ptr OId)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr OId
b
    CInt
result <- Ptr OId -> Ptr OId -> IO CInt
ggit_oid_equal Ptr OId
a' Ptr OId
b'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    OId -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr OId
a
    OId -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr OId
b
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data OIdEqualMethodInfo
instance (signature ~ (OId -> m Bool), MonadIO m) => O.OverloadedMethod OIdEqualMethodInfo OId signature where
    overloadedMethod = oIdEqual

instance O.OverloadedMethodInfo OIdEqualMethodInfo OId where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.OId.oIdEqual",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.12/docs/GI-Ggit-Structs-OId.html#v:oIdEqual"
        })


#endif

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

foreign import ccall "ggit_oid_free" ggit_oid_free :: 
    Ptr OId ->                              -- oid : TInterface (Name {namespace = "Ggit", name = "OId"})
    IO ()

-- | Frees /@oid@/.
oIdFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    OId
    -- ^ /@oid@/: a t'GI.Ggit.Structs.OId.OId'.
    -> m ()
oIdFree :: forall (m :: * -> *). (HasCallStack, MonadIO m) => OId -> m ()
oIdFree OId
oid = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr OId
oid' <- OId -> IO (Ptr OId)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr OId
oid
    Ptr OId -> IO ()
ggit_oid_free Ptr OId
oid'
    OId -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr OId
oid
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data OIdFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod OIdFreeMethodInfo OId signature where
    overloadedMethod = oIdFree

instance O.OverloadedMethodInfo OIdFreeMethodInfo OId where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.OId.oIdFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.12/docs/GI-Ggit-Structs-OId.html#v:oIdFree"
        })


#endif

-- method OId::has_prefix
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "oid"
--           , argType = TInterface Name { namespace = "Ggit" , name = "OId" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitOId." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prefix"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a prefix." , 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 "ggit_oid_has_prefix" ggit_oid_has_prefix :: 
    Ptr OId ->                              -- oid : TInterface (Name {namespace = "Ggit", name = "OId"})
    CString ->                              -- prefix : TBasicType TUTF8
    IO CInt

-- | Check whether the object id has a given prefix. Note that the prefix is
-- specified in hexadecimal ASCII.
oIdHasPrefix ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    OId
    -- ^ /@oid@/: a t'GI.Ggit.Structs.OId.OId'.
    -> T.Text
    -- ^ /@prefix@/: a prefix.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the id has the given prefix, 'P.False' otherwise.
oIdHasPrefix :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
OId -> Text -> m Bool
oIdHasPrefix OId
oid Text
prefix = 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 OId
oid' <- OId -> IO (Ptr OId)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr OId
oid
    CString
prefix' <- Text -> IO CString
textToCString Text
prefix
    CInt
result <- Ptr OId -> CString -> IO CInt
ggit_oid_has_prefix Ptr OId
oid' CString
prefix'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    OId -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr OId
oid
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
prefix'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data OIdHasPrefixMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.OverloadedMethod OIdHasPrefixMethodInfo OId signature where
    overloadedMethod = oIdHasPrefix

instance O.OverloadedMethodInfo OIdHasPrefixMethodInfo OId where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.OId.oIdHasPrefix",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.12/docs/GI-Ggit-Structs-OId.html#v:oIdHasPrefix"
        })


#endif

-- method OId::hash
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "oid"
--           , argType = TInterface Name { namespace = "Ggit" , name = "OId" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitOId." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "ggit_oid_hash" ggit_oid_hash :: 
    Ptr OId ->                              -- oid : TInterface (Name {namespace = "Ggit", name = "OId"})
    IO Word32

-- | Computes a hash value for a git object identifier.
oIdHash ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    OId
    -- ^ /@oid@/: a t'GI.Ggit.Structs.OId.OId'.
    -> m Word32
    -- ^ __Returns:__ the hash value
oIdHash :: forall (m :: * -> *). (HasCallStack, MonadIO m) => OId -> m Word32
oIdHash OId
oid = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr OId
oid' <- OId -> IO (Ptr OId)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr OId
oid
    Word32
result <- Ptr OId -> IO Word32
ggit_oid_hash Ptr OId
oid'
    OId -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr OId
oid
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data OIdHashMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod OIdHashMethodInfo OId signature where
    overloadedMethod = oIdHash

instance O.OverloadedMethodInfo OIdHashMethodInfo OId where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.OId.oIdHash",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.12/docs/GI-Ggit-Structs-OId.html#v:oIdHash"
        })


#endif

-- method OId::is_zero
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "oid"
--           , argType = TInterface Name { namespace = "Ggit" , name = "OId" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitOId." , 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 "ggit_oid_is_zero" ggit_oid_is_zero :: 
    Ptr OId ->                              -- oid : TInterface (Name {namespace = "Ggit", name = "OId"})
    IO CInt

-- | Get whether the oid contains only zeros.
oIdIsZero ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    OId
    -- ^ /@oid@/: a t'GI.Ggit.Structs.OId.OId'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the oid contains only zeros, 'P.False' otherwise.
oIdIsZero :: forall (m :: * -> *). (HasCallStack, MonadIO m) => OId -> m Bool
oIdIsZero OId
oid = 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 OId
oid' <- OId -> IO (Ptr OId)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr OId
oid
    CInt
result <- Ptr OId -> IO CInt
ggit_oid_is_zero Ptr OId
oid'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    OId -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr OId
oid
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data OIdIsZeroMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod OIdIsZeroMethodInfo OId signature where
    overloadedMethod = oIdIsZero

instance O.OverloadedMethodInfo OIdIsZeroMethodInfo OId where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.OId.oIdIsZero",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.12/docs/GI-Ggit-Structs-OId.html#v:oIdIsZero"
        })


#endif

-- method OId::to_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "oid"
--           , argType = TInterface Name { namespace = "Ggit" , name = "OId" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitOId." , 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 "ggit_oid_to_string" ggit_oid_to_string :: 
    Ptr OId ->                              -- oid : TInterface (Name {namespace = "Ggit", name = "OId"})
    IO CString

-- | Converts /@oid@/ into a readable string.
oIdToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    OId
    -- ^ /@oid@/: a t'GI.Ggit.Structs.OId.OId'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a newly allocated string representing /@oid@/ or 'P.Nothing'.
oIdToString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
OId -> m (Maybe Text)
oIdToString OId
oid = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr OId
oid' <- OId -> IO (Ptr OId)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr OId
oid
    CString
result <- Ptr OId -> IO CString
ggit_oid_to_string Ptr OId
oid'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    OId -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr OId
oid
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data OIdToStringMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod OIdToStringMethodInfo OId signature where
    overloadedMethod = oIdToString

instance O.OverloadedMethodInfo OIdToStringMethodInfo OId where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.OId.oIdToString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.12/docs/GI-Ggit-Structs-OId.html#v:oIdToString"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveOIdMethod (t :: Symbol) (o :: *) :: * where
    ResolveOIdMethod "compare" o = OIdCompareMethodInfo
    ResolveOIdMethod "copy" o = OIdCopyMethodInfo
    ResolveOIdMethod "equal" o = OIdEqualMethodInfo
    ResolveOIdMethod "free" o = OIdFreeMethodInfo
    ResolveOIdMethod "hasPrefix" o = OIdHasPrefixMethodInfo
    ResolveOIdMethod "hash" o = OIdHashMethodInfo
    ResolveOIdMethod "isZero" o = OIdIsZeroMethodInfo
    ResolveOIdMethod "toString" o = OIdToStringMethodInfo
    ResolveOIdMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif