{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- 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.Dazzle.Objects.PathElement
    ( 

-- * Exported types
    PathElement(..)                         ,
    IsPathElement                           ,
    toPathElement                           ,


 -- * 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"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [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
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getIconName]("GI.Dazzle.Objects.PathElement#g:method:getIconName"), [getId]("GI.Dazzle.Objects.PathElement#g:method:getId"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getTitle]("GI.Dazzle.Objects.PathElement#g:method:getTitle").
-- 
-- ==== 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").

#if defined(ENABLE_OVERLOADING)
    ResolvePathElementMethod                ,
#endif

-- ** getIconName #method:getIconName#

#if defined(ENABLE_OVERLOADING)
    PathElementGetIconNameMethodInfo        ,
#endif
    pathElementGetIconName                  ,


-- ** getId #method:getId#

#if defined(ENABLE_OVERLOADING)
    PathElementGetIdMethodInfo              ,
#endif
    pathElementGetId                        ,


-- ** getTitle #method:getTitle#

#if defined(ENABLE_OVERLOADING)
    PathElementGetTitleMethodInfo           ,
#endif
    pathElementGetTitle                     ,


-- ** new #method:new#

    pathElementNew                          ,




 -- * Properties


-- ** iconName #attr:iconName#
-- | The icon-name of the icon to display next to the path element
-- in the path bar. Set to 'P.Nothing' for no icon.
-- 
-- /Since: 3.26/

#if defined(ENABLE_OVERLOADING)
    PathElementIconNamePropertyInfo         ,
#endif
    constructPathElementIconName            ,
    getPathElementIconName                  ,
#if defined(ENABLE_OVERLOADING)
    pathElementIconName                     ,
#endif


-- ** id #attr:id#
-- | The id property is an application specific identifier for the
-- element within the path.
-- 
-- /Since: 3.26/

#if defined(ENABLE_OVERLOADING)
    PathElementIdPropertyInfo               ,
#endif
    constructPathElementId                  ,
    getPathElementId                        ,
#if defined(ENABLE_OVERLOADING)
    pathElementId                           ,
#endif


-- ** title #attr:title#
-- | The title property should contain the display text that should
-- be shown to represent the element in the t'GI.Dazzle.Objects.PathBar.PathBar'.
-- 
-- /Since: 3.26/

#if defined(ENABLE_OVERLOADING)
    PathElementTitlePropertyInfo            ,
#endif
    constructPathElementTitle               ,
    getPathElementTitle                     ,
#if defined(ENABLE_OVERLOADING)
    pathElementTitle                        ,
#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.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.GObject.Objects.Object as GObject.Object

#else
import qualified GI.GObject.Objects.Object as GObject.Object

#endif

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

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

foreign import ccall "dzl_path_element_get_type"
    c_dzl_path_element_get_type :: IO B.Types.GType

instance B.Types.TypedObject PathElement where
    glibType :: IO GType
glibType = IO GType
c_dzl_path_element_get_type

instance B.Types.GObject PathElement

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

instance O.HasParentTypes PathElement
type instance O.ParentTypes PathElement = '[GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolvePathElementMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolvePathElementMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePathElementMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePathElementMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePathElementMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePathElementMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePathElementMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePathElementMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePathElementMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePathElementMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePathElementMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePathElementMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePathElementMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePathElementMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePathElementMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePathElementMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePathElementMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePathElementMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePathElementMethod "getIconName" o = PathElementGetIconNameMethodInfo
    ResolvePathElementMethod "getId" o = PathElementGetIdMethodInfo
    ResolvePathElementMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePathElementMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePathElementMethod "getTitle" o = PathElementGetTitleMethodInfo
    ResolvePathElementMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePathElementMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePathElementMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePathElementMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

-- | Get the value of the “@icon-name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pathElement #iconName
-- @
getPathElementIconName :: (MonadIO m, IsPathElement o) => o -> m (Maybe T.Text)
getPathElementIconName :: forall (m :: * -> *) o.
(MonadIO m, IsPathElement o) =>
o -> m (Maybe Text)
getPathElementIconName o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe 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
"icon-name"

-- | Construct a `GValueConstruct` with valid value for the “@icon-name@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPathElementIconName :: (IsPathElement o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructPathElementIconName :: forall o (m :: * -> *).
(IsPathElement o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructPathElementIconName Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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
"icon-name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data PathElementIconNamePropertyInfo
instance AttrInfo PathElementIconNamePropertyInfo where
    type AttrAllowedOps PathElementIconNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint PathElementIconNamePropertyInfo = IsPathElement
    type AttrSetTypeConstraint PathElementIconNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint PathElementIconNamePropertyInfo = (~) T.Text
    type AttrTransferType PathElementIconNamePropertyInfo = T.Text
    type AttrGetType PathElementIconNamePropertyInfo = (Maybe T.Text)
    type AttrLabel PathElementIconNamePropertyInfo = "icon-name"
    type AttrOrigin PathElementIconNamePropertyInfo = PathElement
    attrGet = getPathElementIconName
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructPathElementIconName
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.PathElement.iconName"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-PathElement.html#g:attr:iconName"
        })
#endif

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

-- | Get the value of the “@id@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pathElement #id
-- @
getPathElementId :: (MonadIO m, IsPathElement o) => o -> m T.Text
getPathElementId :: forall (m :: * -> *) o. (MonadIO m, IsPathElement o) => o -> m Text
getPathElementId o
obj = IO Text -> m Text
forall a. IO a -> m a
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
"getPathElementId" (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
"id"

-- | Construct a `GValueConstruct` with valid value for the “@id@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPathElementId :: (IsPathElement o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructPathElementId :: forall o (m :: * -> *).
(IsPathElement o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructPathElementId Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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
"id" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data PathElementIdPropertyInfo
instance AttrInfo PathElementIdPropertyInfo where
    type AttrAllowedOps PathElementIdPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint PathElementIdPropertyInfo = IsPathElement
    type AttrSetTypeConstraint PathElementIdPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint PathElementIdPropertyInfo = (~) T.Text
    type AttrTransferType PathElementIdPropertyInfo = T.Text
    type AttrGetType PathElementIdPropertyInfo = T.Text
    type AttrLabel PathElementIdPropertyInfo = "id"
    type AttrOrigin PathElementIdPropertyInfo = PathElement
    attrGet = getPathElementId
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructPathElementId
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.PathElement.id"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-PathElement.html#g:attr:id"
        })
#endif

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

-- | Get the value of the “@title@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pathElement #title
-- @
getPathElementTitle :: (MonadIO m, IsPathElement o) => o -> m (Maybe T.Text)
getPathElementTitle :: forall (m :: * -> *) o.
(MonadIO m, IsPathElement o) =>
o -> m (Maybe Text)
getPathElementTitle o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe 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
"title"

-- | Construct a `GValueConstruct` with valid value for the “@title@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPathElementTitle :: (IsPathElement o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructPathElementTitle :: forall o (m :: * -> *).
(IsPathElement o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructPathElementTitle Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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
"title" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data PathElementTitlePropertyInfo
instance AttrInfo PathElementTitlePropertyInfo where
    type AttrAllowedOps PathElementTitlePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint PathElementTitlePropertyInfo = IsPathElement
    type AttrSetTypeConstraint PathElementTitlePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint PathElementTitlePropertyInfo = (~) T.Text
    type AttrTransferType PathElementTitlePropertyInfo = T.Text
    type AttrGetType PathElementTitlePropertyInfo = (Maybe T.Text)
    type AttrLabel PathElementTitlePropertyInfo = "title"
    type AttrOrigin PathElementTitlePropertyInfo = PathElement
    attrGet = getPathElementTitle
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructPathElementTitle
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.PathElement.title"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-PathElement.html#g:attr:title"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList PathElement
type instance O.AttributeList PathElement = PathElementAttributeList
type PathElementAttributeList = ('[ '("iconName", PathElementIconNamePropertyInfo), '("id", PathElementIdPropertyInfo), '("title", PathElementTitlePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
pathElementIconName :: AttrLabelProxy "iconName"
pathElementIconName = AttrLabelProxy

pathElementId :: AttrLabelProxy "id"
pathElementId = AttrLabelProxy

pathElementTitle :: AttrLabelProxy "title"
pathElementTitle = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList PathElement = PathElementSignalList
type PathElementSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method PathElement::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An id for the path element."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An optional icon name for the element"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The title of the element."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Dazzle" , name = "PathElement" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_path_element_new" dzl_path_element_new :: 
    CString ->                              -- id : TBasicType TUTF8
    CString ->                              -- icon_name : TBasicType TUTF8
    CString ->                              -- title : TBasicType TUTF8
    IO (Ptr PathElement)

-- | Creates a new path element for an t'GI.Dazzle.Objects.Path.Path'.
-- 
-- /Since: 3.26/
pathElementNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (T.Text)
    -- ^ /@id@/: An id for the path element.
    -> Maybe (T.Text)
    -- ^ /@iconName@/: An optional icon name for the element
    -> T.Text
    -- ^ /@title@/: The title of the element.
    -> m PathElement
    -- ^ __Returns:__ A t'GI.Dazzle.Objects.PathElement.PathElement'
pathElementNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> Maybe Text -> Text -> m PathElement
pathElementNew Maybe Text
id Maybe Text
iconName Text
title = IO PathElement -> m PathElement
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PathElement -> m PathElement)
-> IO PathElement -> m PathElement
forall a b. (a -> b) -> a -> b
$ do
    Ptr CChar
maybeId <- case Maybe Text
id of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jId -> do
            Ptr CChar
jId' <- Text -> IO (Ptr CChar)
textToCString Text
jId
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jId'
    Ptr CChar
maybeIconName <- case Maybe Text
iconName of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jIconName -> do
            Ptr CChar
jIconName' <- Text -> IO (Ptr CChar)
textToCString Text
jIconName
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jIconName'
    Ptr CChar
title' <- Text -> IO (Ptr CChar)
textToCString Text
title
    Ptr PathElement
result <- Ptr CChar -> Ptr CChar -> Ptr CChar -> IO (Ptr PathElement)
dzl_path_element_new Ptr CChar
maybeId Ptr CChar
maybeIconName Ptr CChar
title'
    Text -> Ptr PathElement -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pathElementNew" Ptr PathElement
result
    PathElement
result' <- ((ManagedPtr PathElement -> PathElement)
-> Ptr PathElement -> IO PathElement
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr PathElement -> PathElement
PathElement) Ptr PathElement
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeId
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeIconName
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
title'
    PathElement -> IO PathElement
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PathElement
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method PathElement::get_icon_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "PathElement" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #DzlPathElement" , 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 "dzl_path_element_get_icon_name" dzl_path_element_get_icon_name :: 
    Ptr PathElement ->                      -- self : TInterface (Name {namespace = "Dazzle", name = "PathElement"})
    IO CString

-- | Gets the [PathElement:iconName]("GI.Dazzle.Objects.PathElement#g:attr:iconName") property. This is used by the
-- path bar to display an icon next to the element of the path.
-- 
-- /Since: 3.26/
pathElementGetIconName ::
    (B.CallStack.HasCallStack, MonadIO m, IsPathElement a) =>
    a
    -- ^ /@self@/: A t'GI.Dazzle.Objects.PathElement.PathElement'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ The icon-name for the t'GI.Dazzle.Objects.PathElement.PathElement'.
pathElementGetIconName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPathElement a) =>
a -> m (Maybe Text)
pathElementGetIconName a
self = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr PathElement
self' <- a -> IO (Ptr PathElement)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CChar
result <- Ptr PathElement -> IO (Ptr CChar)
dzl_path_element_get_icon_name Ptr PathElement
self'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data PathElementGetIconNameMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsPathElement a) => O.OverloadedMethod PathElementGetIconNameMethodInfo a signature where
    overloadedMethod = pathElementGetIconName

instance O.OverloadedMethodInfo PathElementGetIconNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.PathElement.pathElementGetIconName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-PathElement.html#v:pathElementGetIconName"
        })


#endif

-- method PathElement::get_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "PathElement" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #DzlPathElement" , 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 "dzl_path_element_get_id" dzl_path_element_get_id :: 
    Ptr PathElement ->                      -- self : TInterface (Name {namespace = "Dazzle", name = "PathElement"})
    IO CString

-- | Gets the id for the element. Generally, a path is built of
-- multiple elements and each element should have an id that
-- is useful to the application that it using it. You might store
-- the name of a directory, or some other key as the id.
-- 
-- /Since: 3.26/
pathElementGetId ::
    (B.CallStack.HasCallStack, MonadIO m, IsPathElement a) =>
    a
    -- ^ /@self@/: A t'GI.Dazzle.Objects.PathElement.PathElement'
    -> m T.Text
    -- ^ __Returns:__ The id for the t'GI.Dazzle.Objects.PathElement.PathElement'.
pathElementGetId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPathElement a) =>
a -> m Text
pathElementGetId a
self = 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
    Ptr PathElement
self' <- a -> IO (Ptr PathElement)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CChar
result <- Ptr PathElement -> IO (Ptr CChar)
dzl_path_element_get_id Ptr PathElement
self'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pathElementGetId" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PathElementGetIdMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsPathElement a) => O.OverloadedMethod PathElementGetIdMethodInfo a signature where
    overloadedMethod = pathElementGetId

instance O.OverloadedMethodInfo PathElementGetIdMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.PathElement.pathElementGetId",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-PathElement.html#v:pathElementGetId"
        })


#endif

-- method PathElement::get_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "PathElement" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #DzlPathElement" , 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 "dzl_path_element_get_title" dzl_path_element_get_title :: 
    Ptr PathElement ->                      -- self : TInterface (Name {namespace = "Dazzle", name = "PathElement"})
    IO CString

-- | Gets the [PathElement:title]("GI.Dazzle.Objects.PathElement#g:attr:title") property. This is used by the
-- path bar to display text representing the element of the path.
-- 
-- /Since: 3.26/
pathElementGetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsPathElement a) =>
    a
    -- ^ /@self@/: A t'GI.Dazzle.Objects.PathElement.PathElement'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ The title for the t'GI.Dazzle.Objects.PathElement.PathElement'.
pathElementGetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPathElement a) =>
a -> m (Maybe Text)
pathElementGetTitle a
self = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr PathElement
self' <- a -> IO (Ptr PathElement)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CChar
result <- Ptr PathElement -> IO (Ptr CChar)
dzl_path_element_get_title Ptr PathElement
self'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data PathElementGetTitleMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsPathElement a) => O.OverloadedMethod PathElementGetTitleMethodInfo a signature where
    overloadedMethod = pathElementGetTitle

instance O.OverloadedMethodInfo PathElementGetTitleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.PathElement.pathElementGetTitle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-PathElement.html#v:pathElementGetTitle"
        })


#endif