{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gtk.Structs.CssLocation.CssLocation' is used to present a location in a file - or other
-- source of data parsed by the CSS engine.
-- 
-- The /@bytes@/ and /@lineBytes@/ offsets are meant to be used to
-- programmatically match data. The /@lines@/ and /@lineChars@/ offsets
-- can be used for printing the location in a file.
-- 
-- Note that the /@lines@/ parameter starts from 0 and is increased
-- whenever a CSS line break is encountered. (CSS defines the C character
-- sequences \"\\r\\n\", \"\\r\", \"\\n\" and \"\\f\" as newlines.)
-- If your document uses different rules for line breaking, you might want
-- run into problems here.

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

module GI.Gtk.Structs.CssLocation
    ( 

-- * Exported types
    CssLocation(..)                         ,
    newZeroCssLocation                      ,


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolveCssLocationMethod                ,
#endif



 -- * Properties


-- ** bytes #attr:bytes#
-- | number of bytes parsed since the beginning

#if defined(ENABLE_OVERLOADING)
    cssLocation_bytes                       ,
#endif
    getCssLocationBytes                     ,
    setCssLocationBytes                     ,


-- ** chars #attr:chars#
-- | number of characters parsed since the beginning

#if defined(ENABLE_OVERLOADING)
    cssLocation_chars                       ,
#endif
    getCssLocationChars                     ,
    setCssLocationChars                     ,


-- ** lineBytes #attr:lineBytes#
-- | Number of bytes parsed since the last line break

#if defined(ENABLE_OVERLOADING)
    cssLocation_lineBytes                   ,
#endif
    getCssLocationLineBytes                 ,
    setCssLocationLineBytes                 ,


-- ** lineChars #attr:lineChars#
-- | Number of characters parsed since the last line
--     break

#if defined(ENABLE_OVERLOADING)
    cssLocation_lineChars                   ,
#endif
    getCssLocationLineChars                 ,
    setCssLocationLineChars                 ,


-- ** lines #attr:lines#
-- | number of full lines that have been parsed
--     If you want to display this as a line number, you
--     need to add 1 to this.

#if defined(ENABLE_OVERLOADING)
    cssLocation_lines                       ,
#endif
    getCssLocationLines                     ,
    setCssLocationLines                     ,




    ) 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 CssLocation = CssLocation (SP.ManagedPtr CssLocation)
    deriving (CssLocation -> CssLocation -> Bool
(CssLocation -> CssLocation -> Bool)
-> (CssLocation -> CssLocation -> Bool) -> Eq CssLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CssLocation -> CssLocation -> Bool
$c/= :: CssLocation -> CssLocation -> Bool
== :: CssLocation -> CssLocation -> Bool
$c== :: CssLocation -> CssLocation -> Bool
Eq)

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

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


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

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


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

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

#if defined(ENABLE_OVERLOADING)
data CssLocationBytesFieldInfo
instance AttrInfo CssLocationBytesFieldInfo where
    type AttrBaseTypeConstraint CssLocationBytesFieldInfo = (~) CssLocation
    type AttrAllowedOps CssLocationBytesFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint CssLocationBytesFieldInfo = (~) Word64
    type AttrTransferTypeConstraint CssLocationBytesFieldInfo = (~)Word64
    type AttrTransferType CssLocationBytesFieldInfo = Word64
    type AttrGetType CssLocationBytesFieldInfo = Word64
    type AttrLabel CssLocationBytesFieldInfo = "bytes"
    type AttrOrigin CssLocationBytesFieldInfo = CssLocation
    attrGet = getCssLocationBytes
    attrSet = setCssLocationBytes
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

cssLocation_bytes :: AttrLabelProxy "bytes"
cssLocation_bytes = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data CssLocationCharsFieldInfo
instance AttrInfo CssLocationCharsFieldInfo where
    type AttrBaseTypeConstraint CssLocationCharsFieldInfo = (~) CssLocation
    type AttrAllowedOps CssLocationCharsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint CssLocationCharsFieldInfo = (~) Word64
    type AttrTransferTypeConstraint CssLocationCharsFieldInfo = (~)Word64
    type AttrTransferType CssLocationCharsFieldInfo = Word64
    type AttrGetType CssLocationCharsFieldInfo = Word64
    type AttrLabel CssLocationCharsFieldInfo = "chars"
    type AttrOrigin CssLocationCharsFieldInfo = CssLocation
    attrGet = getCssLocationChars
    attrSet = setCssLocationChars
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

cssLocation_chars :: AttrLabelProxy "chars"
cssLocation_chars = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data CssLocationLinesFieldInfo
instance AttrInfo CssLocationLinesFieldInfo where
    type AttrBaseTypeConstraint CssLocationLinesFieldInfo = (~) CssLocation
    type AttrAllowedOps CssLocationLinesFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint CssLocationLinesFieldInfo = (~) Word64
    type AttrTransferTypeConstraint CssLocationLinesFieldInfo = (~)Word64
    type AttrTransferType CssLocationLinesFieldInfo = Word64
    type AttrGetType CssLocationLinesFieldInfo = Word64
    type AttrLabel CssLocationLinesFieldInfo = "lines"
    type AttrOrigin CssLocationLinesFieldInfo = CssLocation
    attrGet = getCssLocationLines
    attrSet = setCssLocationLines
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

cssLocation_lines :: AttrLabelProxy "lines"
cssLocation_lines = AttrLabelProxy

#endif


-- | Get the value of the “@line_bytes@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' cssLocation #lineBytes
-- @
getCssLocationLineBytes :: MonadIO m => CssLocation -> m Word64
getCssLocationLineBytes :: forall (m :: * -> *). MonadIO m => CssLocation -> m Word64
getCssLocationLineBytes CssLocation
s = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ CssLocation -> (Ptr CssLocation -> IO Word64) -> IO Word64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr CssLocation
s ((Ptr CssLocation -> IO Word64) -> IO Word64)
-> (Ptr CssLocation -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \Ptr CssLocation
ptr -> do
    Word64
val <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr CssLocation
ptr Ptr CssLocation -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO Word64
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
val

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

#if defined(ENABLE_OVERLOADING)
data CssLocationLineBytesFieldInfo
instance AttrInfo CssLocationLineBytesFieldInfo where
    type AttrBaseTypeConstraint CssLocationLineBytesFieldInfo = (~) CssLocation
    type AttrAllowedOps CssLocationLineBytesFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint CssLocationLineBytesFieldInfo = (~) Word64
    type AttrTransferTypeConstraint CssLocationLineBytesFieldInfo = (~)Word64
    type AttrTransferType CssLocationLineBytesFieldInfo = Word64
    type AttrGetType CssLocationLineBytesFieldInfo = Word64
    type AttrLabel CssLocationLineBytesFieldInfo = "line_bytes"
    type AttrOrigin CssLocationLineBytesFieldInfo = CssLocation
    attrGet = getCssLocationLineBytes
    attrSet = setCssLocationLineBytes
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

cssLocation_lineBytes :: AttrLabelProxy "lineBytes"
cssLocation_lineBytes = AttrLabelProxy

#endif


-- | Get the value of the “@line_chars@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' cssLocation #lineChars
-- @
getCssLocationLineChars :: MonadIO m => CssLocation -> m Word64
getCssLocationLineChars :: forall (m :: * -> *). MonadIO m => CssLocation -> m Word64
getCssLocationLineChars CssLocation
s = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ CssLocation -> (Ptr CssLocation -> IO Word64) -> IO Word64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr CssLocation
s ((Ptr CssLocation -> IO Word64) -> IO Word64)
-> (Ptr CssLocation -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \Ptr CssLocation
ptr -> do
    Word64
val <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr CssLocation
ptr Ptr CssLocation -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) :: IO Word64
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
val

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

#if defined(ENABLE_OVERLOADING)
data CssLocationLineCharsFieldInfo
instance AttrInfo CssLocationLineCharsFieldInfo where
    type AttrBaseTypeConstraint CssLocationLineCharsFieldInfo = (~) CssLocation
    type AttrAllowedOps CssLocationLineCharsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint CssLocationLineCharsFieldInfo = (~) Word64
    type AttrTransferTypeConstraint CssLocationLineCharsFieldInfo = (~)Word64
    type AttrTransferType CssLocationLineCharsFieldInfo = Word64
    type AttrGetType CssLocationLineCharsFieldInfo = Word64
    type AttrLabel CssLocationLineCharsFieldInfo = "line_chars"
    type AttrOrigin CssLocationLineCharsFieldInfo = CssLocation
    attrGet = getCssLocationLineChars
    attrSet = setCssLocationLineChars
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

cssLocation_lineChars :: AttrLabelProxy "lineChars"
cssLocation_lineChars = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList CssLocation
type instance O.AttributeList CssLocation = CssLocationAttributeList
type CssLocationAttributeList = ('[ '("bytes", CssLocationBytesFieldInfo), '("chars", CssLocationCharsFieldInfo), '("lines", CssLocationLinesFieldInfo), '("lineBytes", CssLocationLineBytesFieldInfo), '("lineChars", CssLocationLineCharsFieldInfo)] :: [(Symbol, *)])
#endif

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

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

#endif

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

#endif