{-# LANGUAGE TypeApplications #-}


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

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

module GI.OSTree.Structs.SysrootDeployTreeOpts
    ( 

-- * Exported types
    SysrootDeployTreeOpts(..)               ,
    newZeroSysrootDeployTreeOpts            ,


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolveSysrootDeployTreeOptsMethod      ,
#endif



 -- * Properties


-- ** overlayInitrds #attr:overlayInitrds#
-- | /No description available in the introspection data./

    clearSysrootDeployTreeOptsOverlayInitrds,
    getSysrootDeployTreeOptsOverlayInitrds  ,
    setSysrootDeployTreeOptsOverlayInitrds  ,
#if defined(ENABLE_OVERLOADING)
    sysrootDeployTreeOpts_overlayInitrds    ,
#endif


-- ** overrideKernelArgv #attr:overrideKernelArgv#
-- | /No description available in the introspection data./

    clearSysrootDeployTreeOptsOverrideKernelArgv,
    getSysrootDeployTreeOptsOverrideKernelArgv,
    setSysrootDeployTreeOptsOverrideKernelArgv,
#if defined(ENABLE_OVERLOADING)
    sysrootDeployTreeOpts_overrideKernelArgv,
#endif




    ) 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.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
import qualified GHC.Records as R


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

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

instance BoxedPtr SysrootDeployTreeOpts where
    boxedPtrCopy :: SysrootDeployTreeOpts -> IO SysrootDeployTreeOpts
boxedPtrCopy = \SysrootDeployTreeOpts
p -> SysrootDeployTreeOpts
-> (Ptr SysrootDeployTreeOpts -> IO SysrootDeployTreeOpts)
-> IO SysrootDeployTreeOpts
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr SysrootDeployTreeOpts
p (Int -> Ptr SysrootDeployTreeOpts -> IO (Ptr SysrootDeployTreeOpts)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
128 (Ptr SysrootDeployTreeOpts -> IO (Ptr SysrootDeployTreeOpts))
-> (Ptr SysrootDeployTreeOpts -> IO SysrootDeployTreeOpts)
-> Ptr SysrootDeployTreeOpts
-> IO SysrootDeployTreeOpts
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr SysrootDeployTreeOpts -> SysrootDeployTreeOpts)
-> Ptr SysrootDeployTreeOpts -> IO SysrootDeployTreeOpts
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr SysrootDeployTreeOpts -> SysrootDeployTreeOpts
SysrootDeployTreeOpts)
    boxedPtrFree :: SysrootDeployTreeOpts -> IO ()
boxedPtrFree = \SysrootDeployTreeOpts
x -> SysrootDeployTreeOpts
-> (Ptr SysrootDeployTreeOpts -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr SysrootDeployTreeOpts
x Ptr SysrootDeployTreeOpts -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr SysrootDeployTreeOpts where
    boxedPtrCalloc :: IO (Ptr SysrootDeployTreeOpts)
boxedPtrCalloc = Int -> IO (Ptr SysrootDeployTreeOpts)
forall a. Int -> IO (Ptr a)
callocBytes Int
128


-- | Construct a `SysrootDeployTreeOpts` struct initialized to zero.
newZeroSysrootDeployTreeOpts :: MonadIO m => m SysrootDeployTreeOpts
newZeroSysrootDeployTreeOpts :: forall (m :: * -> *). MonadIO m => m SysrootDeployTreeOpts
newZeroSysrootDeployTreeOpts = IO SysrootDeployTreeOpts -> m SysrootDeployTreeOpts
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SysrootDeployTreeOpts -> m SysrootDeployTreeOpts)
-> IO SysrootDeployTreeOpts -> m SysrootDeployTreeOpts
forall a b. (a -> b) -> a -> b
$ IO (Ptr SysrootDeployTreeOpts)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr SysrootDeployTreeOpts)
-> (Ptr SysrootDeployTreeOpts -> IO SysrootDeployTreeOpts)
-> IO SysrootDeployTreeOpts
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr SysrootDeployTreeOpts -> SysrootDeployTreeOpts)
-> Ptr SysrootDeployTreeOpts -> IO SysrootDeployTreeOpts
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr SysrootDeployTreeOpts -> SysrootDeployTreeOpts
SysrootDeployTreeOpts

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


