{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)

An extensible options structure controlling checkout.  Ensure that
you have entirely zeroed the structure, then set just the desired
options.  This is used by 'GI.OSTree.Objects.Repo.repoCheckoutAt' which
supercedes previous separate enumeration usage in
'GI.OSTree.Objects.Repo.repoCheckoutTree' and @/ostree_repo_checkout_tree_at()/@.
-}

module GI.OSTree.Structs.RepoCheckoutAtOptions
    ( 

-- * Exported types
    RepoCheckoutAtOptions(..)               ,
    newZeroRepoCheckoutAtOptions            ,
    noRepoCheckoutAtOptions                 ,


 -- * Properties
-- ** devinoToCsumCache #attr:devinoToCsumCache#
    clearRepoCheckoutAtOptionsDevinoToCsumCache,
    getRepoCheckoutAtOptionsDevinoToCsumCache,
    repoCheckoutAtOptions_devinoToCsumCache ,
    setRepoCheckoutAtOptionsDevinoToCsumCache,


-- ** enableFsync #attr:enableFsync#
    getRepoCheckoutAtOptionsEnableFsync     ,
    repoCheckoutAtOptions_enableFsync       ,
    setRepoCheckoutAtOptionsEnableFsync     ,


-- ** enableUncompressedCache #attr:enableUncompressedCache#
    getRepoCheckoutAtOptionsEnableUncompressedCache,
    repoCheckoutAtOptions_enableUncompressedCache,
    setRepoCheckoutAtOptionsEnableUncompressedCache,


-- ** mode #attr:mode#
    getRepoCheckoutAtOptionsMode            ,
    repoCheckoutAtOptions_mode              ,
    setRepoCheckoutAtOptionsMode            ,


-- ** noCopyFallback #attr:noCopyFallback#
    getRepoCheckoutAtOptionsNoCopyFallback  ,
    repoCheckoutAtOptions_noCopyFallback    ,
    setRepoCheckoutAtOptionsNoCopyFallback  ,


-- ** overwriteMode #attr:overwriteMode#
    getRepoCheckoutAtOptionsOverwriteMode   ,
    repoCheckoutAtOptions_overwriteMode     ,
    setRepoCheckoutAtOptionsOverwriteMode   ,


-- ** processWhiteouts #attr:processWhiteouts#
    getRepoCheckoutAtOptionsProcessWhiteouts,
    repoCheckoutAtOptions_processWhiteouts  ,
    setRepoCheckoutAtOptionsProcessWhiteouts,


-- ** subpath #attr:subpath#
    clearRepoCheckoutAtOptionsSubpath       ,
    getRepoCheckoutAtOptionsSubpath         ,
    repoCheckoutAtOptions_subpath           ,
    setRepoCheckoutAtOptionsSubpath         ,




    ) 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.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
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 {-# SOURCE #-} qualified GI.OSTree.Enums as OSTree.Enums
import {-# SOURCE #-} qualified GI.OSTree.Structs.RepoDevInoCache as OSTree.RepoDevInoCache

newtype RepoCheckoutAtOptions = RepoCheckoutAtOptions (ManagedPtr RepoCheckoutAtOptions)
instance WrappedPtr RepoCheckoutAtOptions where
    wrappedPtrCalloc = callocBytes 152
    wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 152 >=> wrapPtr RepoCheckoutAtOptions)
    wrappedPtrFree = Just ptr_to_g_free

-- | Construct a `RepoCheckoutAtOptions` struct initialized to zero.
newZeroRepoCheckoutAtOptions :: MonadIO m => m RepoCheckoutAtOptions
newZeroRepoCheckoutAtOptions = liftIO $ wrappedPtrCalloc >>= wrapPtr RepoCheckoutAtOptions

instance tag ~ 'AttrSet => Constructible RepoCheckoutAtOptions tag where
    new _ attrs = do
        o <- newZeroRepoCheckoutAtOptions
        GI.Attributes.set o attrs
        return o


noRepoCheckoutAtOptions :: Maybe RepoCheckoutAtOptions
noRepoCheckoutAtOptions = Nothing

getRepoCheckoutAtOptionsMode :: MonadIO m => RepoCheckoutAtOptions -> m OSTree.Enums.RepoCheckoutMode
getRepoCheckoutAtOptionsMode s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO CUInt
    let val' = (toEnum . fromIntegral) val
    return val'

setRepoCheckoutAtOptionsMode :: MonadIO m => RepoCheckoutAtOptions -> OSTree.Enums.RepoCheckoutMode -> m ()
setRepoCheckoutAtOptionsMode s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = (fromIntegral . fromEnum) val
    poke (ptr `plusPtr` 0) (val' :: CUInt)

data RepoCheckoutAtOptionsModeFieldInfo
instance AttrInfo RepoCheckoutAtOptionsModeFieldInfo where
    type AttrAllowedOps RepoCheckoutAtOptionsModeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint RepoCheckoutAtOptionsModeFieldInfo = (~) OSTree.Enums.RepoCheckoutMode
    type AttrBaseTypeConstraint RepoCheckoutAtOptionsModeFieldInfo = (~) RepoCheckoutAtOptions
    type AttrGetType RepoCheckoutAtOptionsModeFieldInfo = OSTree.Enums.RepoCheckoutMode
    type AttrLabel RepoCheckoutAtOptionsModeFieldInfo = "mode"
    type AttrOrigin RepoCheckoutAtOptionsModeFieldInfo = RepoCheckoutAtOptions
    attrGet _ = getRepoCheckoutAtOptionsMode
    attrSet _ = setRepoCheckoutAtOptionsMode
    attrConstruct = undefined
    attrClear _ = undefined

repoCheckoutAtOptions_mode :: AttrLabelProxy "mode"
repoCheckoutAtOptions_mode = AttrLabelProxy


getRepoCheckoutAtOptionsOverwriteMode :: MonadIO m => RepoCheckoutAtOptions -> m OSTree.Enums.RepoCheckoutOverwriteMode
getRepoCheckoutAtOptionsOverwriteMode s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 4) :: IO CUInt
    let val' = (toEnum . fromIntegral) val
    return val'

setRepoCheckoutAtOptionsOverwriteMode :: MonadIO m => RepoCheckoutAtOptions -> OSTree.Enums.RepoCheckoutOverwriteMode -> m ()
setRepoCheckoutAtOptionsOverwriteMode s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = (fromIntegral . fromEnum) val
    poke (ptr `plusPtr` 4) (val' :: CUInt)

data RepoCheckoutAtOptionsOverwriteModeFieldInfo
instance AttrInfo RepoCheckoutAtOptionsOverwriteModeFieldInfo where
    type AttrAllowedOps RepoCheckoutAtOptionsOverwriteModeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint RepoCheckoutAtOptionsOverwriteModeFieldInfo = (~) OSTree.Enums.RepoCheckoutOverwriteMode
    type AttrBaseTypeConstraint RepoCheckoutAtOptionsOverwriteModeFieldInfo = (~) RepoCheckoutAtOptions
    type AttrGetType RepoCheckoutAtOptionsOverwriteModeFieldInfo = OSTree.Enums.RepoCheckoutOverwriteMode
    type AttrLabel RepoCheckoutAtOptionsOverwriteModeFieldInfo = "overwrite_mode"
    type AttrOrigin RepoCheckoutAtOptionsOverwriteModeFieldInfo = RepoCheckoutAtOptions
    attrGet _ = getRepoCheckoutAtOptionsOverwriteMode
    attrSet _ = setRepoCheckoutAtOptionsOverwriteMode
    attrConstruct = undefined
    attrClear _ = undefined

repoCheckoutAtOptions_overwriteMode :: AttrLabelProxy "overwriteMode"
repoCheckoutAtOptions_overwriteMode = AttrLabelProxy


getRepoCheckoutAtOptionsEnableUncompressedCache :: MonadIO m => RepoCheckoutAtOptions -> m Bool
getRepoCheckoutAtOptionsEnableUncompressedCache s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO CInt
    let val' = (/= 0) val
    return val'

setRepoCheckoutAtOptionsEnableUncompressedCache :: MonadIO m => RepoCheckoutAtOptions -> Bool -> m ()
setRepoCheckoutAtOptionsEnableUncompressedCache s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = (fromIntegral . fromEnum) val
    poke (ptr `plusPtr` 8) (val' :: CInt)

data RepoCheckoutAtOptionsEnableUncompressedCacheFieldInfo
instance AttrInfo RepoCheckoutAtOptionsEnableUncompressedCacheFieldInfo where
    type AttrAllowedOps RepoCheckoutAtOptionsEnableUncompressedCacheFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint RepoCheckoutAtOptionsEnableUncompressedCacheFieldInfo = (~) Bool
    type AttrBaseTypeConstraint RepoCheckoutAtOptionsEnableUncompressedCacheFieldInfo = (~) RepoCheckoutAtOptions
    type AttrGetType RepoCheckoutAtOptionsEnableUncompressedCacheFieldInfo = Bool
    type AttrLabel RepoCheckoutAtOptionsEnableUncompressedCacheFieldInfo = "enable_uncompressed_cache"
    type AttrOrigin RepoCheckoutAtOptionsEnableUncompressedCacheFieldInfo = RepoCheckoutAtOptions
    attrGet _ = getRepoCheckoutAtOptionsEnableUncompressedCache
    attrSet _ = setRepoCheckoutAtOptionsEnableUncompressedCache
    attrConstruct = undefined
    attrClear _ = undefined

repoCheckoutAtOptions_enableUncompressedCache :: AttrLabelProxy "enableUncompressedCache"
repoCheckoutAtOptions_enableUncompressedCache = AttrLabelProxy


getRepoCheckoutAtOptionsEnableFsync :: MonadIO m => RepoCheckoutAtOptions -> m Bool
getRepoCheckoutAtOptionsEnableFsync s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 12) :: IO CInt
    let val' = (/= 0) val
    return val'

setRepoCheckoutAtOptionsEnableFsync :: MonadIO m => RepoCheckoutAtOptions -> Bool -> m ()
setRepoCheckoutAtOptionsEnableFsync s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = (fromIntegral . fromEnum) val
    poke (ptr `plusPtr` 12) (val' :: CInt)

data RepoCheckoutAtOptionsEnableFsyncFieldInfo
instance AttrInfo RepoCheckoutAtOptionsEnableFsyncFieldInfo where
    type AttrAllowedOps RepoCheckoutAtOptionsEnableFsyncFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint RepoCheckoutAtOptionsEnableFsyncFieldInfo = (~) Bool
    type AttrBaseTypeConstraint RepoCheckoutAtOptionsEnableFsyncFieldInfo = (~) RepoCheckoutAtOptions
    type AttrGetType RepoCheckoutAtOptionsEnableFsyncFieldInfo = Bool
    type AttrLabel RepoCheckoutAtOptionsEnableFsyncFieldInfo = "enable_fsync"
    type AttrOrigin RepoCheckoutAtOptionsEnableFsyncFieldInfo = RepoCheckoutAtOptions
    attrGet _ = getRepoCheckoutAtOptionsEnableFsync
    attrSet _ = setRepoCheckoutAtOptionsEnableFsync
    attrConstruct = undefined
    attrClear _ = undefined

repoCheckoutAtOptions_enableFsync :: AttrLabelProxy "enableFsync"
repoCheckoutAtOptions_enableFsync = AttrLabelProxy


getRepoCheckoutAtOptionsProcessWhiteouts :: MonadIO m => RepoCheckoutAtOptions -> m Bool
getRepoCheckoutAtOptionsProcessWhiteouts s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO CInt
    let val' = (/= 0) val
    return val'

setRepoCheckoutAtOptionsProcessWhiteouts :: MonadIO m => RepoCheckoutAtOptions -> Bool -> m ()
setRepoCheckoutAtOptionsProcessWhiteouts s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = (fromIntegral . fromEnum) val
    poke (ptr `plusPtr` 16) (val' :: CInt)

data RepoCheckoutAtOptionsProcessWhiteoutsFieldInfo
instance AttrInfo RepoCheckoutAtOptionsProcessWhiteoutsFieldInfo where
    type AttrAllowedOps RepoCheckoutAtOptionsProcessWhiteoutsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint RepoCheckoutAtOptionsProcessWhiteoutsFieldInfo = (~) Bool
    type AttrBaseTypeConstraint RepoCheckoutAtOptionsProcessWhiteoutsFieldInfo = (~) RepoCheckoutAtOptions
    type AttrGetType RepoCheckoutAtOptionsProcessWhiteoutsFieldInfo = Bool
    type AttrLabel RepoCheckoutAtOptionsProcessWhiteoutsFieldInfo = "process_whiteouts"
    type AttrOrigin RepoCheckoutAtOptionsProcessWhiteoutsFieldInfo = RepoCheckoutAtOptions
    attrGet _ = getRepoCheckoutAtOptionsProcessWhiteouts
    attrSet _ = setRepoCheckoutAtOptionsProcessWhiteouts
    attrConstruct = undefined
    attrClear _ = undefined

repoCheckoutAtOptions_processWhiteouts :: AttrLabelProxy "processWhiteouts"
repoCheckoutAtOptions_processWhiteouts = AttrLabelProxy


getRepoCheckoutAtOptionsNoCopyFallback :: MonadIO m => RepoCheckoutAtOptions -> m Bool
getRepoCheckoutAtOptionsNoCopyFallback s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 20) :: IO CInt
    let val' = (/= 0) val
    return val'

setRepoCheckoutAtOptionsNoCopyFallback :: MonadIO m => RepoCheckoutAtOptions -> Bool -> m ()
setRepoCheckoutAtOptionsNoCopyFallback s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = (fromIntegral . fromEnum) val
    poke (ptr `plusPtr` 20) (val' :: CInt)

data RepoCheckoutAtOptionsNoCopyFallbackFieldInfo
instance AttrInfo RepoCheckoutAtOptionsNoCopyFallbackFieldInfo where
    type AttrAllowedOps RepoCheckoutAtOptionsNoCopyFallbackFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint RepoCheckoutAtOptionsNoCopyFallbackFieldInfo = (~) Bool
    type AttrBaseTypeConstraint RepoCheckoutAtOptionsNoCopyFallbackFieldInfo = (~) RepoCheckoutAtOptions
    type AttrGetType RepoCheckoutAtOptionsNoCopyFallbackFieldInfo = Bool
    type AttrLabel RepoCheckoutAtOptionsNoCopyFallbackFieldInfo = "no_copy_fallback"
    type AttrOrigin RepoCheckoutAtOptionsNoCopyFallbackFieldInfo = RepoCheckoutAtOptions
    attrGet _ = getRepoCheckoutAtOptionsNoCopyFallback
    attrSet _ = setRepoCheckoutAtOptionsNoCopyFallback
    attrConstruct = undefined
    attrClear _ = undefined

repoCheckoutAtOptions_noCopyFallback :: AttrLabelProxy "noCopyFallback"
repoCheckoutAtOptions_noCopyFallback = AttrLabelProxy


-- XXX Skipped attribute for "RepoCheckoutAtOptions:unused_bools" :: Not implemented: "Don't know how to unpack C array of type TCArray False 7 (-1) (TBasicType TBoolean)"
getRepoCheckoutAtOptionsSubpath :: MonadIO m => RepoCheckoutAtOptions -> m (Maybe T.Text)
getRepoCheckoutAtOptionsSubpath s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 56) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return result

setRepoCheckoutAtOptionsSubpath :: MonadIO m => RepoCheckoutAtOptions -> CString -> m ()
setRepoCheckoutAtOptionsSubpath s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 56) (val :: CString)

clearRepoCheckoutAtOptionsSubpath :: MonadIO m => RepoCheckoutAtOptions -> m ()
clearRepoCheckoutAtOptionsSubpath s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 56) (FP.nullPtr :: CString)

data RepoCheckoutAtOptionsSubpathFieldInfo
instance AttrInfo RepoCheckoutAtOptionsSubpathFieldInfo where
    type AttrAllowedOps RepoCheckoutAtOptionsSubpathFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint RepoCheckoutAtOptionsSubpathFieldInfo = (~) CString
    type AttrBaseTypeConstraint RepoCheckoutAtOptionsSubpathFieldInfo = (~) RepoCheckoutAtOptions
    type AttrGetType RepoCheckoutAtOptionsSubpathFieldInfo = Maybe T.Text
    type AttrLabel RepoCheckoutAtOptionsSubpathFieldInfo = "subpath"
    type AttrOrigin RepoCheckoutAtOptionsSubpathFieldInfo = RepoCheckoutAtOptions
    attrGet _ = getRepoCheckoutAtOptionsSubpath
    attrSet _ = setRepoCheckoutAtOptionsSubpath
    attrConstruct = undefined
    attrClear _ = clearRepoCheckoutAtOptionsSubpath

repoCheckoutAtOptions_subpath :: AttrLabelProxy "subpath"
repoCheckoutAtOptions_subpath = AttrLabelProxy


getRepoCheckoutAtOptionsDevinoToCsumCache :: MonadIO m => RepoCheckoutAtOptions -> m (Maybe OSTree.RepoDevInoCache.RepoDevInoCache)
getRepoCheckoutAtOptionsDevinoToCsumCache s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 64) :: IO (Ptr OSTree.RepoDevInoCache.RepoDevInoCache)
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- (newBoxed OSTree.RepoDevInoCache.RepoDevInoCache) val'
        return val''
    return result

setRepoCheckoutAtOptionsDevinoToCsumCache :: MonadIO m => RepoCheckoutAtOptions -> Ptr OSTree.RepoDevInoCache.RepoDevInoCache -> m ()
setRepoCheckoutAtOptionsDevinoToCsumCache s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 64) (val :: Ptr OSTree.RepoDevInoCache.RepoDevInoCache)

clearRepoCheckoutAtOptionsDevinoToCsumCache :: MonadIO m => RepoCheckoutAtOptions -> m ()
clearRepoCheckoutAtOptionsDevinoToCsumCache s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 64) (FP.nullPtr :: Ptr OSTree.RepoDevInoCache.RepoDevInoCache)

data RepoCheckoutAtOptionsDevinoToCsumCacheFieldInfo
instance AttrInfo RepoCheckoutAtOptionsDevinoToCsumCacheFieldInfo where
    type AttrAllowedOps RepoCheckoutAtOptionsDevinoToCsumCacheFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint RepoCheckoutAtOptionsDevinoToCsumCacheFieldInfo = (~) (Ptr OSTree.RepoDevInoCache.RepoDevInoCache)
    type AttrBaseTypeConstraint RepoCheckoutAtOptionsDevinoToCsumCacheFieldInfo = (~) RepoCheckoutAtOptions
    type AttrGetType RepoCheckoutAtOptionsDevinoToCsumCacheFieldInfo = Maybe OSTree.RepoDevInoCache.RepoDevInoCache
    type AttrLabel RepoCheckoutAtOptionsDevinoToCsumCacheFieldInfo = "devino_to_csum_cache"
    type AttrOrigin RepoCheckoutAtOptionsDevinoToCsumCacheFieldInfo = RepoCheckoutAtOptions
    attrGet _ = getRepoCheckoutAtOptionsDevinoToCsumCache
    attrSet _ = setRepoCheckoutAtOptionsDevinoToCsumCache
    attrConstruct = undefined
    attrClear _ = clearRepoCheckoutAtOptionsDevinoToCsumCache

repoCheckoutAtOptions_devinoToCsumCache :: AttrLabelProxy "devinoToCsumCache"
repoCheckoutAtOptions_devinoToCsumCache = AttrLabelProxy


-- XXX Skipped attribute for "RepoCheckoutAtOptions:unused_ints" :: Not implemented: "Don't know how to unpack C array of type TCArray False 6 (-1) (TBasicType TInt)"
-- XXX Skipped attribute for "RepoCheckoutAtOptions:unused_ptrs" :: Not implemented: "Don't know how to unpack C array of type TCArray False 7 (-1) (TBasicType TPtr)"

instance O.HasAttributeList RepoCheckoutAtOptions
type instance O.AttributeList RepoCheckoutAtOptions = RepoCheckoutAtOptionsAttributeList
type RepoCheckoutAtOptionsAttributeList = ('[ '("mode", RepoCheckoutAtOptionsModeFieldInfo), '("overwriteMode", RepoCheckoutAtOptionsOverwriteModeFieldInfo), '("enableUncompressedCache", RepoCheckoutAtOptionsEnableUncompressedCacheFieldInfo), '("enableFsync", RepoCheckoutAtOptionsEnableFsyncFieldInfo), '("processWhiteouts", RepoCheckoutAtOptionsProcessWhiteoutsFieldInfo), '("noCopyFallback", RepoCheckoutAtOptionsNoCopyFallbackFieldInfo), '("subpath", RepoCheckoutAtOptionsSubpathFieldInfo), '("devinoToCsumCache", RepoCheckoutAtOptionsDevinoToCsumCacheFieldInfo)] :: [(Symbol, *)])

type family ResolveRepoCheckoutAtOptionsMethod (t :: Symbol) (o :: *) :: * where
    ResolveRepoCheckoutAtOptionsMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveRepoCheckoutAtOptionsMethod t RepoCheckoutAtOptions, O.MethodInfo info RepoCheckoutAtOptions p) => O.IsLabelProxy t (RepoCheckoutAtOptions -> p) where
    fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)

#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolveRepoCheckoutAtOptionsMethod t RepoCheckoutAtOptions, O.MethodInfo info RepoCheckoutAtOptions p) => O.IsLabel t (RepoCheckoutAtOptions -> p) where
    fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif