{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Wnck.Structs.WorkspaceLayout.WorkspaceLayout' struct contains information about the layout of
-- t'GI.Wnck.Objects.Workspace.Workspace' on a t'GI.Wnck.Objects.Screen.Screen', and the exact position of a specific
-- t'GI.Wnck.Objects.Workspace.Workspace'.
-- 
-- /Since: 2.12/

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

module GI.Wnck.Structs.WorkspaceLayout
    ( 

-- * Exported types
    WorkspaceLayout(..)                     ,
    newZeroWorkspaceLayout                  ,
    noWorkspaceLayout                       ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveWorkspaceLayoutMethod            ,
#endif




 -- * Properties
-- ** cols #attr:cols#
-- | number of columns in the layout grid.

    getWorkspaceLayoutCols                  ,
    setWorkspaceLayoutCols                  ,
#if defined(ENABLE_OVERLOADING)
    workspaceLayout_cols                    ,
#endif


-- ** currentCol #attr:currentCol#
-- | column of the specific t'GI.Wnck.Objects.Workspace.Workspace', starting from 0.

    getWorkspaceLayoutCurrentCol            ,
    setWorkspaceLayoutCurrentCol            ,
#if defined(ENABLE_OVERLOADING)
    workspaceLayout_currentCol              ,
#endif


-- ** currentRow #attr:currentRow#
-- | row of the specific t'GI.Wnck.Objects.Workspace.Workspace', starting from 0.

    getWorkspaceLayoutCurrentRow            ,
    setWorkspaceLayoutCurrentRow            ,
#if defined(ENABLE_OVERLOADING)
    workspaceLayout_currentRow              ,
#endif


-- ** grid #attr:grid#
-- | array of size /@gridArea@/ containing the index (starting from 0) of
-- the t'GI.Wnck.Objects.Workspace.Workspace' for each position in the layout grid, or -1 if the
-- position does not correspond to any t'GI.Wnck.Objects.Workspace.Workspace'.

    getWorkspaceLayoutGrid                  ,
    setWorkspaceLayoutGrid                  ,
#if defined(ENABLE_OVERLOADING)
    workspaceLayout_grid                    ,
#endif


-- ** gridArea #attr:gridArea#
-- | size of the grid containing all t'GI.Wnck.Objects.Workspace.Workspace'. This can be
-- bigger than the number of t'GI.Wnck.Objects.Workspace.Workspace' because the grid might not be
-- filled.

    getWorkspaceLayoutGridArea              ,
    setWorkspaceLayoutGridArea              ,
#if defined(ENABLE_OVERLOADING)
    workspaceLayout_gridArea                ,
#endif


-- ** rows #attr:rows#
-- | number of rows in the layout grid.

    getWorkspaceLayoutRows                  ,
    setWorkspaceLayoutRows                  ,
#if defined(ENABLE_OVERLOADING)
    workspaceLayout_rows                    ,
#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.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 WorkspaceLayout = WorkspaceLayout (ManagedPtr WorkspaceLayout)
    deriving (WorkspaceLayout -> WorkspaceLayout -> Bool
(WorkspaceLayout -> WorkspaceLayout -> Bool)
-> (WorkspaceLayout -> WorkspaceLayout -> Bool)
-> Eq WorkspaceLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WorkspaceLayout -> WorkspaceLayout -> Bool
$c/= :: WorkspaceLayout -> WorkspaceLayout -> Bool
== :: WorkspaceLayout -> WorkspaceLayout -> Bool
$c== :: WorkspaceLayout -> WorkspaceLayout -> Bool
Eq)
instance WrappedPtr WorkspaceLayout where
    wrappedPtrCalloc :: IO (Ptr WorkspaceLayout)
wrappedPtrCalloc = Int -> IO (Ptr WorkspaceLayout)
forall a. Int -> IO (Ptr a)
callocBytes 32
    wrappedPtrCopy :: WorkspaceLayout -> IO WorkspaceLayout
wrappedPtrCopy = \p :: WorkspaceLayout
p -> WorkspaceLayout
-> (Ptr WorkspaceLayout -> IO WorkspaceLayout)
-> IO WorkspaceLayout
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr WorkspaceLayout
p (Int -> Ptr WorkspaceLayout -> IO (Ptr WorkspaceLayout)
forall a. WrappedPtr a => Int -> Ptr a -> IO (Ptr a)
copyBytes 32 (Ptr WorkspaceLayout -> IO (Ptr WorkspaceLayout))
-> (Ptr WorkspaceLayout -> IO WorkspaceLayout)
-> Ptr WorkspaceLayout
-> IO WorkspaceLayout
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr WorkspaceLayout -> WorkspaceLayout)
-> Ptr WorkspaceLayout -> IO WorkspaceLayout
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr WorkspaceLayout -> WorkspaceLayout
WorkspaceLayout)
    wrappedPtrFree :: Maybe (GDestroyNotify WorkspaceLayout)
wrappedPtrFree = GDestroyNotify WorkspaceLayout
-> Maybe (GDestroyNotify WorkspaceLayout)
forall a. a -> Maybe a
Just GDestroyNotify WorkspaceLayout
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free

-- | Construct a `WorkspaceLayout` struct initialized to zero.
newZeroWorkspaceLayout :: MonadIO m => m WorkspaceLayout
newZeroWorkspaceLayout :: m WorkspaceLayout
newZeroWorkspaceLayout = IO WorkspaceLayout -> m WorkspaceLayout
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WorkspaceLayout -> m WorkspaceLayout)
-> IO WorkspaceLayout -> m WorkspaceLayout
forall a b. (a -> b) -> a -> b
$ IO (Ptr WorkspaceLayout)
forall a. WrappedPtr a => IO (Ptr a)
wrappedPtrCalloc IO (Ptr WorkspaceLayout)
-> (Ptr WorkspaceLayout -> IO WorkspaceLayout)
-> IO WorkspaceLayout
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr WorkspaceLayout -> WorkspaceLayout)
-> Ptr WorkspaceLayout -> IO WorkspaceLayout
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr WorkspaceLayout -> WorkspaceLayout
WorkspaceLayout

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


-- | A convenience alias for `Nothing` :: `Maybe` `WorkspaceLayout`.
noWorkspaceLayout :: Maybe WorkspaceLayout
noWorkspaceLayout :: Maybe WorkspaceLayout
noWorkspaceLayout = Maybe WorkspaceLayout
forall a. Maybe a
Nothing

-- | Get the value of the “@rows@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' workspaceLayout #rows
-- @
getWorkspaceLayoutRows :: MonadIO m => WorkspaceLayout -> m Int32
getWorkspaceLayoutRows :: WorkspaceLayout -> m Int32
getWorkspaceLayoutRows s :: WorkspaceLayout
s = 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
$ WorkspaceLayout -> (Ptr WorkspaceLayout -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr WorkspaceLayout
s ((Ptr WorkspaceLayout -> IO Int32) -> IO Int32)
-> (Ptr WorkspaceLayout -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr WorkspaceLayout
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr WorkspaceLayout
ptr Ptr WorkspaceLayout -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

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

#if defined(ENABLE_OVERLOADING)
data WorkspaceLayoutRowsFieldInfo
instance AttrInfo WorkspaceLayoutRowsFieldInfo where
    type AttrBaseTypeConstraint WorkspaceLayoutRowsFieldInfo = (~) WorkspaceLayout
    type AttrAllowedOps WorkspaceLayoutRowsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint WorkspaceLayoutRowsFieldInfo = (~) Int32
    type AttrTransferTypeConstraint WorkspaceLayoutRowsFieldInfo = (~)Int32
    type AttrTransferType WorkspaceLayoutRowsFieldInfo = Int32
    type AttrGetType WorkspaceLayoutRowsFieldInfo = Int32
    type AttrLabel WorkspaceLayoutRowsFieldInfo = "rows"
    type AttrOrigin WorkspaceLayoutRowsFieldInfo = WorkspaceLayout
    attrGet = getWorkspaceLayoutRows
    attrSet = setWorkspaceLayoutRows
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

workspaceLayout_rows :: AttrLabelProxy "rows"
workspaceLayout_rows = AttrLabelProxy

#endif


-- | Get the value of the “@cols@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' workspaceLayout #cols
-- @
getWorkspaceLayoutCols :: MonadIO m => WorkspaceLayout -> m Int32
getWorkspaceLayoutCols :: WorkspaceLayout -> m Int32
getWorkspaceLayoutCols s :: WorkspaceLayout
s = 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
$ WorkspaceLayout -> (Ptr WorkspaceLayout -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr WorkspaceLayout
s ((Ptr WorkspaceLayout -> IO Int32) -> IO Int32)
-> (Ptr WorkspaceLayout -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr WorkspaceLayout
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr WorkspaceLayout
ptr Ptr WorkspaceLayout -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

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

#if defined(ENABLE_OVERLOADING)
data WorkspaceLayoutColsFieldInfo
instance AttrInfo WorkspaceLayoutColsFieldInfo where
    type AttrBaseTypeConstraint WorkspaceLayoutColsFieldInfo = (~) WorkspaceLayout
    type AttrAllowedOps WorkspaceLayoutColsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint WorkspaceLayoutColsFieldInfo = (~) Int32
    type AttrTransferTypeConstraint WorkspaceLayoutColsFieldInfo = (~)Int32
    type AttrTransferType WorkspaceLayoutColsFieldInfo = Int32
    type AttrGetType WorkspaceLayoutColsFieldInfo = Int32
    type AttrLabel WorkspaceLayoutColsFieldInfo = "cols"
    type AttrOrigin WorkspaceLayoutColsFieldInfo = WorkspaceLayout
    attrGet = getWorkspaceLayoutCols
    attrSet = setWorkspaceLayoutCols
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

workspaceLayout_cols :: AttrLabelProxy "cols"
workspaceLayout_cols = AttrLabelProxy

#endif


-- | Get the value of the “@grid@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' workspaceLayout #grid
-- @
getWorkspaceLayoutGrid :: MonadIO m => WorkspaceLayout -> m Int32
getWorkspaceLayoutGrid :: WorkspaceLayout -> m Int32
getWorkspaceLayoutGrid s :: WorkspaceLayout
s = 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
$ WorkspaceLayout -> (Ptr WorkspaceLayout -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr WorkspaceLayout
s ((Ptr WorkspaceLayout -> IO Int32) -> IO Int32)
-> (Ptr WorkspaceLayout -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr WorkspaceLayout
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr WorkspaceLayout
ptr Ptr WorkspaceLayout -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

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

#if defined(ENABLE_OVERLOADING)
data WorkspaceLayoutGridFieldInfo
instance AttrInfo WorkspaceLayoutGridFieldInfo where
    type AttrBaseTypeConstraint WorkspaceLayoutGridFieldInfo = (~) WorkspaceLayout
    type AttrAllowedOps WorkspaceLayoutGridFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint WorkspaceLayoutGridFieldInfo = (~) Int32
    type AttrTransferTypeConstraint WorkspaceLayoutGridFieldInfo = (~)Int32
    type AttrTransferType WorkspaceLayoutGridFieldInfo = Int32
    type AttrGetType WorkspaceLayoutGridFieldInfo = Int32
    type AttrLabel WorkspaceLayoutGridFieldInfo = "grid"
    type AttrOrigin WorkspaceLayoutGridFieldInfo = WorkspaceLayout
    attrGet = getWorkspaceLayoutGrid
    attrSet = setWorkspaceLayoutGrid
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

workspaceLayout_grid :: AttrLabelProxy "grid"
workspaceLayout_grid = AttrLabelProxy

#endif


-- | Get the value of the “@grid_area@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' workspaceLayout #gridArea
-- @
getWorkspaceLayoutGridArea :: MonadIO m => WorkspaceLayout -> m Int32
getWorkspaceLayoutGridArea :: WorkspaceLayout -> m Int32
getWorkspaceLayoutGridArea s :: WorkspaceLayout
s = 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
$ WorkspaceLayout -> (Ptr WorkspaceLayout -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr WorkspaceLayout
s ((Ptr WorkspaceLayout -> IO Int32) -> IO Int32)
-> (Ptr WorkspaceLayout -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr WorkspaceLayout
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr WorkspaceLayout
ptr Ptr WorkspaceLayout -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

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

#if defined(ENABLE_OVERLOADING)
data WorkspaceLayoutGridAreaFieldInfo
instance AttrInfo WorkspaceLayoutGridAreaFieldInfo where
    type AttrBaseTypeConstraint WorkspaceLayoutGridAreaFieldInfo = (~) WorkspaceLayout
    type AttrAllowedOps WorkspaceLayoutGridAreaFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint WorkspaceLayoutGridAreaFieldInfo = (~) Int32
    type AttrTransferTypeConstraint WorkspaceLayoutGridAreaFieldInfo = (~)Int32
    type AttrTransferType WorkspaceLayoutGridAreaFieldInfo = Int32
    type AttrGetType WorkspaceLayoutGridAreaFieldInfo = Int32
    type AttrLabel WorkspaceLayoutGridAreaFieldInfo = "grid_area"
    type AttrOrigin WorkspaceLayoutGridAreaFieldInfo = WorkspaceLayout
    attrGet = getWorkspaceLayoutGridArea
    attrSet = setWorkspaceLayoutGridArea
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

workspaceLayout_gridArea :: AttrLabelProxy "gridArea"
workspaceLayout_gridArea = AttrLabelProxy

#endif


-- | Get the value of the “@current_row@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' workspaceLayout #currentRow
-- @
getWorkspaceLayoutCurrentRow :: MonadIO m => WorkspaceLayout -> m Int32
getWorkspaceLayoutCurrentRow :: WorkspaceLayout -> m Int32
getWorkspaceLayoutCurrentRow s :: WorkspaceLayout
s = 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
$ WorkspaceLayout -> (Ptr WorkspaceLayout -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr WorkspaceLayout
s ((Ptr WorkspaceLayout -> IO Int32) -> IO Int32)
-> (Ptr WorkspaceLayout -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr WorkspaceLayout
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr WorkspaceLayout
ptr Ptr WorkspaceLayout -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

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

#if defined(ENABLE_OVERLOADING)
data WorkspaceLayoutCurrentRowFieldInfo
instance AttrInfo WorkspaceLayoutCurrentRowFieldInfo where
    type AttrBaseTypeConstraint WorkspaceLayoutCurrentRowFieldInfo = (~) WorkspaceLayout
    type AttrAllowedOps WorkspaceLayoutCurrentRowFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint WorkspaceLayoutCurrentRowFieldInfo = (~) Int32
    type AttrTransferTypeConstraint WorkspaceLayoutCurrentRowFieldInfo = (~)Int32
    type AttrTransferType WorkspaceLayoutCurrentRowFieldInfo = Int32
    type AttrGetType WorkspaceLayoutCurrentRowFieldInfo = Int32
    type AttrLabel WorkspaceLayoutCurrentRowFieldInfo = "current_row"
    type AttrOrigin WorkspaceLayoutCurrentRowFieldInfo = WorkspaceLayout
    attrGet = getWorkspaceLayoutCurrentRow
    attrSet = setWorkspaceLayoutCurrentRow
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

workspaceLayout_currentRow :: AttrLabelProxy "currentRow"
workspaceLayout_currentRow = AttrLabelProxy

#endif


-- | Get the value of the “@current_col@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' workspaceLayout #currentCol
-- @
getWorkspaceLayoutCurrentCol :: MonadIO m => WorkspaceLayout -> m Int32
getWorkspaceLayoutCurrentCol :: WorkspaceLayout -> m Int32
getWorkspaceLayoutCurrentCol s :: WorkspaceLayout
s = 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
$ WorkspaceLayout -> (Ptr WorkspaceLayout -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr WorkspaceLayout
s ((Ptr WorkspaceLayout -> IO Int32) -> IO Int32)
-> (Ptr WorkspaceLayout -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr WorkspaceLayout
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr WorkspaceLayout
ptr Ptr WorkspaceLayout -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

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

#if defined(ENABLE_OVERLOADING)
data WorkspaceLayoutCurrentColFieldInfo
instance AttrInfo WorkspaceLayoutCurrentColFieldInfo where
    type AttrBaseTypeConstraint WorkspaceLayoutCurrentColFieldInfo = (~) WorkspaceLayout
    type AttrAllowedOps WorkspaceLayoutCurrentColFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint WorkspaceLayoutCurrentColFieldInfo = (~) Int32
    type AttrTransferTypeConstraint WorkspaceLayoutCurrentColFieldInfo = (~)Int32
    type AttrTransferType WorkspaceLayoutCurrentColFieldInfo = Int32
    type AttrGetType WorkspaceLayoutCurrentColFieldInfo = Int32
    type AttrLabel WorkspaceLayoutCurrentColFieldInfo = "current_col"
    type AttrOrigin WorkspaceLayoutCurrentColFieldInfo = WorkspaceLayout
    attrGet = getWorkspaceLayoutCurrentCol
    attrSet = setWorkspaceLayoutCurrentCol
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

workspaceLayout_currentCol :: AttrLabelProxy "currentCol"
workspaceLayout_currentCol = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList WorkspaceLayout
type instance O.AttributeList WorkspaceLayout = WorkspaceLayoutAttributeList
type WorkspaceLayoutAttributeList = ('[ '("rows", WorkspaceLayoutRowsFieldInfo), '("cols", WorkspaceLayoutColsFieldInfo), '("grid", WorkspaceLayoutGridFieldInfo), '("gridArea", WorkspaceLayoutGridAreaFieldInfo), '("currentRow", WorkspaceLayoutCurrentRowFieldInfo), '("currentCol", WorkspaceLayoutCurrentColFieldInfo)] :: [(Symbol, *)])
#endif

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

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

#endif