-- XXX Skipped attribute for "SysrootDeployTreeOpts:unused_bools"
-- Not implemented: Don't know how to unpack C array of type TCArray False 8 (-1) (TBasicType TBoolean)
-- XXX Skipped attribute for "SysrootDeployTreeOpts:unused_ints"
-- Not implemented: Don't know how to unpack C array of type TCArray False 8 (-1) (TBasicType TInt)
-- | Get the value of the “@override_kernel_argv@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' sysrootDeployTreeOpts #overrideKernelArgv
-- @
getSysrootDeployTreeOptsOverrideKernelArgv :: MonadIO m => SysrootDeployTreeOpts -> m (Maybe T.Text)
getSysrootDeployTreeOptsOverrideKernelArgv :: forall (m :: * -> *).
MonadIO m =>
SysrootDeployTreeOpts -> m (Maybe Text)
getSysrootDeployTreeOptsOverrideKernelArgv SysrootDeployTreeOpts
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
$ SysrootDeployTreeOpts
-> (Ptr SysrootDeployTreeOpts -> IO (Maybe Text))
-> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr SysrootDeployTreeOpts
s ((Ptr SysrootDeployTreeOpts -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr SysrootDeployTreeOpts -> IO (Maybe Text))
-> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr SysrootDeployTreeOpts
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr SysrootDeployTreeOpts
ptr Ptr SysrootDeployTreeOpts -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64) :: 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 “@override_kernel_argv@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' sysrootDeployTreeOpts [ #overrideKernelArgv 'Data.GI.Base.Attributes.:=' value ]
-- @
setSysrootDeployTreeOptsOverrideKernelArgv :: MonadIO m => SysrootDeployTreeOpts -> CString -> m ()
setSysrootDeployTreeOptsOverrideKernelArgv :: forall (m :: * -> *).
MonadIO m =>
SysrootDeployTreeOpts -> CString -> m ()
setSysrootDeployTreeOptsOverrideKernelArgv SysrootDeployTreeOpts
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
$ SysrootDeployTreeOpts
-> (Ptr SysrootDeployTreeOpts -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr SysrootDeployTreeOpts
s ((Ptr SysrootDeployTreeOpts -> IO ()) -> IO ())
-> (Ptr SysrootDeployTreeOpts -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SysrootDeployTreeOpts
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr SysrootDeployTreeOpts
ptr Ptr SysrootDeployTreeOpts -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64) (CString
val :: CString)

-- | Set the value of the “@override_kernel_argv@” 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' #overrideKernelArgv
-- @
clearSysrootDeployTreeOptsOverrideKernelArgv :: MonadIO m => SysrootDeployTreeOpts -> m ()
clearSysrootDeployTreeOptsOverrideKernelArgv :: forall (m :: * -> *). MonadIO m => SysrootDeployTreeOpts -> m ()
clearSysrootDeployTreeOptsOverrideKernelArgv SysrootDeployTreeOpts
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SysrootDeployTreeOpts
-> (Ptr SysrootDeployTreeOpts -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr SysrootDeployTreeOpts
s ((Ptr SysrootDeployTreeOpts -> IO ()) -> IO ())
-> (Ptr SysrootDeployTreeOpts -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SysrootDeployTreeOpts
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr SysrootDeployTreeOpts
ptr Ptr SysrootDeployTreeOpts -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data SysrootDeployTreeOptsOverrideKernelArgvFieldInfo
instance AttrInfo SysrootDeployTreeOptsOverrideKernelArgvFieldInfo where
    type AttrBaseTypeConstraint SysrootDeployTreeOptsOverrideKernelArgvFieldInfo = (~) SysrootDeployTreeOpts
    type AttrAllowedOps SysrootDeployTreeOptsOverrideKernelArgvFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint SysrootDeployTreeOptsOverrideKernelArgvFieldInfo = (~) CString
    type AttrTransferTypeConstraint SysrootDeployTreeOptsOverrideKernelArgvFieldInfo = (~)CString
    type AttrTransferType SysrootDeployTreeOptsOverrideKernelArgvFieldInfo = CString
    type AttrGetType SysrootDeployTreeOptsOverrideKernelArgvFieldInfo = Maybe T.Text
    type AttrLabel SysrootDeployTreeOptsOverrideKernelArgvFieldInfo = "override_kernel_argv"
    type AttrOrigin SysrootDeployTreeOptsOverrideKernelArgvFieldInfo = SysrootDeployTreeOpts
    attrGet = getSysrootDeployTreeOptsOverrideKernelArgv
    attrSet = setSysrootDeployTreeOptsOverrideKernelArgv
    attrConstruct = undefined
    attrClear = clearSysrootDeployTreeOptsOverrideKernelArgv
    attrTransfer _ v = do
        return v

sysrootDeployTreeOpts_overrideKernelArgv :: AttrLabelProxy "overrideKernelArgv"
sysrootDeployTreeOpts_overrideKernelArgv = AttrLabelProxy

#endif


-- | Get the value of the “@overlay_initrds@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' sysrootDeployTreeOpts #overlayInitrds
-- @
getSysrootDeployTreeOptsOverlayInitrds :: MonadIO m => SysrootDeployTreeOpts -> m (Maybe T.Text)
getSysrootDeployTreeOptsOverlayInitrds :: forall (m :: * -> *).
MonadIO m =>
SysrootDeployTreeOpts -> m (Maybe Text)
getSysrootDeployTreeOptsOverlayInitrds SysrootDeployTreeOpts
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
$ SysrootDeployTreeOpts
-> (Ptr SysrootDeployTreeOpts -> IO (Maybe Text))
-> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr SysrootDeployTreeOpts
s ((Ptr SysrootDeployTreeOpts -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr SysrootDeployTreeOpts -> IO (Maybe Text))
-> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr SysrootDeployTreeOpts
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr SysrootDeployTreeOpts
ptr Ptr SysrootDeployTreeOpts -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72) :: 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 “@overlay_initrds@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' sysrootDeployTreeOpts [ #overlayInitrds 'Data.GI.Base.Attributes.:=' value ]
-- @
setSysrootDeployTreeOptsOverlayInitrds :: MonadIO m => SysrootDeployTreeOpts -> CString -> m ()
setSysrootDeployTreeOptsOverlayInitrds :: forall (m :: * -> *).
MonadIO m =>
SysrootDeployTreeOpts -> CString -> m ()
setSysrootDeployTreeOptsOverlayInitrds SysrootDeployTreeOpts
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
$ SysrootDeployTreeOpts
-> (Ptr SysrootDeployTreeOpts -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr SysrootDeployTreeOpts
s ((Ptr SysrootDeployTreeOpts -> IO ()) -> IO ())
-> (Ptr SysrootDeployTreeOpts -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SysrootDeployTreeOpts
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr SysrootDeployTreeOpts
ptr Ptr SysrootDeployTreeOpts -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72) (CString
val :: CString)

-- | Set the value of the “@overlay_initrds@” 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' #overlayInitrds
-- @
clearSysrootDeployTreeOptsOverlayInitrds :: MonadIO m => SysrootDeployTreeOpts -> m ()
clearSysrootDeployTreeOptsOverlayInitrds :: forall (m :: * -> *). MonadIO m => SysrootDeployTreeOpts -> m ()
clearSysrootDeployTreeOptsOverlayInitrds SysrootDeployTreeOpts
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SysrootDeployTreeOpts
-> (Ptr SysrootDeployTreeOpts -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr SysrootDeployTreeOpts
s ((Ptr SysrootDeployTreeOpts -> IO ()) -> IO ())
-> (Ptr SysrootDeployTreeOpts -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SysrootDeployTreeOpts
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr SysrootDeployTreeOpts
ptr Ptr SysrootDeployTreeOpts -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data SysrootDeployTreeOptsOverlayInitrdsFieldInfo
instance AttrInfo SysrootDeployTreeOptsOverlayInitrdsFieldInfo where
    type AttrBaseTypeConstraint SysrootDeployTreeOptsOverlayInitrdsFieldInfo = (~) SysrootDeployTreeOpts
    type AttrAllowedOps SysrootDeployTreeOptsOverlayInitrdsFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint SysrootDeployTreeOptsOverlayInitrdsFieldInfo = (~) CString
    type AttrTransferTypeConstraint SysrootDeployTreeOptsOverlayInitrdsFieldInfo = (~)CString
    type AttrTransferType SysrootDeployTreeOptsOverlayInitrdsFieldInfo = CString
    type AttrGetType SysrootDeployTreeOptsOverlayInitrdsFieldInfo = Maybe T.Text
    type AttrLabel SysrootDeployTreeOptsOverlayInitrdsFieldInfo = "overlay_initrds"
    type AttrOrigin SysrootDeployTreeOptsOverlayInitrdsFieldInfo = SysrootDeployTreeOpts
    attrGet = getSysrootDeployTreeOptsOverlayInitrds
    attrSet = setSysrootDeployTreeOptsOverlayInitrds
    attrConstruct = undefined
    attrClear = clearSysrootDeployTreeOptsOverlayInitrds
    attrTransfer _ v = do
        return v

sysrootDeployTreeOpts_overlayInitrds :: AttrLabelProxy "overlayInitrds"
sysrootDeployTreeOpts_overlayInitrds = AttrLabelProxy

#endif


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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SysrootDeployTreeOpts
type instance O.AttributeList SysrootDeployTreeOpts = SysrootDeployTreeOptsAttributeList
type SysrootDeployTreeOptsAttributeList = ('[ '("overrideKernelArgv", SysrootDeployTreeOptsOverrideKernelArgvFieldInfo), '("overlayInitrds", SysrootDeployTreeOptsOverlayInitrdsFieldInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveSysrootDeployTreeOptsMethod (t :: Symbol) (o :: *) :: * where
    ResolveSysrootDeployTreeOptsMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif