{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A structure which globally uniquely identifies a ref as the tuple
-- (/@collectionId@/, /@refName@/). For backwards compatibility, /@collectionId@/ may be 'P.Nothing',
-- indicating a ref name which is not globally unique.
-- 
-- /Since: 2018.6/

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

module GI.OSTree.Structs.CollectionRef
    ( 

-- * Exported types
    CollectionRef(..)                       ,
    newZeroCollectionRef                    ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveCollectionRefMethod              ,
#endif


-- ** dup #method:dup#

#if defined(ENABLE_OVERLOADING)
    CollectionRefDupMethodInfo              ,
#endif
    collectionRefDup                        ,


-- ** dupv #method:dupv#

    collectionRefDupv                       ,


-- ** equal #method:equal#

    collectionRefEqual                      ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    CollectionRefFreeMethodInfo             ,
#endif
    collectionRefFree                       ,


-- ** freev #method:freev#

    collectionRefFreev                      ,


-- ** hash #method:hash#

    collectionRefHash                       ,


-- ** new #method:new#

    collectionRefNew                        ,




 -- * Properties
-- ** collectionId #attr:collectionId#
-- | collection ID which provided the ref, or 'P.Nothing' if there
--    is no associated collection

    clearCollectionRefCollectionId          ,
#if defined(ENABLE_OVERLOADING)
    collectionRef_collectionId              ,
#endif
    getCollectionRefCollectionId            ,
    setCollectionRefCollectionId            ,


-- ** refName #attr:refName#
-- | ref name

    clearCollectionRefRefName               ,
#if defined(ENABLE_OVERLOADING)
    collectionRef_refName                   ,
#endif
    getCollectionRefRefName                 ,
    setCollectionRefRefName                 ,




    ) 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.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.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 CollectionRef = CollectionRef (SP.ManagedPtr CollectionRef)
    deriving (CollectionRef -> CollectionRef -> Bool
(CollectionRef -> CollectionRef -> Bool)
-> (CollectionRef -> CollectionRef -> Bool) -> Eq CollectionRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CollectionRef -> CollectionRef -> Bool
$c/= :: CollectionRef -> CollectionRef -> Bool
== :: CollectionRef -> CollectionRef -> Bool
$c== :: CollectionRef -> CollectionRef -> Bool
Eq)

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

foreign import ccall "ostree_collection_ref_get_type" c_ostree_collection_ref_get_type :: 
    IO GType

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

instance B.Types.TypedObject CollectionRef where
    glibType :: IO GType
glibType = IO GType
c_ostree_collection_ref_get_type

instance B.Types.GBoxed CollectionRef

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

-- | Construct a `CollectionRef` struct initialized to zero.
newZeroCollectionRef :: MonadIO m => m CollectionRef
newZeroCollectionRef :: m CollectionRef
newZeroCollectionRef = IO CollectionRef -> m CollectionRef
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CollectionRef -> m CollectionRef)
-> IO CollectionRef -> m CollectionRef
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr CollectionRef)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
16 IO (Ptr CollectionRef)
-> (Ptr CollectionRef -> IO CollectionRef) -> IO CollectionRef
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr CollectionRef -> CollectionRef)
-> Ptr CollectionRef -> IO CollectionRef
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr CollectionRef -> CollectionRef
CollectionRef

instance tag ~ 'AttrSet => Constructible CollectionRef tag where
    new :: (ManagedPtr CollectionRef -> CollectionRef)
-> [AttrOp CollectionRef tag] -> m CollectionRef
new ManagedPtr CollectionRef -> CollectionRef
_ [AttrOp CollectionRef tag]
attrs = do
        CollectionRef
