{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Defines a part of a CSS document.
-- 
-- Because sections are nested into one another, you can use
-- [method/@cssSection@/.get_parent] to get the containing region.

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

module GI.Gtk.Structs.CssSection
    ( 

-- * Exported types
    CssSection(..)                          ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [print]("GI.Gtk.Structs.CssSection#g:method:print"), [ref]("GI.Gtk.Structs.CssSection#g:method:ref"), [toString]("GI.Gtk.Structs.CssSection#g:method:toString"), [unref]("GI.Gtk.Structs.CssSection#g:method:unref").
-- 
-- ==== Getters
-- [getBytes]("GI.Gtk.Structs.CssSection#g:method:getBytes"), [getEndLocation]("GI.Gtk.Structs.CssSection#g:method:getEndLocation"), [getFile]("GI.Gtk.Structs.CssSection#g:method:getFile"), [getParent]("GI.Gtk.Structs.CssSection#g:method:getParent"), [getStartLocation]("GI.Gtk.Structs.CssSection#g:method:getStartLocation").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveCssSectionMethod                 ,
#endif

-- ** getBytes #method:getBytes#

#if defined(ENABLE_OVERLOADING)
    CssSectionGetBytesMethodInfo            ,
#endif
    cssSectionGetBytes                      ,


-- ** getEndLocation #method:getEndLocation#

#if defined(ENABLE_OVERLOADING)
    CssSectionGetEndLocationMethodInfo      ,
#endif
    cssSectionGetEndLocation                ,


-- ** getFile #method:getFile#

#if defined(ENABLE_OVERLOADING)
    CssSectionGetFileMethodInfo             ,
#endif
    cssSectionGetFile                       ,


-- ** getParent #method:getParent#

#if defined(ENABLE_OVERLOADING)
    CssSectionGetParentMethodInfo           ,
#endif
    cssSectionGetParent                     ,


-- ** getStartLocation #method:getStartLocation#

#if defined(ENABLE_OVERLOADING)
    CssSectionGetStartLocationMethodInfo    ,
#endif
    cssSectionGetStartLocation              ,


-- ** new #method:new#

    cssSectionNew                           ,


-- ** newWithBytes #method:newWithBytes#

    cssSectionNewWithBytes                  ,


-- ** print #method:print#

#if defined(ENABLE_OVERLOADING)
    CssSectionPrintMethodInfo               ,
#endif
    cssSectionPrint                         ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    CssSectionRefMethodInfo                 ,
#endif
    cssSectionRef                           ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    CssSectionToStringMethodInfo            ,
#endif
    cssSectionToString                      ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    CssSectionUnrefMethodInfo               ,
#endif
    cssSectionUnref                         ,




    ) 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.GHashTable as B.GHT
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.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
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
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GLib.Structs.String as GLib.String
import qualified GI.Gio.Interfaces.File as Gio.File
import {-# SOURCE #-} qualified GI.Gtk.Structs.CssLocation as Gtk.CssLocation

#else
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GLib.Structs.String as GLib.String
import qualified GI.Gio.Interfaces.File as Gio.File
import {-# SOURCE #-} qualified GI.Gtk.Structs.CssLocation as Gtk.CssLocation

#endif

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

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

foreign import ccall "gtk_css_section_get_type" c_gtk_css_section_get_type :: 
    IO GType

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

instance B.Types.TypedObject CssSection where
    glibType :: IO GType
glibType = IO GType
c_gtk_css_section_get_type

instance B.Types.GBoxed CssSection

-- | Convert t'CssSection' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe CssSection) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_css_section_get_type
    gvalueSet_ :: Ptr GValue -> Maybe CssSection -> IO ()
gvalueSet_ Ptr GValue
gv Maybe CssSection
P.Nothing = Ptr GValue -> Ptr CssSection -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr CssSection
forall a. Ptr a
FP.nullPtr :: FP.Ptr CssSection)
    gvalueSet_ Ptr GValue
gv (P.Just CssSection
obj) = CssSection -> (Ptr CssSection -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr CssSection
obj (Ptr GValue -> Ptr CssSection -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe CssSection)
gvalueGet_ Ptr GValue
gv = do
        ptr <- Ptr GValue -> IO (Ptr CssSection)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr CssSection)
        if ptr /= FP.nullPtr
        then P.Just <$> B.ManagedPtr.newBoxed CssSection ptr
        else return P.Nothing
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList CssSection
type instance O.AttributeList CssSection = CssSectionAttributeList
type CssSectionAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

-- method CssSection::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The file this section refers to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "CssLocation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The start location" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "end"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "CssLocation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The end location" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "CssSection" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_css_section_new" gtk_css_section_new :: 
    Ptr Gio.File.File ->                    -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gtk.CssLocation.CssLocation ->      -- start : TInterface (Name {namespace = "Gtk", name = "CssLocation"})
    Ptr Gtk.CssLocation.CssLocation ->      -- end : TInterface (Name {namespace = "Gtk", name = "CssLocation"})
    IO (Ptr CssSection)

-- | Creates a new @GtkCssSection@ referring to the section
-- in the given @file@ from the @start@ location to the
-- @end@ location.
cssSectionNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.File.IsFile a) =>
    Maybe (a)
    -- ^ /@file@/: The file this section refers to
    -> Gtk.CssLocation.CssLocation
    -- ^ /@start@/: The start location
    -> Gtk.CssLocation.CssLocation
    -- ^ /@end@/: The end location
    -> m CssSection
    -- ^ __Returns:__ a new @GtkCssSection@
cssSectionNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
Maybe a -> CssLocation -> CssLocation -> m CssSection
cssSectionNew Maybe a
file CssLocation
start CssLocation
end = IO CssSection -> m CssSection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CssSection -> m CssSection) -> IO CssSection -> m CssSection
forall a b. (a -> b) -> a -> b
$ do
    maybeFile <- case Maybe a
file of
        Maybe a
Nothing -> Ptr File -> IO (Ptr File)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
forall a. Ptr a
FP.nullPtr
        Just a
jFile -> do
            jFile' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jFile
            return jFile'
    start' <- unsafeManagedPtrGetPtr start
    end' <- unsafeManagedPtrGetPtr end
    result <- gtk_css_section_new maybeFile start' end'
    checkUnexpectedReturnNULL "cssSectionNew" result
    result' <- (wrapBoxed CssSection) result
    whenJust file touchManagedPtr
    touchManagedPtr start
    touchManagedPtr end
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method CssSection::new_with_bytes
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The file this section refers to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bytes"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The bytes this sections refers to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "CssLocation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The start location" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "end"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "CssLocation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The end location" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "CssSection" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_css_section_new_with_bytes" gtk_css_section_new_with_bytes :: 
    Ptr Gio.File.File ->                    -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr GLib.Bytes.Bytes ->                 -- bytes : TInterface (Name {namespace = "GLib", name = "Bytes"})
    Ptr Gtk.CssLocation.CssLocation ->      -- start : TInterface (Name {namespace = "Gtk", name = "CssLocation"})
    Ptr Gtk.CssLocation.CssLocation ->      -- end : TInterface (Name {namespace = "Gtk", name = "CssLocation"})
    IO (Ptr CssSection)

-- | Creates a new @GtkCssSection@ referring to the section
-- in the given @file@ or the given @bytes@ from the @start@ location to the
-- @end@ location.
-- 
-- /Since: 4.16/
cssSectionNewWithBytes ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.File.IsFile a) =>
    Maybe (a)
    -- ^ /@file@/: The file this section refers to
    -> Maybe (GLib.Bytes.Bytes)
    -- ^ /@bytes@/: The bytes this sections refers to
    -> Gtk.CssLocation.CssLocation
    -- ^ /@start@/: The start location
    -> Gtk.CssLocation.CssLocation
    -- ^ /@end@/: The end location
    -> m CssSection
    -- ^ __Returns:__ a new @GtkCssSection@
cssSectionNewWithBytes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
Maybe a
-> Maybe Bytes -> CssLocation -> CssLocation -> m CssSection
cssSectionNewWithBytes Maybe a
file Maybe Bytes
bytes CssLocation
start CssLocation
end = IO CssSection -> m CssSection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CssSection -> m CssSection) -> IO CssSection -> m CssSection
forall a b. (a -> b) -> a -> b
$ do
    maybeFile <- case Maybe a
file of
        Maybe a
Nothing -> Ptr File -> IO (Ptr File)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
forall a. Ptr a
FP.nullPtr
        Just a
jFile -> do
            jFile' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jFile
            return jFile'
    maybeBytes <- case bytes of
        Maybe Bytes
Nothing -> Ptr Bytes -> IO (Ptr Bytes)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Bytes
forall a. Ptr a
FP.nullPtr
        Just Bytes
jBytes -> do
            jBytes' <- Bytes -> IO (Ptr Bytes)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bytes
jBytes
            return jBytes'
    start' <- unsafeManagedPtrGetPtr start
    end' <- unsafeManagedPtrGetPtr end
    result <- gtk_css_section_new_with_bytes maybeFile maybeBytes start' end'
    checkUnexpectedReturnNULL "cssSectionNewWithBytes" result
    result' <- (wrapBoxed CssSection) result
    whenJust file touchManagedPtr
    whenJust bytes touchManagedPtr
    touchManagedPtr start
    touchManagedPtr end
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method CssSection::get_bytes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "section"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "CssSection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the section" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "Bytes" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_css_section_get_bytes" gtk_css_section_get_bytes :: 
    Ptr CssSection ->                       -- section : TInterface (Name {namespace = "Gtk", name = "CssSection"})
    IO (Ptr GLib.Bytes.Bytes)

-- | Gets the bytes that /@section@/ was parsed from.
-- 
-- /Since: 4.16/
cssSectionGetBytes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CssSection
    -- ^ /@section@/: the section
    -> m (Maybe GLib.Bytes.Bytes)
    -- ^ __Returns:__ the @GBytes@ from which the @section@
    --   was parsed
cssSectionGetBytes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
CssSection -> m (Maybe Bytes)
cssSectionGetBytes CssSection
section = IO (Maybe Bytes) -> m (Maybe Bytes)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Bytes) -> m (Maybe Bytes))
-> IO (Maybe Bytes) -> m (Maybe Bytes)
forall a b. (a -> b) -> a -> b
$ do
    section' <- CssSection -> IO (Ptr CssSection)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CssSection
section
    result <- gtk_css_section_get_bytes section'
    maybeResult <- convertIfNonNull result $ \Ptr Bytes
result' -> do
        result'' <- ((ManagedPtr Bytes -> Bytes) -> Ptr Bytes -> IO Bytes
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Bytes -> Bytes
GLib.Bytes.Bytes) Ptr Bytes
result'
        return result''
    touchManagedPtr section
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data CssSectionGetBytesMethodInfo
instance (signature ~ (m (Maybe GLib.Bytes.Bytes)), MonadIO m) => O.OverloadedMethod CssSectionGetBytesMethodInfo CssSection signature where
    overloadedMethod = cssSectionGetBytes

instance O.OverloadedMethodInfo CssSectionGetBytesMethodInfo CssSection where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.CssSection.cssSectionGetBytes",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Structs-CssSection.html#v:cssSectionGetBytes"
        })


#endif

-- method CssSection::get_end_location
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "section"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "CssSection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the section" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "CssLocation" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_css_section_get_end_location" gtk_css_section_get_end_location :: 
    Ptr CssSection ->                       -- section : TInterface (Name {namespace = "Gtk", name = "CssSection"})
    IO (Ptr Gtk.CssLocation.CssLocation)

-- | Returns the location in the CSS document where this section ends.
cssSectionGetEndLocation ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CssSection
    -- ^ /@section@/: the section
    -> m Gtk.CssLocation.CssLocation
    -- ^ __Returns:__ The end location of
    --   this section
cssSectionGetEndLocation :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
CssSection -> m CssLocation
cssSectionGetEndLocation CssSection
section = IO CssLocation -> m CssLocation
forall a. IO a -> m a
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
$ do
    section' <- CssSection -> IO (Ptr CssSection)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CssSection
section
    result <- gtk_css_section_get_end_location section'
    checkUnexpectedReturnNULL "cssSectionGetEndLocation" result
    result' <- (newPtr Gtk.CssLocation.CssLocation) result
    touchManagedPtr section
    return result'

#if defined(ENABLE_OVERLOADING)
data CssSectionGetEndLocationMethodInfo
instance (signature ~ (m Gtk.CssLocation.CssLocation), MonadIO m) => O.OverloadedMethod CssSectionGetEndLocationMethodInfo CssSection signature where
    overloadedMethod = cssSectionGetEndLocation

instance O.OverloadedMethodInfo CssSectionGetEndLocationMethodInfo CssSection where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.CssSection.cssSectionGetEndLocation",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Structs-CssSection.html#v:cssSectionGetEndLocation"
        })


#endif

-- method CssSection::get_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "section"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "CssSection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the section" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "File" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_css_section_get_file" gtk_css_section_get_file :: 
    Ptr CssSection ->                       -- section : TInterface (Name {namespace = "Gtk", name = "CssSection"})
    IO (Ptr Gio.File.File)

-- | Gets the file that /@section@/ was parsed from.
-- 
-- If no such file exists, for example because the CSS was loaded via
-- 'GI.Gtk.Objects.CssProvider.cssProviderLoadFromData', then @NULL@ is returned.
cssSectionGetFile ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CssSection
    -- ^ /@section@/: the section
    -> m (Maybe Gio.File.File)
    -- ^ __Returns:__ the @GFile@ from which the @section@
    --   was parsed
cssSectionGetFile :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
CssSection -> m (Maybe File)
cssSectionGetFile CssSection
section = IO (Maybe File) -> m (Maybe File)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe File) -> m (Maybe File))
-> IO (Maybe File) -> m (Maybe File)
forall a b. (a -> b) -> a -> b
$ do
    section' <- CssSection -> IO (Ptr CssSection)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CssSection
section
    result <- gtk_css_section_get_file section'
    maybeResult <- convertIfNonNull result $ \Ptr File
result' -> do
        result'' <- ((ManagedPtr File -> File) -> Ptr File -> IO File
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr File -> File
Gio.File.File) Ptr File
result'
        return result''
    touchManagedPtr section
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data CssSectionGetFileMethodInfo
instance (signature ~ (m (Maybe Gio.File.File)), MonadIO m) => O.OverloadedMethod CssSectionGetFileMethodInfo CssSection signature where
    overloadedMethod = cssSectionGetFile

instance O.OverloadedMethodInfo CssSectionGetFileMethodInfo CssSection where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.CssSection.cssSectionGetFile",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Structs-CssSection.html#v:cssSectionGetFile"
        })


#endif

-- method CssSection::get_parent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "section"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "CssSection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the section" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "CssSection" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_css_section_get_parent" gtk_css_section_get_parent :: 
    Ptr CssSection ->                       -- section : TInterface (Name {namespace = "Gtk", name = "CssSection"})
    IO (Ptr CssSection)

-- | Gets the parent section for the given @section@.
-- 
-- The parent section is the section that contains this @section@. A special
-- case are sections of  type @GTK_CSS_SECTION_DOCUMENT@. Their parent will
-- either be @NULL@ if they are the original CSS document that was loaded by
-- 'GI.Gtk.Objects.CssProvider.cssProviderLoadFromFile' or a section of type
-- @GTK_CSS_SECTION_IMPORT@ if it was loaded with an @\@import@ rule from
-- a different file.
cssSectionGetParent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CssSection
    -- ^ /@section@/: the section
    -> m (Maybe CssSection)
    -- ^ __Returns:__ the parent section
cssSectionGetParent :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
CssSection -> m (Maybe CssSection)
cssSectionGetParent CssSection
section = IO (Maybe CssSection) -> m (Maybe CssSection)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe CssSection) -> m (Maybe CssSection))
-> IO (Maybe CssSection) -> m (Maybe CssSection)
forall a b. (a -> b) -> a -> b
$ do
    section' <- CssSection -> IO (Ptr CssSection)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CssSection
section
    result <- gtk_css_section_get_parent section'
    maybeResult <- convertIfNonNull result $ \Ptr CssSection
result' -> do
        result'' <- ((ManagedPtr CssSection -> CssSection)
-> Ptr CssSection -> IO CssSection
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr CssSection -> CssSection
CssSection) Ptr CssSection
result'
        return result''
    touchManagedPtr section
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data CssSectionGetParentMethodInfo
instance (signature ~ (m (Maybe CssSection)), MonadIO m) => O.OverloadedMethod CssSectionGetParentMethodInfo CssSection signature where
    overloadedMethod = cssSectionGetParent

instance O.OverloadedMethodInfo CssSectionGetParentMethodInfo CssSection where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.CssSection.cssSectionGetParent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Structs-CssSection.html#v:cssSectionGetParent"
        })


#endif

-- method CssSection::get_start_location
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "section"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "CssSection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the section" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "CssLocation" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_css_section_get_start_location" gtk_css_section_get_start_location :: 
    Ptr CssSection ->                       -- section : TInterface (Name {namespace = "Gtk", name = "CssSection"})
    IO (Ptr Gtk.CssLocation.CssLocation)

-- | Returns the location in the CSS document where this section starts.
cssSectionGetStartLocation ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CssSection
    -- ^ /@section@/: the section
    -> m Gtk.CssLocation.CssLocation
    -- ^ __Returns:__ The start location of
    --   this section
cssSectionGetStartLocation :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
CssSection -> m CssLocation
cssSectionGetStartLocation CssSection
section = IO CssLocation -> m CssLocation
forall a. IO a -> m a
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
$ do
    section' <- CssSection -> IO (Ptr CssSection)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CssSection
section
    result <- gtk_css_section_get_start_location section'
    checkUnexpectedReturnNULL "cssSectionGetStartLocation" result
    result' <- (newPtr Gtk.CssLocation.CssLocation) result
    touchManagedPtr section
    return result'

#if defined(ENABLE_OVERLOADING)
data CssSectionGetStartLocationMethodInfo
instance (signature ~ (m Gtk.CssLocation.CssLocation), MonadIO m) => O.OverloadedMethod CssSectionGetStartLocationMethodInfo CssSection signature where
    overloadedMethod = cssSectionGetStartLocation

instance O.OverloadedMethodInfo CssSectionGetStartLocationMethodInfo CssSection where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.CssSection.cssSectionGetStartLocation",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Structs-CssSection.html#v:cssSectionGetStartLocation"
        })


#endif

-- method CssSection::print
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "section"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "CssSection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a section" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "string"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "String" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GString` to print to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_css_section_print" gtk_css_section_print :: 
    Ptr CssSection ->                       -- section : TInterface (Name {namespace = "Gtk", name = "CssSection"})
    Ptr GLib.String.String ->               -- string : TInterface (Name {namespace = "GLib", name = "String"})
    IO ()

-- | Prints the @section@ into @string@ in a human-readable form.
-- 
-- This is a form like @gtk.css:32:1-23@ to denote line 32, characters
-- 1 to 23 in the file @gtk.css@.
cssSectionPrint ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CssSection
    -- ^ /@section@/: a section
    -> GLib.String.String
    -- ^ /@string@/: a @GString@ to print to
    -> m ()
cssSectionPrint :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
CssSection -> String -> m ()
cssSectionPrint CssSection
section String
string = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    section' <- CssSection -> IO (Ptr CssSection)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CssSection
section
    string' <- unsafeManagedPtrGetPtr string
    gtk_css_section_print section' string'
    touchManagedPtr section
    touchManagedPtr string
    return ()

#if defined(ENABLE_OVERLOADING)
data CssSectionPrintMethodInfo
instance (signature ~ (GLib.String.String -> m ()), MonadIO m) => O.OverloadedMethod CssSectionPrintMethodInfo CssSection signature where
    overloadedMethod = cssSectionPrint

instance O.OverloadedMethodInfo CssSectionPrintMethodInfo CssSection where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.CssSection.cssSectionPrint",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Structs-CssSection.html#v:cssSectionPrint"
        })


#endif

-- method CssSection::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "section"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "CssSection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkCssSection`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "CssSection" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_css_section_ref" gtk_css_section_ref :: 
    Ptr CssSection ->                       -- section : TInterface (Name {namespace = "Gtk", name = "CssSection"})
    IO (Ptr CssSection)

-- | Increments the reference count on @section@.
cssSectionRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CssSection
    -- ^ /@section@/: a @GtkCssSection@
    -> m CssSection
    -- ^ __Returns:__ the CSS section itself.
cssSectionRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
CssSection -> m CssSection
cssSectionRef CssSection
section = IO CssSection -> m CssSection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CssSection -> m CssSection) -> IO CssSection -> m CssSection
forall a b. (a -> b) -> a -> b
$ do
    section' <- CssSection -> IO (Ptr CssSection)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CssSection
section
    result <- gtk_css_section_ref section'
    checkUnexpectedReturnNULL "cssSectionRef" result
    result' <- (wrapBoxed CssSection) result
    touchManagedPtr section
    return result'

#if defined(ENABLE_OVERLOADING)
data CssSectionRefMethodInfo
instance (signature ~ (m CssSection), MonadIO m) => O.OverloadedMethod CssSectionRefMethodInfo CssSection signature where
    overloadedMethod = cssSectionRef

instance O.OverloadedMethodInfo CssSectionRefMethodInfo CssSection where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.CssSection.cssSectionRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Structs-CssSection.html#v:cssSectionRef"
        })


#endif

-- method CssSection::to_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "section"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "CssSection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkCssSection`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_css_section_to_string" gtk_css_section_to_string :: 
    Ptr CssSection ->                       -- section : TInterface (Name {namespace = "Gtk", name = "CssSection"})
    IO CString

-- | Prints the section into a human-readable text form using
-- 'GI.Gtk.Structs.CssSection.cssSectionPrint'.
cssSectionToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CssSection
    -- ^ /@section@/: a @GtkCssSection@
    -> m T.Text
    -- ^ __Returns:__ A new string.
cssSectionToString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
CssSection -> m Text
cssSectionToString CssSection
section = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    section' <- CssSection -> IO (Ptr CssSection)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CssSection
section
    result <- gtk_css_section_to_string section'
    checkUnexpectedReturnNULL "cssSectionToString" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr section
    return result'

#if defined(ENABLE_OVERLOADING)
data CssSectionToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod CssSectionToStringMethodInfo CssSection signature where
    overloadedMethod = cssSectionToString

instance O.OverloadedMethodInfo CssSectionToStringMethodInfo CssSection where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.CssSection.cssSectionToString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Structs-CssSection.html#v:cssSectionToString"
        })


#endif

-- method CssSection::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "section"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "CssSection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkCssSection`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_css_section_unref" gtk_css_section_unref :: 
    Ptr CssSection ->                       -- section : TInterface (Name {namespace = "Gtk", name = "CssSection"})
    IO ()

-- | Decrements the reference count on @section@, freeing the
-- structure if the reference count reaches 0.
cssSectionUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CssSection
    -- ^ /@section@/: a @GtkCssSection@
    -> m ()
cssSectionUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
CssSection -> m ()
cssSectionUnref CssSection
section = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    section' <- CssSection -> IO (Ptr CssSection)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed CssSection
section
    gtk_css_section_unref section'
    touchManagedPtr section
    return ()

#if defined(ENABLE_OVERLOADING)
data CssSectionUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod CssSectionUnrefMethodInfo CssSection signature where
    overloadedMethod = cssSectionUnref

instance O.OverloadedMethodInfo CssSectionUnrefMethodInfo CssSection where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.CssSection.cssSectionUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Structs-CssSection.html#v:cssSectionUnref"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveCssSectionMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveCssSectionMethod "print" o = CssSectionPrintMethodInfo
    ResolveCssSectionMethod "ref" o = CssSectionRefMethodInfo
    ResolveCssSectionMethod "toString" o = CssSectionToStringMethodInfo
    ResolveCssSectionMethod "unref" o = CssSectionUnrefMethodInfo
    ResolveCssSectionMethod "getBytes" o = CssSectionGetBytesMethodInfo
    ResolveCssSectionMethod "getEndLocation" o = CssSectionGetEndLocationMethodInfo
    ResolveCssSectionMethod "getFile" o = CssSectionGetFileMethodInfo
    ResolveCssSectionMethod "getParent" o = CssSectionGetParentMethodInfo
    ResolveCssSectionMethod "getStartLocation" o = CssSectionGetStartLocationMethodInfo
    ResolveCssSectionMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif