{-# LANGUAGE TypeApplications #-}


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

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

module GI.GtkSource.Objects.Mark
    ( 

-- * Exported types
    Mark(..)                                ,
    IsMark                                  ,
    toMark                                  ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [next]("GI.GtkSource.Objects.Mark#g:method:next"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [prev]("GI.GtkSource.Objects.Mark#g:method:prev"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getBuffer]("GI.Gtk.Objects.TextMark#g:method:getBuffer"), [getCategory]("GI.GtkSource.Objects.Mark#g:method:getCategory"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDeleted]("GI.Gtk.Objects.TextMark#g:method:getDeleted"), [getLeftGravity]("GI.Gtk.Objects.TextMark#g:method:getLeftGravity"), [getName]("GI.Gtk.Objects.TextMark#g:method:getName"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getVisible]("GI.Gtk.Objects.TextMark#g:method:getVisible").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setVisible]("GI.Gtk.Objects.TextMark#g:method:setVisible").

#if defined(ENABLE_OVERLOADING)
    ResolveMarkMethod                       ,
#endif

-- ** getCategory #method:getCategory#

#if defined(ENABLE_OVERLOADING)
    MarkGetCategoryMethodInfo               ,
#endif
    markGetCategory                         ,


-- ** new #method:new#

    markNew                                 ,


-- ** next #method:next#

#if defined(ENABLE_OVERLOADING)
    MarkNextMethodInfo                      ,
#endif
    markNext                                ,


-- ** prev #method:prev#

#if defined(ENABLE_OVERLOADING)
    MarkPrevMethodInfo                      ,
#endif
    markPrev                                ,




 -- * Properties


-- ** category #attr:category#
-- | The category of the t'GI.GtkSource.Objects.Mark.Mark', classifies the mark and controls
-- which pixbuf is used and with which priority it is drawn.

#if defined(ENABLE_OVERLOADING)
    MarkCategoryPropertyInfo                ,
#endif
    constructMarkCategory                   ,
    getMarkCategory                         ,
#if defined(ENABLE_OVERLOADING)
    markCategory                            ,
#endif




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Objects.TextMark as Gtk.TextMark

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

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

foreign import ccall "gtk_source_mark_get_type"
    c_gtk_source_mark_get_type :: IO B.Types.GType

instance B.Types.TypedObject Mark where
    glibType :: IO GType
glibType = IO GType
c_gtk_source_mark_get_type

instance B.Types.GObject Mark

-- | Type class for types which can be safely cast to `Mark`, for instance with `toMark`.
class (SP.GObject o, O.IsDescendantOf Mark o) => IsMark o
instance (SP.GObject o, O.IsDescendantOf Mark o) => IsMark o

instance O.HasParentTypes Mark
type instance O.ParentTypes Mark = '[Gtk.TextMark.TextMark, GObject.Object.Object]

-- | Cast to `Mark`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toMark :: (MIO.MonadIO m, IsMark o) => o -> m Mark
toMark :: forall (m :: * -> *) o. (MonadIO m, IsMark o) => o -> m Mark
toMark = IO Mark -> m Mark
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Mark -> m Mark) -> (o -> IO Mark) -> o -> m Mark
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Mark -> Mark) -> o -> IO Mark
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Mark -> Mark
Mark

-- | Convert 'Mark' 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 Mark) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_source_mark_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Mark -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Mark
P.Nothing = Ptr GValue -> Ptr Mark -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Mark
forall a. Ptr a
FP.nullPtr :: FP.Ptr Mark)
    gvalueSet_ Ptr GValue
gv (P.Just Mark
obj) = Mark -> (Ptr Mark -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Mark
obj (Ptr GValue -> Ptr Mark -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Mark)
gvalueGet_ Ptr GValue
gv = do
        Ptr Mark
ptr <- Ptr GValue -> IO (Ptr Mark)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Mark)
        if Ptr Mark
ptr Ptr Mark -> Ptr Mark -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Mark
forall a. Ptr a
FP.nullPtr
        then Mark -> Maybe Mark
forall a. a -> Maybe a
P.Just (Mark -> Maybe Mark) -> IO Mark -> IO (Maybe Mark)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Mark -> Mark) -> Ptr Mark -> IO Mark
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Mark -> Mark
Mark Ptr Mark
ptr
        else Maybe Mark -> IO (Maybe Mark)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Mark
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveMarkMethod (t :: Symbol) (o :: *) :: * where
    ResolveMarkMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveMarkMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveMarkMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveMarkMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveMarkMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveMarkMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveMarkMethod "next" o = MarkNextMethodInfo
    ResolveMarkMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveMarkMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveMarkMethod "prev" o = MarkPrevMethodInfo
    ResolveMarkMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveMarkMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveMarkMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveMarkMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveMarkMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveMarkMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveMarkMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveMarkMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveMarkMethod "getBuffer" o = Gtk.TextMark.TextMarkGetBufferMethodInfo
    ResolveMarkMethod "getCategory" o = MarkGetCategoryMethodInfo
    ResolveMarkMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveMarkMethod "getDeleted" o = Gtk.TextMark.TextMarkGetDeletedMethodInfo
    ResolveMarkMethod "getLeftGravity" o = Gtk.TextMark.TextMarkGetLeftGravityMethodInfo
    ResolveMarkMethod "getName" o = Gtk.TextMark.TextMarkGetNameMethodInfo
    ResolveMarkMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveMarkMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveMarkMethod "getVisible" o = Gtk.TextMark.TextMarkGetVisibleMethodInfo
    ResolveMarkMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveMarkMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveMarkMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveMarkMethod "setVisible" o = Gtk.TextMark.TextMarkSetVisibleMethodInfo
    ResolveMarkMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "category"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@category@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' mark #category
-- @
getMarkCategory :: (MonadIO m, IsMark o) => o -> m T.Text
getMarkCategory :: forall (m :: * -> *) o. (MonadIO m, IsMark o) => o -> m Text
getMarkCategory o
obj = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getMarkCategory" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"category"

-- | Construct a `GValueConstruct` with valid value for the “@category@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMarkCategory :: (IsMark o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructMarkCategory :: forall o (m :: * -> *).
(IsMark o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructMarkCategory Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"category" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data MarkCategoryPropertyInfo
instance AttrInfo MarkCategoryPropertyInfo where
    type AttrAllowedOps MarkCategoryPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MarkCategoryPropertyInfo = IsMark
    type AttrSetTypeConstraint MarkCategoryPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint MarkCategoryPropertyInfo = (~) T.Text
    type AttrTransferType MarkCategoryPropertyInfo = T.Text
    type AttrGetType MarkCategoryPropertyInfo = T.Text
    type AttrLabel MarkCategoryPropertyInfo = "category"
    type AttrOrigin MarkCategoryPropertyInfo = Mark
    attrGet = getMarkCategory
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructMarkCategory
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Mark
type instance O.AttributeList Mark = MarkAttributeList
type MarkAttributeList = ('[ '("category", MarkCategoryPropertyInfo), '("leftGravity", Gtk.TextMark.TextMarkLeftGravityPropertyInfo), '("name", Gtk.TextMark.TextMarkNamePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
markCategory :: AttrLabelProxy "category"
markCategory = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Mark = MarkSignalList
type MarkSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Mark::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Name of the #GtkSourceMark, can be NULL when not using a name"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "category"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "is used to classify marks according to common characteristics\n(e.g. all the marks representing a bookmark could belong to the \"bookmark\"\ncategory, or all the marks representing a compilation error could belong to\n\"error\" category)."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GtkSource" , name = "Mark" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_mark_new" gtk_source_mark_new :: 
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- category : TBasicType TUTF8
    IO (Ptr Mark)

-- | Creates a text mark. Add it to a buffer using 'GI.Gtk.Objects.TextBuffer.textBufferAddMark'.
-- If name is NULL, the mark is anonymous; otherwise, the mark can be retrieved
-- by name using 'GI.Gtk.Objects.TextBuffer.textBufferGetMark'.
-- Normally marks are created using the utility function
-- 'GI.GtkSource.Objects.Buffer.bufferCreateSourceMark'.
-- 
-- /Since: 2.2/
markNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@name@/: Name of the t'GI.GtkSource.Objects.Mark.Mark', can be NULL when not using a name
    -> T.Text
    -- ^ /@category@/: is used to classify marks according to common characteristics
    -- (e.g. all the marks representing a bookmark could belong to the \"bookmark\"
    -- category, or all the marks representing a compilation error could belong to
    -- \"error\" category).
    -> m Mark
    -- ^ __Returns:__ a new t'GI.GtkSource.Objects.Mark.Mark' that can be added using 'GI.Gtk.Objects.TextBuffer.textBufferAddMark'.
markNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Text -> m Mark
markNew Text
name Text
category = IO Mark -> m Mark
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Mark -> m Mark) -> IO Mark -> m Mark
forall a b. (a -> b) -> a -> b
$ do
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
category' <- Text -> IO CString
textToCString Text
category
    Ptr Mark
result <- CString -> CString -> IO (Ptr Mark)
gtk_source_mark_new CString
name' CString
category'
    Text -> Ptr Mark -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"markNew" Ptr Mark
result
    Mark
result' <- ((ManagedPtr Mark -> Mark) -> Ptr Mark -> IO Mark
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Mark -> Mark
Mark) Ptr Mark
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
category'
    Mark -> IO Mark
forall (m :: * -> *) a. Monad m => a -> m a
return Mark
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Mark::get_category
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mark"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Mark" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceMark." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_mark_get_category" gtk_source_mark_get_category :: 
    Ptr Mark ->                             -- mark : TInterface (Name {namespace = "GtkSource", name = "Mark"})
    IO CString

-- | Returns the mark category.
-- 
-- /Since: 2.2/
markGetCategory ::
    (B.CallStack.HasCallStack, MonadIO m, IsMark a) =>
    a
    -- ^ /@mark@/: a t'GI.GtkSource.Objects.Mark.Mark'.
    -> m T.Text
    -- ^ __Returns:__ the category of the t'GI.GtkSource.Objects.Mark.Mark'.
markGetCategory :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMark a) =>
a -> m Text
markGetCategory a
mark = IO Text -> m Text
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
    Ptr Mark
mark' <- a -> IO (Ptr Mark)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mark
    CString
result <- Ptr Mark -> IO CString
gtk_source_mark_get_category Ptr Mark
mark'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"markGetCategory" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mark
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data MarkGetCategoryMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsMark a) => O.OverloadedMethod MarkGetCategoryMethodInfo a signature where
    overloadedMethod = markGetCategory

instance O.OverloadedMethodInfo MarkGetCategoryMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.Mark.markGetCategory",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-Mark.html#v:markGetCategory"
        }


#endif

-- method Mark::next
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mark"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Mark" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceMark." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "category"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a string specifying the mark category, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GtkSource" , name = "Mark" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_mark_next" gtk_source_mark_next :: 
    Ptr Mark ->                             -- mark : TInterface (Name {namespace = "GtkSource", name = "Mark"})
    CString ->                              -- category : TBasicType TUTF8
    IO (Ptr Mark)

-- | Returns the next t'GI.GtkSource.Objects.Mark.Mark' in the buffer or 'P.Nothing' if the mark
-- was not added to a buffer. If there is no next mark, 'P.Nothing' will be returned.
-- 
-- If /@category@/ is 'P.Nothing', looks for marks of any category.
-- 
-- /Since: 2.2/
markNext ::
    (B.CallStack.HasCallStack, MonadIO m, IsMark a) =>
    a
    -- ^ /@mark@/: a t'GI.GtkSource.Objects.Mark.Mark'.
    -> Maybe (T.Text)
    -- ^ /@category@/: a string specifying the mark category, or 'P.Nothing'.
    -> m (Maybe Mark)
    -- ^ __Returns:__ the next t'GI.GtkSource.Objects.Mark.Mark', or 'P.Nothing'.
markNext :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMark a) =>
a -> Maybe Text -> m (Maybe Mark)
markNext a
mark Maybe Text
category = IO (Maybe Mark) -> m (Maybe Mark)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Mark) -> m (Maybe Mark))
-> IO (Maybe Mark) -> m (Maybe Mark)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Mark
mark' <- a -> IO (Ptr Mark)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mark
    CString
maybeCategory <- case Maybe Text
category of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jCategory -> do
            CString
jCategory' <- Text -> IO CString
textToCString Text
jCategory
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jCategory'
    Ptr Mark
result <- Ptr Mark -> CString -> IO (Ptr Mark)
gtk_source_mark_next Ptr Mark
mark' CString
maybeCategory
    Maybe Mark
maybeResult <- Ptr Mark -> (Ptr Mark -> IO Mark) -> IO (Maybe Mark)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Mark
result ((Ptr Mark -> IO Mark) -> IO (Maybe Mark))
-> (Ptr Mark -> IO Mark) -> IO (Maybe Mark)
forall a b. (a -> b) -> a -> b
$ \Ptr Mark
result' -> do
        Mark
result'' <- ((ManagedPtr Mark -> Mark) -> Ptr Mark -> IO Mark
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Mark -> Mark
Mark) Ptr Mark
result'
        Mark -> IO Mark
forall (m :: * -> *) a. Monad m => a -> m a
return Mark
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mark
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeCategory
    Maybe Mark -> IO (Maybe Mark)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Mark
maybeResult

#if defined(ENABLE_OVERLOADING)
data MarkNextMethodInfo
instance (signature ~ (Maybe (T.Text) -> m (Maybe Mark)), MonadIO m, IsMark a) => O.OverloadedMethod MarkNextMethodInfo a signature where
    overloadedMethod = markNext

instance O.OverloadedMethodInfo MarkNextMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.Mark.markNext",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-Mark.html#v:markNext"
        }


#endif

-- method Mark::prev
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mark"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Mark" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceMark." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "category"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a string specifying the mark category, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GtkSource" , name = "Mark" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_mark_prev" gtk_source_mark_prev :: 
    Ptr Mark ->                             -- mark : TInterface (Name {namespace = "GtkSource", name = "Mark"})
    CString ->                              -- category : TBasicType TUTF8
    IO (Ptr Mark)

-- | Returns the previous t'GI.GtkSource.Objects.Mark.Mark' in the buffer or 'P.Nothing' if the mark
-- was not added to a buffer. If there is no previous mark, 'P.Nothing' is returned.
-- 
-- If /@category@/ is 'P.Nothing', looks for marks of any category
-- 
-- /Since: 2.2/
markPrev ::
    (B.CallStack.HasCallStack, MonadIO m, IsMark a) =>
    a
    -- ^ /@mark@/: a t'GI.GtkSource.Objects.Mark.Mark'.
    -> T.Text
    -- ^ /@category@/: a string specifying the mark category, or 'P.Nothing'.
    -> m (Maybe Mark)
    -- ^ __Returns:__ the previous t'GI.GtkSource.Objects.Mark.Mark', or 'P.Nothing'.
markPrev :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMark a) =>
a -> Text -> m (Maybe Mark)
markPrev a
mark Text
category = IO (Maybe Mark) -> m (Maybe Mark)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Mark) -> m (Maybe Mark))
-> IO (Maybe Mark) -> m (Maybe Mark)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Mark
mark' <- a -> IO (Ptr Mark)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mark
    CString
category' <- Text -> IO CString
textToCString Text
category
    Ptr Mark
result <- Ptr Mark -> CString -> IO (Ptr Mark)
gtk_source_mark_prev Ptr Mark
mark' CString
category'
    Maybe Mark
maybeResult <- Ptr Mark -> (Ptr Mark -> IO Mark) -> IO (Maybe Mark)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Mark
result ((Ptr Mark -> IO Mark) -> IO (Maybe Mark))
-> (Ptr Mark -> IO Mark) -> IO (Maybe Mark)
forall a b. (a -> b) -> a -> b
$ \Ptr Mark
result' -> do
        Mark
result'' <- ((ManagedPtr Mark -> Mark) -> Ptr Mark -> IO Mark
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Mark -> Mark
Mark) Ptr Mark
result'
        Mark -> IO Mark
forall (m :: * -> *) a. Monad m => a -> m a
return Mark
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mark
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
category'
    Maybe Mark -> IO (Maybe Mark)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Mark
maybeResult

#if defined(ENABLE_OVERLOADING)
data MarkPrevMethodInfo
instance (signature ~ (T.Text -> m (Maybe Mark)), MonadIO m, IsMark a) => O.OverloadedMethod MarkPrevMethodInfo a signature where
    overloadedMethod = markPrev

instance O.OverloadedMethodInfo MarkPrevMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.Mark.markPrev",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-Mark.html#v:markPrev"
        }


#endif