o <- m CollectionRef
forall (m :: * -> *). MonadIO m => m CollectionRef
newZeroCollectionRef
        CollectionRef -> [AttrOp CollectionRef 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set CollectionRef
o [AttrOp CollectionRef tag]
[AttrOp CollectionRef 'AttrSet]
attrs
        CollectionRef -> m CollectionRef
forall (m :: * -> *) a. Monad m => a -> m a
return CollectionRef
o


-- | Get the value of the “@collection_id@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' collectionRef #collectionId
-- @
getCollectionRefCollectionId :: MonadIO m => CollectionRef -> m (Maybe T.Text)
getCollectionRefCollectionId :: CollectionRef -> m (Maybe Text)
getCollectionRefCollectionId CollectionRef
s = 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
$ CollectionRef
-> (Ptr CollectionRef -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr CollectionRef
s ((Ptr CollectionRef -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr CollectionRef -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CollectionRef
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr CollectionRef
ptr Ptr CollectionRef -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@collection_id@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' collectionRef [ #collectionId 'Data.GI.Base.Attributes.:=' value ]
-- @
setCollectionRefCollectionId :: MonadIO m => CollectionRef -> CString -> m ()
setCollectionRefCollectionId :: CollectionRef -> CString -> m ()
setCollectionRefCollectionId CollectionRef
s CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ CollectionRef -> (Ptr CollectionRef -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr CollectionRef
s ((Ptr CollectionRef -> IO ()) -> IO ())
-> (Ptr CollectionRef -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CollectionRef
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CollectionRef
ptr Ptr CollectionRef -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CString
val :: CString)

-- | Set the value of the “@collection_id@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #collectionId
-- @
clearCollectionRefCollectionId :: MonadIO m => CollectionRef -> m ()
clearCollectionRefCollectionId :: CollectionRef -> m ()
clearCollectionRefCollectionId CollectionRef
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ CollectionRef -> (Ptr CollectionRef -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr CollectionRef
s ((Ptr CollectionRef -> IO ()) -> IO ())
-> (Ptr CollectionRef -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CollectionRef
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CollectionRef
ptr Ptr CollectionRef -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data CollectionRefCollectionIdFieldInfo
instance AttrInfo CollectionRefCollectionIdFieldInfo where
    type AttrBaseTypeConstraint CollectionRefCollectionIdFieldInfo = (~) CollectionRef
    type AttrAllowedOps CollectionRefCollectionIdFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint CollectionRefCollectionIdFieldInfo = (~) CString
    type AttrTransferTypeConstraint CollectionRefCollectionIdFieldInfo = (~)CString
    type AttrTransferType CollectionRefCollectionIdFieldInfo = CString
    type AttrGetType CollectionRefCollectionIdFieldInfo = Maybe T.Text
    type AttrLabel CollectionRefCollectionIdFieldInfo = "collection_id"
    type AttrOrigin CollectionRefCollectionIdFieldInfo = CollectionRef
    attrGet = getCollectionRefCollectionId
    attrSet = setCollectionRefCollectionId
    attrConstruct = undefined
    attrClear = clearCollectionRefCollectionId
    attrTransfer _ v = do
        return v

collectionRef_collectionId :: AttrLabelProxy "collectionId"
collectionRef_collectionId = AttrLabelProxy

#endif


-- | Get the value of the “@ref_name@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' collectionRef #refName
-- @
getCollectionRefRefName :: MonadIO m => CollectionRef -> m (Maybe T.Text)
getCollectionRefRefName :: CollectionRef -> m (Maybe Text)
getCollectionRefRefName CollectionRef
s = 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
$ CollectionRef
-> (Ptr CollectionRef -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr CollectionRef
s ((Ptr CollectionRef -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr CollectionRef -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CollectionRef
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr CollectionRef
ptr Ptr CollectionRef -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@ref_name@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' collectionRef [ #refName 'Data.GI.Base.Attributes.:=' value ]
-- @
setCollectionRefRefName :: MonadIO m => CollectionRef -> CString -> m ()
setCollectionRefRefName :: CollectionRef -> CString -> m ()
setCollectionRefRefName CollectionRef
s CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ CollectionRef -> (Ptr CollectionRef -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr CollectionRef
s ((Ptr CollectionRef -> IO ()) -> IO ())
-> (Ptr CollectionRef -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CollectionRef
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CollectionRef
ptr Ptr CollectionRef -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CString
val :: CString)

-- | Set the value of the “@ref_name@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #refName
-- @
clearCollectionRefRefName :: MonadIO m => CollectionRef -> m ()
clearCollectionRefRefName :: CollectionRef -> m ()
clearCollectionRefRefName CollectionRef
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ CollectionRef -> (Ptr CollectionRef -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr CollectionRef
s ((Ptr CollectionRef -> IO ()) -> IO ())
-> (Ptr CollectionRef -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CollectionRef
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CollectionRef
ptr Ptr CollectionRef -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data CollectionRefRefNameFieldInfo
instance AttrInfo CollectionRefRefNameFieldInfo where
    type AttrBaseTypeConstraint CollectionRefRefNameFieldInfo = (~) CollectionRef
    type AttrAllowedOps CollectionRefRefNameFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint CollectionRefRefNameFieldInfo = (~) CString
    type AttrTransferTypeConstraint CollectionRefRefNameFieldInfo = (~)CString
    type AttrTransferType CollectionRefRefNameFieldInfo = CString
    type AttrGetType CollectionRefRefNameFieldInfo = Maybe T.Text
    type AttrLabel CollectionRefRefNameFieldInfo = "ref_name"
    type AttrOrigin CollectionRefRefNameFieldInfo = CollectionRef
    attrGet = getCollectionRefRefName
    attrSet = setCollectionRefRefName
    attrConstruct = undefined
    attrClear = clearCollectionRefRefName
    attrTransfer _ v = do
        return v

collectionRef_refName :: AttrLabelProxy "refName"
collectionRef_refName = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList CollectionRef
type instance O.AttributeList CollectionRef = CollectionRefAttributeList
type CollectionRefAttributeList = ('[ '("collectionId", CollectionRefCollectionIdFieldInfo), '("refName", CollectionRefRefNameFieldInfo)] :: [(Symbol, *)])
#endif

-- method CollectionRef::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "collection_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a collection ID, or %NULL for a plain ref"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ref_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a ref name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "OSTree" , name = "CollectionRef" })
-- throws : False
-- Skip return : False

foreign import ccall "ostree_collection_ref_new" ostree_collection_ref_new :: 
    CString ->                              -- collection_id : TBasicType TUTF8
    CString ->                              -- ref_name : TBasicType TUTF8
    IO (Ptr CollectionRef)

-- | Create a new t'GI.OSTree.Structs.CollectionRef.CollectionRef' containing (/@collectionId@/, /@refName@/). If
-- /@collectionId@/ is 'P.Nothing', this is equivalent to a plain ref name string (not a
-- refspec; no remote name is included), which can be used for non-P2P
-- operations.
-- 
-- /Since: 2018.6/
collectionRefNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (T.Text)
    -- ^ /@collectionId@/: a collection ID, or 'P.Nothing' for a plain ref
    -> T.Text
    -- ^ /@refName@/: a ref name
    -> m (Maybe CollectionRef)
    -- ^ __Returns:__ a new t'GI.OSTree.Structs.CollectionRef.CollectionRef'
collectionRefNew :: Maybe Text -> Text -> m (Maybe CollectionRef)
collectionRefNew Maybe Text
collectionId Text
refName = IO (Maybe CollectionRef) -> m (Maybe CollectionRef)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe CollectionRef) -> m (Maybe CollectionRef))
-> IO (Maybe CollectionRef) -> m (Maybe CollectionRef)
forall a b. (a -> b) -> a -> b
$ do
    CString
maybeCollectionId <- case Maybe Text
collectionId of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jCollectionId -> do
            CString
jCollectionId' <- Text -> IO CString
textToCString Text
jCollectionId
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jCollectionId'
    CString
refName' <- Text -> IO CString
textToCString Text
refName
    Ptr CollectionRef
result <- CString -> CString -> IO (Ptr CollectionRef)
ostree_collection_ref_new CString
maybeCollectionId CString
refName'
    Maybe CollectionRef
maybeResult <- Ptr CollectionRef
-> (Ptr CollectionRef -> IO CollectionRef)
-> IO (Maybe CollectionRef)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CollectionRef
result ((Ptr CollectionRef -> IO CollectionRef)
 -> IO (Maybe CollectionRef))
-> (Ptr CollectionRef -> IO CollectionRef)
-> IO (Maybe CollectionRef)
forall a b. (a -> b) -> a -> b
$ \Ptr CollectionRef
result' -> do
        CollectionRef
result'' <- ((ManagedPtr CollectionRef -> CollectionRef)
-> Ptr CollectionRef -> IO CollectionRef
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr CollectionRef -> CollectionRef
CollectionRef) Ptr CollectionRef
result'
        CollectionRef -> IO CollectionRef
forall (m :: * -> *) a. Monad m => a -> m a
return CollectionRef
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeCollectionId
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
refName'
    Maybe CollectionRef -> IO (Maybe CollectionRef)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CollectionRef
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "ostree_collection_ref_dup" ostree_collection_ref_dup :: 
    Ptr CollectionRef ->                    -- ref : TInterface (Name {namespace = "OSTree", name = "CollectionRef"})
    IO (Ptr CollectionRef)

-- | Create a copy of the given /@ref@/.
-- 
-- /Since: 2018.6/
collectionRefDup ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CollectionRef
    -- ^ /@ref@/: an t'GI.OSTree.Structs.CollectionRef.CollectionRef'
    -> m CollectionRef
    -- ^ __Returns:__ a newly allocated copy of /@ref@/
collectionRefDup :: CollectionRef -> m CollectionRef
collectionRefDup CollectionRef
ref = IO CollectionRef -> m CollectionRef
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CollectionRef -> m CollectionRef)
-> IO CollectionRef -> m CollectionRef
forall a b. (a -> b) -> a -> b
$ do
    Ptr CollectionRef
ref' <- CollectionRef -> IO (Ptr CollectionRef)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CollectionRef
ref
    Ptr CollectionRef
result <- Ptr CollectionRef -> IO (Ptr CollectionRef)
ostree_collection_ref_dup Ptr CollectionRef
ref'
    Text -> Ptr CollectionRef -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"collectionRefDup" Ptr CollectionRef
result
    CollectionRef
result' <- ((ManagedPtr CollectionRef -> CollectionRef)
-> Ptr CollectionRef -> IO CollectionRef
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr CollectionRef -> CollectionRef
CollectionRef) Ptr CollectionRef
result
    CollectionRef -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CollectionRef
ref
    CollectionRef -> IO CollectionRef
forall (m :: * -> *) a. Monad m => a -> m a
return CollectionRef
result'

#if defined(ENABLE_OVERLOADING)
data CollectionRefDupMethodInfo
instance (signature ~ (m CollectionRef), MonadIO m) => O.MethodInfo CollectionRefDupMethodInfo CollectionRef signature where
    overloadedMethod = collectionRefDup

#endif

-- method CollectionRef::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "ref"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "CollectionRef" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeCollectionRef"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ostree_collection_ref_free" ostree_collection_ref_free :: 
    Ptr CollectionRef ->                    -- ref : TInterface (Name {namespace = "OSTree", name = "CollectionRef"})
    IO ()

-- | Free the given /@ref@/.
-- 
-- /Since: 2018.6/
collectionRefFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CollectionRef
    -- ^ /@ref@/: an t'GI.OSTree.Structs.CollectionRef.CollectionRef'
    -> m ()
collectionRefFree :: CollectionRef -> m ()
collectionRefFree CollectionRef
ref = 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 CollectionRef
ref' <- CollectionRef -> IO (Ptr CollectionRef)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed CollectionRef
ref
    Ptr CollectionRef -> IO ()
ostree_collection_ref_free Ptr CollectionRef
ref'
    CollectionRef -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CollectionRef
ref
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CollectionRefFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo CollectionRefFreeMethodInfo CollectionRef signature where
    overloadedMethod = collectionRefFree

#endif

-- method CollectionRef::dupv
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "refs"
--           , argType =
--               TCArray
--                 True
--                 (-1)
--                 (-1)
--                 (TInterface Name { namespace = "OSTree" , name = "CollectionRef" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "%NULL-terminated array of #OstreeCollectionRefs"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TCArray
--                  True
--                  (-1)
--                  (-1)
--                  (TInterface
--                     Name { namespace = "OSTree" , name = "CollectionRef" }))
-- throws : False
-- Skip return : False

foreign import ccall "ostree_collection_ref_dupv" ostree_collection_ref_dupv :: 
    Ptr (Ptr CollectionRef) ->              -- refs : TCArray True (-1) (-1) (TInterface (Name {namespace = "OSTree", name = "CollectionRef"}))
    IO (Ptr (Ptr CollectionRef))

-- | Copy an array of @/OstreeCollectionRefs/@, including deep copies of all its
-- elements. /@refs@/ must be 'P.Nothing'-terminated; it may be empty, but must not be
-- 'P.Nothing'.
-- 
-- /Since: 2018.6/
collectionRefDupv ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [CollectionRef]
    -- ^ /@refs@/: 'P.Nothing'-terminated array of @/OstreeCollectionRefs/@
    -> m [CollectionRef]
    -- ^ __Returns:__ a newly allocated copy of /@refs@/
collectionRefDupv :: [CollectionRef] -> m [CollectionRef]
collectionRefDupv [CollectionRef]
refs = IO [CollectionRef] -> m [CollectionRef]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [CollectionRef] -> m [CollectionRef])
-> IO [CollectionRef] -> m [CollectionRef]
forall a b. (a -> b) -> a -> b
$ do
    [Ptr CollectionRef]
refs' <- (CollectionRef -> IO (Ptr CollectionRef))
-> [CollectionRef] -> IO [Ptr CollectionRef]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM CollectionRef -> IO (Ptr CollectionRef)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [CollectionRef]
refs
    Ptr (Ptr CollectionRef)
refs'' <- [Ptr CollectionRef] -> IO (Ptr (Ptr CollectionRef))
forall a. [Ptr a] -> IO (Ptr (Ptr a))
packZeroTerminatedPtrArray [Ptr CollectionRef]
refs'
    Ptr (Ptr CollectionRef)
result <- Ptr (Ptr CollectionRef) -> IO (Ptr (Ptr CollectionRef))
ostree_collection_ref_dupv Ptr (Ptr CollectionRef)
refs''
    Text -> Ptr (Ptr CollectionRef) -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"collectionRefDupv" Ptr (Ptr CollectionRef)
result
    [Ptr CollectionRef]
result' <- Ptr (Ptr CollectionRef) -> IO [Ptr CollectionRef]
forall a. Ptr (Ptr a) -> IO [Ptr a]
unpackZeroTerminatedPtrArray Ptr (Ptr CollectionRef)
result
    [CollectionRef]
result'' <- (Ptr CollectionRef -> IO CollectionRef)
-> [Ptr CollectionRef] -> IO [CollectionRef]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr CollectionRef -> CollectionRef)
-> Ptr CollectionRef -> IO CollectionRef
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr CollectionRef -> CollectionRef
CollectionRef) [Ptr CollectionRef]
result'
    Ptr (Ptr CollectionRef) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CollectionRef)
result
    (CollectionRef -> IO ()) -> [CollectionRef] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CollectionRef -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [CollectionRef]
refs
    Ptr (Ptr CollectionRef) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CollectionRef)
refs''
    [CollectionRef] -> IO [CollectionRef]
forall (m :: * -> *) a. Monad m => a -> m a
return [CollectionRef]
result''

#if defined(ENABLE_OVERLOADING)
#endif

-- method CollectionRef::equal
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "ref1"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeCollectionRef"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ref2"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "another #OstreeCollectionRef"
--                 , 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 "ostree_collection_ref_equal" ostree_collection_ref_equal :: 
    Ptr () ->                               -- ref1 : TBasicType TPtr
    Ptr () ->                               -- ref2 : TBasicType TPtr
    IO CInt

-- | Compare /@ref1@/ and /@ref2@/ and return 'P.True' if they have the same collection ID and
-- ref name, and 'P.False' otherwise. Both /@ref1@/ and /@ref2@/ must be non-'P.Nothing'.
-- 
-- /Since: 2018.6/
collectionRefEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ptr ()
    -- ^ /@ref1@/: an t'GI.OSTree.Structs.CollectionRef.CollectionRef'
    -> Ptr ()
    -- ^ /@ref2@/: another t'GI.OSTree.Structs.CollectionRef.CollectionRef'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@ref1@/ and /@ref2@/ are equal, 'P.False' otherwise
collectionRefEqual :: Ptr () -> Ptr () -> m Bool
collectionRefEqual Ptr ()
ref1 Ptr ()
ref2 = 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
    CInt
result <- Ptr () -> Ptr () -> IO CInt
ostree_collection_ref_equal Ptr ()
ref1 Ptr ()
ref2
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method CollectionRef::freev
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "refs"
--           , argType =
--               TCArray
--                 True
--                 (-1)
--                 (-1)
--                 (TInterface Name { namespace = "OSTree" , name = "CollectionRef" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an array of #OstreeCollectionRefs"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ostree_collection_ref_freev" ostree_collection_ref_freev :: 
    Ptr (Ptr CollectionRef) ->              -- refs : TCArray True (-1) (-1) (TInterface (Name {namespace = "OSTree", name = "CollectionRef"}))
    IO ()

-- | Free the given array of /@refs@/, including freeing all its elements. /@refs@/
-- must be 'P.Nothing'-terminated; it may be empty, but must not be 'P.Nothing'.
-- 
-- /Since: 2018.6/
collectionRefFreev ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [CollectionRef]
    -- ^ /@refs@/: an array of @/OstreeCollectionRefs/@
    -> m ()
collectionRefFreev :: [CollectionRef] -> m ()
collectionRefFreev [CollectionRef]
refs = 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 CollectionRef]
refs' <- (CollectionRef -> IO (Ptr CollectionRef))
-> [CollectionRef] -> IO [Ptr CollectionRef]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM CollectionRef -> IO (Ptr CollectionRef)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed [CollectionRef]
refs
    Ptr (Ptr CollectionRef)
refs'' <- [Ptr CollectionRef] -> IO (Ptr (Ptr CollectionRef))
forall a. [Ptr a] -> IO (Ptr (Ptr a))
packZeroTerminatedPtrArray [Ptr CollectionRef]
refs'
    Ptr (Ptr CollectionRef) -> IO ()
ostree_collection_ref_freev Ptr (Ptr CollectionRef)
refs''
    (CollectionRef -> IO ()) -> [CollectionRef] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CollectionRef -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [CollectionRef]
refs
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method CollectionRef::hash
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "ref"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeCollectionRef"
--                 , 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 "ostree_collection_ref_hash" ostree_collection_ref_hash :: 
    Ptr () ->                               -- ref : TBasicType TPtr
    IO Word32

-- | Hash the given /@ref@/. This function is suitable for use with t'GI.GLib.Structs.HashTable.HashTable'.
-- /@ref@/ must be non-'P.Nothing'.
-- 
-- /Since: 2018.6/
collectionRefHash ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ptr ()
    -- ^ /@ref@/: an t'GI.OSTree.Structs.CollectionRef.CollectionRef'
    -> m Word32
    -- ^ __Returns:__ hash value for /@ref@/
collectionRefHash :: Ptr () -> m Word32
collectionRefHash Ptr ()
ref = 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
    Word32
result <- Ptr () -> IO Word32
ostree_collection_ref_hash Ptr ()
ref
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveCollectionRefMethod (t :: Symbol) (o :: *) :: * where
    ResolveCollectionRefMethod "dup" o = CollectionRefDupMethodInfo
    ResolveCollectionRefMethod "free" o = CollectionRefFreeMethodInfo
    ResolveCollectionRefMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveCollectionRefMethod t CollectionRef, O.MethodInfo info CollectionRef p) => OL.IsLabel t (CollectionRef -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif