{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- 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(..)                                 ,
    noOId                                   ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified 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


-- | Memory-managed wrapper type.
newtype OId = OId (ManagedPtr OId)
    deriving (OId -> OId -> Bool
(OId -> OId -> Bool) -> (OId -> OId -> Bool) -> Eq OId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OId -> OId -> Bool
$c/= :: OId -> OId -> Bool
== :: OId -> OId -> Bool
$c== :: OId -> OId -> Bool
Eq)
foreign import ccall "ggit_oid_get_type" c_ggit_oid_get_type :: 
    IO GType

instance BoxedObject OId where
    boxedType :: OId -> IO GType
boxedType _ = IO GType
c_ggit_oid_get_type

-- | Convert 'OId' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue OId where
    toGValue :: OId -> IO GValue
toGValue o :: OId
o = do
        GType
gtype <- IO GType
c_ggit_oid_get_type
        OId -> (Ptr OId -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr OId
o (GType -> (GValue -> Ptr OId -> IO ()) -> Ptr OId -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr OId -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO OId
fromGValue gv :: GValue
gv = do
        Ptr OId
ptr <- GValue -> IO (Ptr OId)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr OId)
        (ManagedPtr OId -> OId) -> Ptr OId -> IO OId
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr OId -> OId
OId Ptr OId
ptr
        
    

-- | A convenience alias for `Nothing` :: `Maybe` `OId`.
noOId :: Maybe OId
noOId :: Maybe OId
noOId = Maybe OId
forall a. Maybe a
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 :: ByteString -> m (Maybe OId)
oIdNewFromRaw raw :: ByteString
raw = IO (Maybe OId) -> m (Maybe OId)
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
$ \result' :: Ptr OId
result' -> do
        OId
result'' <- ((ManagedPtr OId -> OId) -> Ptr OId -> IO OId
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr OId -> OId
OId) Ptr OId
result'
        OId -> IO OId
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 (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 :: Text -> m (Maybe OId)
oIdNewFromString str :: Text
str = IO (Maybe OId) -> m (Maybe OId)
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
$ \result' :: Ptr OId
result' -> do
        OId
result'' <- ((ManagedPtr OId -> OId) -> Ptr OId -> IO OId
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr OId -> OId
OId) Ptr OId
result'
        OId -> IO OId
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 (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 :: OId -> OId -> m Int32
oIdCompare a :: OId
a b :: OId
b = IO Int32 -> m Int32
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 (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data OIdCompareMethodInfo
instance (signature ~ (OId -> m Int32), MonadIO m) => O.MethodInfo OIdCompareMethodInfo OId signature where
    overloadedMethod = 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 :: OId -> m (Maybe OId)
oIdCopy oid :: OId
oid = IO (Maybe OId) -> m (Maybe OId)
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
$ \result' :: Ptr OId
result' -> do
        OId
result'' <- ((ManagedPtr OId -> OId) -> Ptr OId -> IO OId
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr OId -> OId
OId) Ptr OId
result'
        OId -> IO OId
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 (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.MethodInfo OIdCopyMethodInfo OId signature where
    overloadedMethod = 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 :: OId -> OId -> m Bool
oIdEqual a :: OId
a b :: OId
b = IO Bool -> m Bool
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
/= 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 (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data OIdEqualMethodInfo
instance (signature ~ (OId -> m Bool), MonadIO m) => O.MethodInfo OIdEqualMethodInfo OId signature where
    overloadedMethod = 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 :: OId -> m ()
oIdFree oid :: OId
oid = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data OIdFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo OIdFreeMethodInfo OId signature where
    overloadedMethod = 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 :: OId -> Text -> m Bool
oIdHasPrefix oid :: OId
oid prefix :: Text
prefix = IO Bool -> m Bool
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
/= 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 (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.MethodInfo OIdHasPrefixMethodInfo OId signature where
    overloadedMethod = 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 :: OId -> m Word32
oIdHash oid :: OId
oid = IO Word32 -> m Word32
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 (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data OIdHashMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo OIdHashMethodInfo OId signature where
    overloadedMethod = 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 :: OId -> m Bool
oIdIsZero oid :: OId
oid = IO Bool -> m Bool
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
/= 0) CInt
result
    OId -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr OId
oid
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data OIdIsZeroMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo OIdIsZeroMethodInfo OId signature where
    overloadedMethod = 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 :: OId -> m (Maybe Text)
oIdToString oid :: OId
oid = IO (Maybe Text) -> m (Maybe Text)
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
$ \result' :: 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 (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 (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.MethodInfo OIdToStringMethodInfo OId signature where
    overloadedMethod = 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.MethodInfo 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

#endif