{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Pango.Structs.FontDescription.FontDescription' structure represents the description
-- of an ideal font. These structures are used both to list
-- what fonts are available on the system and also for specifying
-- the characteristics of a font to load.

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

module GI.Pango.Structs.FontDescription
    ( 

-- * Exported types
    FontDescription(..)                     ,
    noFontDescription                       ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveFontDescriptionMethod            ,
#endif


-- ** betterMatch #method:betterMatch#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionBetterMatchMethodInfo    ,
#endif
    fontDescriptionBetterMatch              ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionCopyMethodInfo           ,
#endif
    fontDescriptionCopy                     ,


-- ** copyStatic #method:copyStatic#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionCopyStaticMethodInfo     ,
#endif
    fontDescriptionCopyStatic               ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionEqualMethodInfo          ,
#endif
    fontDescriptionEqual                    ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionFreeMethodInfo           ,
#endif
    fontDescriptionFree                     ,


-- ** fromString #method:fromString#

    fontDescriptionFromString               ,


-- ** getFamily #method:getFamily#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionGetFamilyMethodInfo      ,
#endif
    fontDescriptionGetFamily                ,


-- ** getGravity #method:getGravity#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionGetGravityMethodInfo     ,
#endif
    fontDescriptionGetGravity               ,


-- ** getSetFields #method:getSetFields#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionGetSetFieldsMethodInfo   ,
#endif
    fontDescriptionGetSetFields             ,


-- ** getSize #method:getSize#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionGetSizeMethodInfo        ,
#endif
    fontDescriptionGetSize                  ,


-- ** getSizeIsAbsolute #method:getSizeIsAbsolute#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionGetSizeIsAbsoluteMethodInfo,
#endif
    fontDescriptionGetSizeIsAbsolute        ,


-- ** getStretch #method:getStretch#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionGetStretchMethodInfo     ,
#endif
    fontDescriptionGetStretch               ,


-- ** getStyle #method:getStyle#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionGetStyleMethodInfo       ,
#endif
    fontDescriptionGetStyle                 ,


-- ** getVariant #method:getVariant#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionGetVariantMethodInfo     ,
#endif
    fontDescriptionGetVariant               ,


-- ** getVariations #method:getVariations#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionGetVariationsMethodInfo  ,
#endif
    fontDescriptionGetVariations            ,


-- ** getWeight #method:getWeight#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionGetWeightMethodInfo      ,
#endif
    fontDescriptionGetWeight                ,


-- ** hash #method:hash#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionHashMethodInfo           ,
#endif
    fontDescriptionHash                     ,


-- ** merge #method:merge#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionMergeMethodInfo          ,
#endif
    fontDescriptionMerge                    ,


-- ** mergeStatic #method:mergeStatic#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionMergeStaticMethodInfo    ,
#endif
    fontDescriptionMergeStatic              ,


-- ** new #method:new#

    fontDescriptionNew                      ,


-- ** setAbsoluteSize #method:setAbsoluteSize#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionSetAbsoluteSizeMethodInfo,
#endif
    fontDescriptionSetAbsoluteSize          ,


-- ** setFamily #method:setFamily#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionSetFamilyMethodInfo      ,
#endif
    fontDescriptionSetFamily                ,


-- ** setFamilyStatic #method:setFamilyStatic#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionSetFamilyStaticMethodInfo,
#endif
    fontDescriptionSetFamilyStatic          ,


-- ** setGravity #method:setGravity#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionSetGravityMethodInfo     ,
#endif
    fontDescriptionSetGravity               ,


-- ** setSize #method:setSize#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionSetSizeMethodInfo        ,
#endif
    fontDescriptionSetSize                  ,


-- ** setStretch #method:setStretch#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionSetStretchMethodInfo     ,
#endif
    fontDescriptionSetStretch               ,


-- ** setStyle #method:setStyle#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionSetStyleMethodInfo       ,
#endif
    fontDescriptionSetStyle                 ,


-- ** setVariant #method:setVariant#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionSetVariantMethodInfo     ,
#endif
    fontDescriptionSetVariant               ,


-- ** setVariations #method:setVariations#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionSetVariationsMethodInfo  ,
#endif
    fontDescriptionSetVariations            ,


-- ** setVariationsStatic #method:setVariationsStatic#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionSetVariationsStaticMethodInfo,
#endif
    fontDescriptionSetVariationsStatic      ,


-- ** setWeight #method:setWeight#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionSetWeightMethodInfo      ,
#endif
    fontDescriptionSetWeight                ,


-- ** toFilename #method:toFilename#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionToFilenameMethodInfo     ,
#endif
    fontDescriptionToFilename               ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionToStringMethodInfo       ,
#endif
    fontDescriptionToString                 ,


-- ** unsetFields #method:unsetFields#

#if defined(ENABLE_OVERLOADING)
    FontDescriptionUnsetFieldsMethodInfo    ,
#endif
    fontDescriptionUnsetFields              ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import {-# SOURCE #-} qualified GI.Pango.Enums as Pango.Enums
import {-# SOURCE #-} qualified GI.Pango.Flags as Pango.Flags

-- | Memory-managed wrapper type.
newtype FontDescription = FontDescription (ManagedPtr FontDescription)
    deriving (FontDescription -> FontDescription -> Bool
(FontDescription -> FontDescription -> Bool)
-> (FontDescription -> FontDescription -> Bool)
-> Eq FontDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontDescription -> FontDescription -> Bool
$c/= :: FontDescription -> FontDescription -> Bool
== :: FontDescription -> FontDescription -> Bool
$c== :: FontDescription -> FontDescription -> Bool
Eq)
foreign import ccall "pango_font_description_get_type" c_pango_font_description_get_type :: 
    IO GType

instance BoxedObject FontDescription where
    boxedType :: FontDescription -> IO GType
boxedType _ = IO GType
c_pango_font_description_get_type

-- | Convert 'FontDescription' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue FontDescription where
    toGValue :: FontDescription -> IO GValue
toGValue o :: FontDescription
o = do
        GType
gtype <- IO GType
c_pango_font_description_get_type
        FontDescription -> (Ptr FontDescription -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr FontDescription
o (GType
-> (GValue -> Ptr FontDescription -> IO ())
-> Ptr FontDescription
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr FontDescription -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO FontDescription
fromGValue gv :: GValue
gv = do
        Ptr FontDescription
ptr <- GValue -> IO (Ptr FontDescription)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr FontDescription)
        (ManagedPtr FontDescription -> FontDescription)
-> Ptr FontDescription -> IO FontDescription
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr FontDescription -> FontDescription
FontDescription Ptr FontDescription
ptr
        
    

-- | A convenience alias for `Nothing` :: `Maybe` `FontDescription`.
noFontDescription :: Maybe FontDescription
noFontDescription :: Maybe FontDescription
noFontDescription = Maybe FontDescription
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList FontDescription
type instance O.AttributeList FontDescription = FontDescriptionAttributeList
type FontDescriptionAttributeList = ('[ ] :: [(Symbol, *)])
#endif

-- method FontDescription::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Pango" , name = "FontDescription" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_new" pango_font_description_new :: 
    IO (Ptr FontDescription)

-- | Creates a new font description structure with all fields unset.
fontDescriptionNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m FontDescription
    -- ^ __Returns:__ the newly allocated t'GI.Pango.Structs.FontDescription.FontDescription', which
    --               should be freed using 'GI.Pango.Structs.FontDescription.fontDescriptionFree'.
fontDescriptionNew :: m FontDescription
fontDescriptionNew  = IO FontDescription -> m FontDescription
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FontDescription -> m FontDescription)
-> IO FontDescription -> m FontDescription
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
result <- IO (Ptr FontDescription)
pango_font_description_new
    Text -> Ptr FontDescription -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "fontDescriptionNew" Ptr FontDescription
result
    FontDescription
result' <- ((ManagedPtr FontDescription -> FontDescription)
-> Ptr FontDescription -> IO FontDescription
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FontDescription -> FontDescription
FontDescription) Ptr FontDescription
result
    FontDescription -> IO FontDescription
forall (m :: * -> *) a. Monad m => a -> m a
return FontDescription
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method FontDescription::better_match
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "old_match"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "new_match"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_better_match" pango_font_description_better_match :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    Ptr FontDescription ->                  -- old_match : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    Ptr FontDescription ->                  -- new_match : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    IO CInt

-- | Determines if the style attributes of /@newMatch@/ are a closer match
-- for /@desc@/ than those of /@oldMatch@/ are, or if /@oldMatch@/ is 'P.Nothing',
-- determines if /@newMatch@/ is a match at all.
-- Approximate matching is done for
-- weight and style; other style attributes must match exactly.
-- Style attributes are all attributes other than family and size-related
-- attributes.  Approximate matching for style considers PANGO_STYLE_OBLIQUE
-- and PANGO_STYLE_ITALIC as matches, but not as good a match as when the
-- styles are equal.
-- 
-- Note that /@oldMatch@/ must match /@desc@/.
fontDescriptionBetterMatch ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> Maybe (FontDescription)
    -- ^ /@oldMatch@/: a t'GI.Pango.Structs.FontDescription.FontDescription', or 'P.Nothing'
    -> FontDescription
    -- ^ /@newMatch@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@newMatch@/ is a better match
fontDescriptionBetterMatch :: FontDescription
-> Maybe FontDescription -> FontDescription -> m Bool
fontDescriptionBetterMatch desc :: FontDescription
desc oldMatch :: Maybe FontDescription
oldMatch newMatch :: FontDescription
newMatch = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    Ptr FontDescription
maybeOldMatch <- case Maybe FontDescription
oldMatch of
        Nothing -> Ptr FontDescription -> IO (Ptr FontDescription)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FontDescription
forall a. Ptr a
nullPtr
        Just jOldMatch :: FontDescription
jOldMatch -> do
            Ptr FontDescription
jOldMatch' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
jOldMatch
            Ptr FontDescription -> IO (Ptr FontDescription)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FontDescription
jOldMatch'
    Ptr FontDescription
newMatch' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
newMatch
    CInt
result <- Ptr FontDescription
-> Ptr FontDescription -> Ptr FontDescription -> IO CInt
pango_font_description_better_match Ptr FontDescription
desc' Ptr FontDescription
maybeOldMatch Ptr FontDescription
newMatch'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    Maybe FontDescription -> (FontDescription -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe FontDescription
oldMatch FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
newMatch
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FontDescriptionBetterMatchMethodInfo
instance (signature ~ (Maybe (FontDescription) -> FontDescription -> m Bool), MonadIO m) => O.MethodInfo FontDescriptionBetterMatchMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionBetterMatch

#endif

-- method FontDescription::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription, may be %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Pango" , name = "FontDescription" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_copy" pango_font_description_copy :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    IO (Ptr FontDescription)

-- | Make a copy of a t'GI.Pango.Structs.FontDescription.FontDescription'.
fontDescriptionCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription', may be 'P.Nothing'
    -> m (Maybe FontDescription)
    -- ^ __Returns:__ the newly allocated
    --               t'GI.Pango.Structs.FontDescription.FontDescription', which should be freed with
    --               'GI.Pango.Structs.FontDescription.fontDescriptionFree', or 'P.Nothing' if /@desc@/ was
    --               'P.Nothing'.
fontDescriptionCopy :: FontDescription -> m (Maybe FontDescription)
fontDescriptionCopy desc :: FontDescription
desc = IO (Maybe FontDescription) -> m (Maybe FontDescription)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FontDescription) -> m (Maybe FontDescription))
-> IO (Maybe FontDescription) -> m (Maybe FontDescription)
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    Ptr FontDescription
result <- Ptr FontDescription -> IO (Ptr FontDescription)
pango_font_description_copy Ptr FontDescription
desc'
    Maybe FontDescription
maybeResult <- Ptr FontDescription
-> (Ptr FontDescription -> IO FontDescription)
-> IO (Maybe FontDescription)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr FontDescription
result ((Ptr FontDescription -> IO FontDescription)
 -> IO (Maybe FontDescription))
-> (Ptr FontDescription -> IO FontDescription)
-> IO (Maybe FontDescription)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr FontDescription
result' -> do
        FontDescription
result'' <- ((ManagedPtr FontDescription -> FontDescription)
-> Ptr FontDescription -> IO FontDescription
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FontDescription -> FontDescription
FontDescription) Ptr FontDescription
result'
        FontDescription -> IO FontDescription
forall (m :: * -> *) a. Monad m => a -> m a
return FontDescription
result''
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    Maybe FontDescription -> IO (Maybe FontDescription)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FontDescription
maybeResult

#if defined(ENABLE_OVERLOADING)
data FontDescriptionCopyMethodInfo
instance (signature ~ (m (Maybe FontDescription)), MonadIO m) => O.MethodInfo FontDescriptionCopyMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionCopy

#endif

-- method FontDescription::copy_static
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription, may be %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Pango" , name = "FontDescription" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_copy_static" pango_font_description_copy_static :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    IO (Ptr FontDescription)

-- | Like 'GI.Pango.Structs.FontDescription.fontDescriptionCopy', but only a shallow copy is made
-- of the family name and other allocated fields. The result can only
-- be used until /@desc@/ is modified or freed. This is meant to be used
-- when the copy is only needed temporarily.
fontDescriptionCopyStatic ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription', may be 'P.Nothing'
    -> m (Maybe FontDescription)
    -- ^ __Returns:__ the newly allocated
    --               t'GI.Pango.Structs.FontDescription.FontDescription', which should be freed with
    --               'GI.Pango.Structs.FontDescription.fontDescriptionFree', or 'P.Nothing' if /@desc@/ was
    --               'P.Nothing'.
fontDescriptionCopyStatic :: FontDescription -> m (Maybe FontDescription)
fontDescriptionCopyStatic desc :: FontDescription
desc = IO (Maybe FontDescription) -> m (Maybe FontDescription)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FontDescription) -> m (Maybe FontDescription))
-> IO (Maybe FontDescription) -> m (Maybe FontDescription)
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    Ptr FontDescription
result <- Ptr FontDescription -> IO (Ptr FontDescription)
pango_font_description_copy_static Ptr FontDescription
desc'
    Maybe FontDescription
maybeResult <- Ptr FontDescription
-> (Ptr FontDescription -> IO FontDescription)
-> IO (Maybe FontDescription)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr FontDescription
result ((Ptr FontDescription -> IO FontDescription)
 -> IO (Maybe FontDescription))
-> (Ptr FontDescription -> IO FontDescription)
-> IO (Maybe FontDescription)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr FontDescription
result' -> do
        FontDescription
result'' <- ((ManagedPtr FontDescription -> FontDescription)
-> Ptr FontDescription -> IO FontDescription
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FontDescription -> FontDescription
FontDescription) Ptr FontDescription
result'
        FontDescription -> IO FontDescription
forall (m :: * -> *) a. Monad m => a -> m a
return FontDescription
result''
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    Maybe FontDescription -> IO (Maybe FontDescription)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FontDescription
maybeResult

#if defined(ENABLE_OVERLOADING)
data FontDescriptionCopyStaticMethodInfo
instance (signature ~ (m (Maybe FontDescription)), MonadIO m) => O.MethodInfo FontDescriptionCopyStaticMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionCopyStatic

#endif

-- method FontDescription::equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc1"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "desc2"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "another #PangoFontDescription"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_equal" pango_font_description_equal :: 
    Ptr FontDescription ->                  -- desc1 : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    Ptr FontDescription ->                  -- desc2 : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    IO CInt

-- | Compares two font descriptions for equality. Two font descriptions
-- are considered equal if the fonts they describe are provably identical.
-- This means that their masks do not have to match, as long as other fields
-- are all the same. (Two font descriptions may result in identical fonts
-- being loaded, but still compare 'P.False'.)
fontDescriptionEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc1@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> FontDescription
    -- ^ /@desc2@/: another t'GI.Pango.Structs.FontDescription.FontDescription'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the two font descriptions are identical,
    -- 	 'P.False' otherwise.
fontDescriptionEqual :: FontDescription -> FontDescription -> m Bool
fontDescriptionEqual desc1 :: FontDescription
desc1 desc2 :: FontDescription
desc2 = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc1' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc1
    Ptr FontDescription
desc2' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc2
    CInt
result <- Ptr FontDescription -> Ptr FontDescription -> IO CInt
pango_font_description_equal Ptr FontDescription
desc1' Ptr FontDescription
desc2'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc1
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc2
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FontDescriptionEqualMethodInfo
instance (signature ~ (FontDescription -> m Bool), MonadIO m) => O.MethodInfo FontDescriptionEqualMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionEqual

#endif

-- method FontDescription::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription, may be %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_free" pango_font_description_free :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    IO ()

-- | Frees a font description.
fontDescriptionFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription', may be 'P.Nothing'
    -> m ()
fontDescriptionFree :: FontDescription -> m ()
fontDescriptionFree desc :: FontDescription
desc = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    Ptr FontDescription -> IO ()
pango_font_description_free Ptr FontDescription
desc'
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontDescriptionFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo FontDescriptionFreeMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionFree

#endif

-- method FontDescription::get_family
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription."
--                 , 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 "pango_font_description_get_family" pango_font_description_get_family :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    IO CString

-- | Gets the family name field of a font description. See
-- 'GI.Pango.Structs.FontDescription.fontDescriptionSetFamily'.
fontDescriptionGetFamily ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the family name field for the font
    --               description, or 'P.Nothing' if not previously set.  This
    --               has the same life-time as the font description itself
    --               and should not be freed.
fontDescriptionGetFamily :: FontDescription -> m (Maybe Text)
fontDescriptionGetFamily desc :: FontDescription
desc = IO (Maybe Text) -> m (Maybe Text)
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 FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    CString
result <- Ptr FontDescription -> IO CString
pango_font_description_get_family Ptr FontDescription
desc'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \result' :: CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data FontDescriptionGetFamilyMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.MethodInfo FontDescriptionGetFamilyMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionGetFamily

#endif

-- method FontDescription::get_gravity
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "Gravity" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_get_gravity" pango_font_description_get_gravity :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    IO CUInt

-- | Gets the gravity field of a font description. See
-- 'GI.Pango.Structs.FontDescription.fontDescriptionSetGravity'.
-- 
-- /Since: 1.16/
fontDescriptionGetGravity ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> m Pango.Enums.Gravity
    -- ^ __Returns:__ the gravity field for the font description. Use
    --   'GI.Pango.Structs.FontDescription.fontDescriptionGetSetFields' to find out if
    --   the field was explicitly set or not.
fontDescriptionGetGravity :: FontDescription -> m Gravity
fontDescriptionGetGravity desc :: FontDescription
desc = IO Gravity -> m Gravity
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Gravity -> m Gravity) -> IO Gravity -> m Gravity
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    CUInt
result <- Ptr FontDescription -> IO CUInt
pango_font_description_get_gravity Ptr FontDescription
desc'
    let result' :: Gravity
result' = (Int -> Gravity
forall a. Enum a => Int -> a
toEnum (Int -> Gravity) -> (CUInt -> Int) -> CUInt -> Gravity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    Gravity -> IO Gravity
forall (m :: * -> *) a. Monad m => a -> m a
return Gravity
result'

#if defined(ENABLE_OVERLOADING)
data FontDescriptionGetGravityMethodInfo
instance (signature ~ (m Pango.Enums.Gravity), MonadIO m) => O.MethodInfo FontDescriptionGetGravityMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionGetGravity

#endif

-- method FontDescription::get_set_fields
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "FontMask" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_get_set_fields" pango_font_description_get_set_fields :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    IO CUInt

-- | Determines which fields in a font description have been set.
fontDescriptionGetSetFields ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> m [Pango.Flags.FontMask]
    -- ^ __Returns:__ a bitmask with bits set corresponding to the
    --   fields in /@desc@/ that have been set.
fontDescriptionGetSetFields :: FontDescription -> m [FontMask]
fontDescriptionGetSetFields desc :: FontDescription
desc = IO [FontMask] -> m [FontMask]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FontMask] -> m [FontMask]) -> IO [FontMask] -> m [FontMask]
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    CUInt
result <- Ptr FontDescription -> IO CUInt
pango_font_description_get_set_fields Ptr FontDescription
desc'
    let result' :: [FontMask]
result' = CUInt -> [FontMask]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    [FontMask] -> IO [FontMask]
forall (m :: * -> *) a. Monad m => a -> m a
return [FontMask]
result'

#if defined(ENABLE_OVERLOADING)
data FontDescriptionGetSetFieldsMethodInfo
instance (signature ~ (m [Pango.Flags.FontMask]), MonadIO m) => O.MethodInfo FontDescriptionGetSetFieldsMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionGetSetFields

#endif

-- method FontDescription::get_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_get_size" pango_font_description_get_size :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    IO Int32

-- | Gets the size field of a font description.
-- See 'GI.Pango.Structs.FontDescription.fontDescriptionSetSize'.
fontDescriptionGetSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> m Int32
    -- ^ __Returns:__ the size field for the font description in points or device units.
    --   You must call 'GI.Pango.Structs.FontDescription.fontDescriptionGetSizeIsAbsolute'
    --   to find out which is the case. Returns 0 if the size field has not
    --   previously been set or it has been set to 0 explicitly.
    --   Use 'GI.Pango.Structs.FontDescription.fontDescriptionGetSetFields' to
    --   find out if the field was explicitly set or not.
fontDescriptionGetSize :: FontDescription -> m Int32
fontDescriptionGetSize desc :: FontDescription
desc = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    Int32
result <- Ptr FontDescription -> IO Int32
pango_font_description_get_size Ptr FontDescription
desc'
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data FontDescriptionGetSizeMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo FontDescriptionGetSizeMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionGetSize

#endif

-- method FontDescription::get_size_is_absolute
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_get_size_is_absolute" pango_font_description_get_size_is_absolute :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    IO CInt

-- | Determines whether the size of the font is in points (not absolute) or device units (absolute).
-- See 'GI.Pango.Structs.FontDescription.fontDescriptionSetSize' and 'GI.Pango.Structs.FontDescription.fontDescriptionSetAbsoluteSize'.
-- 
-- /Since: 1.8/
fontDescriptionGetSizeIsAbsolute ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> m Bool
    -- ^ __Returns:__ whether the size for the font description is in
    --   points or device units.  Use 'GI.Pango.Structs.FontDescription.fontDescriptionGetSetFields' to
    --   find out if the size field of the font description was explicitly set or not.
fontDescriptionGetSizeIsAbsolute :: FontDescription -> m Bool
fontDescriptionGetSizeIsAbsolute desc :: FontDescription
desc = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    CInt
result <- Ptr FontDescription -> IO CInt
pango_font_description_get_size_is_absolute Ptr FontDescription
desc'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FontDescriptionGetSizeIsAbsoluteMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo FontDescriptionGetSizeIsAbsoluteMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionGetSizeIsAbsolute

#endif

-- method FontDescription::get_stretch
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "Stretch" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_get_stretch" pango_font_description_get_stretch :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    IO CUInt

-- | Gets the stretch field of a font description.
-- See 'GI.Pango.Structs.FontDescription.fontDescriptionSetStretch'.
fontDescriptionGetStretch ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'.
    -> m Pango.Enums.Stretch
    -- ^ __Returns:__ the stretch field for the font description. Use
    --   'GI.Pango.Structs.FontDescription.fontDescriptionGetSetFields' to find out if
    --   the field was explicitly set or not.
fontDescriptionGetStretch :: FontDescription -> m Stretch
fontDescriptionGetStretch desc :: FontDescription
desc = IO Stretch -> m Stretch
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Stretch -> m Stretch) -> IO Stretch -> m Stretch
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    CUInt
result <- Ptr FontDescription -> IO CUInt
pango_font_description_get_stretch Ptr FontDescription
desc'
    let result' :: Stretch
result' = (Int -> Stretch
forall a. Enum a => Int -> a
toEnum (Int -> Stretch) -> (CUInt -> Int) -> CUInt -> Stretch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    Stretch -> IO Stretch
forall (m :: * -> *) a. Monad m => a -> m a
return Stretch
result'

#if defined(ENABLE_OVERLOADING)
data FontDescriptionGetStretchMethodInfo
instance (signature ~ (m Pango.Enums.Stretch), MonadIO m) => O.MethodInfo FontDescriptionGetStretchMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionGetStretch

#endif

-- method FontDescription::get_style
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "Style" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_get_style" pango_font_description_get_style :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    IO CUInt

-- | Gets the style field of a t'GI.Pango.Structs.FontDescription.FontDescription'. See
-- 'GI.Pango.Structs.FontDescription.fontDescriptionSetStyle'.
fontDescriptionGetStyle ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> m Pango.Enums.Style
    -- ^ __Returns:__ the style field for the font description.
    --   Use 'GI.Pango.Structs.FontDescription.fontDescriptionGetSetFields' to find out if
    --   the field was explicitly set or not.
fontDescriptionGetStyle :: FontDescription -> m Style
fontDescriptionGetStyle desc :: FontDescription
desc = IO Style -> m Style
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Style -> m Style) -> IO Style -> m Style
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    CUInt
result <- Ptr FontDescription -> IO CUInt
pango_font_description_get_style Ptr FontDescription
desc'
    let result' :: Style
result' = (Int -> Style
forall a. Enum a => Int -> a
toEnum (Int -> Style) -> (CUInt -> Int) -> CUInt -> Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    Style -> IO Style
forall (m :: * -> *) a. Monad m => a -> m a
return Style
result'

#if defined(ENABLE_OVERLOADING)
data FontDescriptionGetStyleMethodInfo
instance (signature ~ (m Pango.Enums.Style), MonadIO m) => O.MethodInfo FontDescriptionGetStyleMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionGetStyle

#endif

-- method FontDescription::get_variant
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "Variant" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_get_variant" pango_font_description_get_variant :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    IO CUInt

-- | Gets the variant field of a t'GI.Pango.Structs.FontDescription.FontDescription'. See
-- 'GI.Pango.Structs.FontDescription.fontDescriptionSetVariant'.
fontDescriptionGetVariant ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'.
    -> m Pango.Enums.Variant
    -- ^ __Returns:__ the variant field for the font description. Use
    --   'GI.Pango.Structs.FontDescription.fontDescriptionGetSetFields' to find out if
    --   the field was explicitly set or not.
fontDescriptionGetVariant :: FontDescription -> m Variant
fontDescriptionGetVariant desc :: FontDescription
desc = IO Variant -> m Variant
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Variant -> m Variant) -> IO Variant -> m Variant
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    CUInt
result <- Ptr FontDescription -> IO CUInt
pango_font_description_get_variant Ptr FontDescription
desc'
    let result' :: Variant
result' = (Int -> Variant
forall a. Enum a => Int -> a
toEnum (Int -> Variant) -> (CUInt -> Int) -> CUInt -> Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    Variant -> IO Variant
forall (m :: * -> *) a. Monad m => a -> m a
return Variant
result'

#if defined(ENABLE_OVERLOADING)
data FontDescriptionGetVariantMethodInfo
instance (signature ~ (m Pango.Enums.Variant), MonadIO m) => O.MethodInfo FontDescriptionGetVariantMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionGetVariant

#endif

-- method FontDescription::get_variations
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , 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 "pango_font_description_get_variations" pango_font_description_get_variations :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    IO CString

-- | Gets the variations field of a font description. See
-- 'GI.Pango.Structs.FontDescription.fontDescriptionSetVariations'.
-- 
-- /Since: 1.42/
fontDescriptionGetVariations ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the varitions field for the font
    --               description, or 'P.Nothing' if not previously set.  This
    --               has the same life-time as the font description itself
    --               and should not be freed.
fontDescriptionGetVariations :: FontDescription -> m (Maybe Text)
fontDescriptionGetVariations desc :: FontDescription
desc = IO (Maybe Text) -> m (Maybe Text)
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 FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    CString
result <- Ptr FontDescription -> IO CString
pango_font_description_get_variations Ptr FontDescription
desc'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \result' :: CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data FontDescriptionGetVariationsMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.MethodInfo FontDescriptionGetVariationsMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionGetVariations

#endif

-- method FontDescription::get_weight
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "Weight" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_get_weight" pango_font_description_get_weight :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    IO CUInt

-- | Gets the weight field of a font description. See
-- 'GI.Pango.Structs.FontDescription.fontDescriptionSetWeight'.
fontDescriptionGetWeight ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> m Pango.Enums.Weight
    -- ^ __Returns:__ the weight field for the font description. Use
    --   'GI.Pango.Structs.FontDescription.fontDescriptionGetSetFields' to find out if
    --   the field was explicitly set or not.
fontDescriptionGetWeight :: FontDescription -> m Weight
fontDescriptionGetWeight desc :: FontDescription
desc = IO Weight -> m Weight
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Weight -> m Weight) -> IO Weight -> m Weight
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    CUInt
result <- Ptr FontDescription -> IO CUInt
pango_font_description_get_weight Ptr FontDescription
desc'
    let result' :: Weight
result' = (Int -> Weight
forall a. Enum a => Int -> a
toEnum (Int -> Weight) -> (CUInt -> Int) -> CUInt -> Weight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    Weight -> IO Weight
forall (m :: * -> *) a. Monad m => a -> m a
return Weight
result'

#if defined(ENABLE_OVERLOADING)
data FontDescriptionGetWeightMethodInfo
instance (signature ~ (m Pango.Enums.Weight), MonadIO m) => O.MethodInfo FontDescriptionGetWeightMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionGetWeight

#endif

-- method FontDescription::hash
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_hash" pango_font_description_hash :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    IO Word32

-- | Computes a hash of a t'GI.Pango.Structs.FontDescription.FontDescription' structure suitable
-- to be used, for example, as an argument to @/g_hash_table_new()/@.
-- The hash value is independent of /@desc@/->mask.
fontDescriptionHash ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> m Word32
    -- ^ __Returns:__ the hash value.
fontDescriptionHash :: FontDescription -> m Word32
fontDescriptionHash desc :: FontDescription
desc = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    Word32
result <- Ptr FontDescription -> IO Word32
pango_font_description_hash Ptr FontDescription
desc'
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data FontDescriptionHashMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo FontDescriptionHashMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionHash

#endif

-- method FontDescription::merge
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "desc_to_merge"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #PangoFontDescription to merge from, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "replace_existing"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "if %TRUE, replace fields in @desc with the\n  corresponding values from @desc_to_merge, even if they\n  are already exist."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_merge" pango_font_description_merge :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    Ptr FontDescription ->                  -- desc_to_merge : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    CInt ->                                 -- replace_existing : TBasicType TBoolean
    IO ()

-- | Merges the fields that are set in /@descToMerge@/ into the fields in
-- /@desc@/.  If /@replaceExisting@/ is 'P.False', only fields in /@desc@/ that
-- are not already set are affected. If 'P.True', then fields that are
-- already set will be replaced as well.
-- 
-- If /@descToMerge@/ is 'P.Nothing', this function performs nothing.
fontDescriptionMerge ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> Maybe (FontDescription)
    -- ^ /@descToMerge@/: the t'GI.Pango.Structs.FontDescription.FontDescription' to merge from, or 'P.Nothing'
    -> Bool
    -- ^ /@replaceExisting@/: if 'P.True', replace fields in /@desc@/ with the
    --   corresponding values from /@descToMerge@/, even if they
    --   are already exist.
    -> m ()
fontDescriptionMerge :: FontDescription -> Maybe FontDescription -> Bool -> m ()
fontDescriptionMerge desc :: FontDescription
desc descToMerge :: Maybe FontDescription
descToMerge replaceExisting :: Bool
replaceExisting = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    Ptr FontDescription
maybeDescToMerge <- case Maybe FontDescription
descToMerge of
        Nothing -> Ptr FontDescription -> IO (Ptr FontDescription)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FontDescription
forall a. Ptr a
nullPtr
        Just jDescToMerge :: FontDescription
jDescToMerge -> do
            Ptr FontDescription
jDescToMerge' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
jDescToMerge
            Ptr FontDescription -> IO (Ptr FontDescription)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FontDescription
jDescToMerge'
    let replaceExisting' :: CInt
replaceExisting' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
replaceExisting
    Ptr FontDescription -> Ptr FontDescription -> CInt -> IO ()
pango_font_description_merge Ptr FontDescription
desc' Ptr FontDescription
maybeDescToMerge CInt
replaceExisting'
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    Maybe FontDescription -> (FontDescription -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe FontDescription
descToMerge FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontDescriptionMergeMethodInfo
instance (signature ~ (Maybe (FontDescription) -> Bool -> m ()), MonadIO m) => O.MethodInfo FontDescriptionMergeMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionMerge

#endif

-- method FontDescription::merge_static
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "desc_to_merge"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #PangoFontDescription to merge from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "replace_existing"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "if %TRUE, replace fields in @desc with the\n  corresponding values from @desc_to_merge, even if they\n  are already exist."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_merge_static" pango_font_description_merge_static :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    Ptr FontDescription ->                  -- desc_to_merge : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    CInt ->                                 -- replace_existing : TBasicType TBoolean
    IO ()

-- | Like 'GI.Pango.Structs.FontDescription.fontDescriptionMerge', but only a shallow copy is made
-- of the family name and other allocated fields. /@desc@/ can only be
-- used until /@descToMerge@/ is modified or freed. This is meant
-- to be used when the merged font description is only needed temporarily.
fontDescriptionMergeStatic ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> FontDescription
    -- ^ /@descToMerge@/: the t'GI.Pango.Structs.FontDescription.FontDescription' to merge from
    -> Bool
    -- ^ /@replaceExisting@/: if 'P.True', replace fields in /@desc@/ with the
    --   corresponding values from /@descToMerge@/, even if they
    --   are already exist.
    -> m ()
fontDescriptionMergeStatic :: FontDescription -> FontDescription -> Bool -> m ()
fontDescriptionMergeStatic desc :: FontDescription
desc descToMerge :: FontDescription
descToMerge replaceExisting :: Bool
replaceExisting = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    Ptr FontDescription
descToMerge' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
descToMerge
    let replaceExisting' :: CInt
replaceExisting' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
replaceExisting
    Ptr FontDescription -> Ptr FontDescription -> CInt -> IO ()
pango_font_description_merge_static Ptr FontDescription
desc' Ptr FontDescription
descToMerge' CInt
replaceExisting'
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
descToMerge
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontDescriptionMergeStaticMethodInfo
instance (signature ~ (FontDescription -> Bool -> m ()), MonadIO m) => O.MethodInfo FontDescriptionMergeStaticMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionMergeStatic

#endif

-- method FontDescription::set_absolute_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the new size, in Pango units. There are %PANGO_SCALE Pango units in one\n  device unit. For an output backend where a device unit is a pixel, a @size\n  value of 10 * PANGO_SCALE gives a 10 pixel font."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_set_absolute_size" pango_font_description_set_absolute_size :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    CDouble ->                              -- size : TBasicType TDouble
    IO ()

-- | Sets the size field of a font description, in device units. This is mutually
-- exclusive with 'GI.Pango.Structs.FontDescription.fontDescriptionSetSize' which sets the font size
-- in points.
-- 
-- /Since: 1.8/
fontDescriptionSetAbsoluteSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> Double
    -- ^ /@size@/: the new size, in Pango units. There are 'GI.Pango.Constants.SCALE' Pango units in one
    --   device unit. For an output backend where a device unit is a pixel, a /@size@/
    --   value of 10 * PANGO_SCALE gives a 10 pixel font.
    -> m ()
fontDescriptionSetAbsoluteSize :: FontDescription -> Double -> m ()
fontDescriptionSetAbsoluteSize desc :: FontDescription
desc size :: Double
size = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    let size' :: CDouble
size' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
size
    Ptr FontDescription -> CDouble -> IO ()
pango_font_description_set_absolute_size Ptr FontDescription
desc' CDouble
size'
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontDescriptionSetAbsoluteSizeMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m) => O.MethodInfo FontDescriptionSetAbsoluteSizeMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionSetAbsoluteSize

#endif

-- method FontDescription::set_family
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "family"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string representing the family name."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_set_family" pango_font_description_set_family :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    CString ->                              -- family : TBasicType TUTF8
    IO ()

-- | Sets the family name field of a font description. The family
-- name represents a family of related font styles, and will
-- resolve to a particular t'GI.Pango.Objects.FontFamily.FontFamily'. In some uses of
-- t'GI.Pango.Structs.FontDescription.FontDescription', it is also possible to use a comma
-- separated list of family names for this field.
fontDescriptionSetFamily ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'.
    -> T.Text
    -- ^ /@family@/: a string representing the family name.
    -> m ()
fontDescriptionSetFamily :: FontDescription -> Text -> m ()
fontDescriptionSetFamily desc :: FontDescription
desc family :: Text
family = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    CString
family' <- Text -> IO CString
textToCString Text
family
    Ptr FontDescription -> CString -> IO ()
pango_font_description_set_family Ptr FontDescription
desc' CString
family'
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
family'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontDescriptionSetFamilyMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.MethodInfo FontDescriptionSetFamilyMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionSetFamily

#endif

-- method FontDescription::set_family_static
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "family"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string representing the family name."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_set_family_static" pango_font_description_set_family_static :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    CString ->                              -- family : TBasicType TUTF8
    IO ()

-- | Like 'GI.Pango.Structs.FontDescription.fontDescriptionSetFamily', except that no
-- copy of /@family@/ is made. The caller must make sure that the
-- string passed in stays around until /@desc@/ has been freed
-- or the name is set again. This function can be used if
-- /@family@/ is a static string such as a C string literal, or
-- if /@desc@/ is only needed temporarily.
fontDescriptionSetFamilyStatic ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> T.Text
    -- ^ /@family@/: a string representing the family name.
    -> m ()
fontDescriptionSetFamilyStatic :: FontDescription -> Text -> m ()
fontDescriptionSetFamilyStatic desc :: FontDescription
desc family :: Text
family = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    CString
family' <- Text -> IO CString
textToCString Text
family
    Ptr FontDescription -> CString -> IO ()
pango_font_description_set_family_static Ptr FontDescription
desc' CString
family'
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
family'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontDescriptionSetFamilyStaticMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.MethodInfo FontDescriptionSetFamilyStaticMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionSetFamilyStatic

#endif

-- method FontDescription::set_gravity
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "gravity"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Gravity" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the gravity for the font description."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_set_gravity" pango_font_description_set_gravity :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    CUInt ->                                -- gravity : TInterface (Name {namespace = "Pango", name = "Gravity"})
    IO ()

-- | Sets the gravity field of a font description. The gravity field
-- specifies how the glyphs should be rotated.  If /@gravity@/ is
-- 'GI.Pango.Enums.GravityAuto', this actually unsets the gravity mask on
-- the font description.
-- 
-- This function is seldom useful to the user.  Gravity should normally
-- be set on a t'GI.Pango.Objects.Context.Context'.
-- 
-- /Since: 1.16/
fontDescriptionSetGravity ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> Pango.Enums.Gravity
    -- ^ /@gravity@/: the gravity for the font description.
    -> m ()
fontDescriptionSetGravity :: FontDescription -> Gravity -> m ()
fontDescriptionSetGravity desc :: FontDescription
desc gravity :: Gravity
gravity = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    let gravity' :: CUInt
gravity' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Gravity -> Int) -> Gravity -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gravity -> Int
forall a. Enum a => a -> Int
fromEnum) Gravity
gravity
    Ptr FontDescription -> CUInt -> IO ()
pango_font_description_set_gravity Ptr FontDescription
desc' CUInt
gravity'
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontDescriptionSetGravityMethodInfo
instance (signature ~ (Pango.Enums.Gravity -> m ()), MonadIO m) => O.MethodInfo FontDescriptionSetGravityMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionSetGravity

#endif

-- method FontDescription::set_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the size of the font in points, scaled by PANGO_SCALE. (That is,\n       a @size value of 10 * PANGO_SCALE is a 10 point font. The conversion\n       factor between points and device units depends on system configuration\n       and the output device. For screen display, a logical DPI of 96 is\n       common, in which case a 10 point font corresponds to a 10 * (96 / 72) = 13.3\n       pixel font. Use pango_font_description_set_absolute_size() if you need\n       a particular size in device units."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_set_size" pango_font_description_set_size :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    Int32 ->                                -- size : TBasicType TInt
    IO ()

-- | Sets the size field of a font description in fractional points. This is mutually
-- exclusive with 'GI.Pango.Structs.FontDescription.fontDescriptionSetAbsoluteSize'.
fontDescriptionSetSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> Int32
    -- ^ /@size@/: the size of the font in points, scaled by PANGO_SCALE. (That is,
    --        a /@size@/ value of 10 * PANGO_SCALE is a 10 point font. The conversion
    --        factor between points and device units depends on system configuration
    --        and the output device. For screen display, a logical DPI of 96 is
    --        common, in which case a 10 point font corresponds to a 10 * (96 \/ 72) = 13.3
    --        pixel font. Use 'GI.Pango.Structs.FontDescription.fontDescriptionSetAbsoluteSize' if you need
    --        a particular size in device units.
    -> m ()
fontDescriptionSetSize :: FontDescription -> Int32 -> m ()
fontDescriptionSetSize desc :: FontDescription
desc size :: Int32
size = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    Ptr FontDescription -> Int32 -> IO ()
pango_font_description_set_size Ptr FontDescription
desc' Int32
size
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontDescriptionSetSizeMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m) => O.MethodInfo FontDescriptionSetSizeMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionSetSize

#endif

-- method FontDescription::set_stretch
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stretch"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Stretch" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the stretch for the font description"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_set_stretch" pango_font_description_set_stretch :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    CUInt ->                                -- stretch : TInterface (Name {namespace = "Pango", name = "Stretch"})
    IO ()

-- | Sets the stretch field of a font description. The stretch field
-- specifies how narrow or wide the font should be.
fontDescriptionSetStretch ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> Pango.Enums.Stretch
    -- ^ /@stretch@/: the stretch for the font description
    -> m ()
fontDescriptionSetStretch :: FontDescription -> Stretch -> m ()
fontDescriptionSetStretch desc :: FontDescription
desc stretch :: Stretch
stretch = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    let stretch' :: CUInt
stretch' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Stretch -> Int) -> Stretch -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stretch -> Int
forall a. Enum a => a -> Int
fromEnum) Stretch
stretch
    Ptr FontDescription -> CUInt -> IO ()
pango_font_description_set_stretch Ptr FontDescription
desc' CUInt
stretch'
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontDescriptionSetStretchMethodInfo
instance (signature ~ (Pango.Enums.Stretch -> m ()), MonadIO m) => O.MethodInfo FontDescriptionSetStretchMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionSetStretch

#endif

-- method FontDescription::set_style
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "style"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Style" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the style for the font description"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_set_style" pango_font_description_set_style :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    CUInt ->                                -- style : TInterface (Name {namespace = "Pango", name = "Style"})
    IO ()

-- | Sets the style field of a t'GI.Pango.Structs.FontDescription.FontDescription'. The
-- t'GI.Pango.Enums.Style' enumeration describes whether the font is slanted and
-- the manner in which it is slanted; it can be either
-- @/PANGO_STYLE_NORMAL/@, @/PANGO_STYLE_ITALIC/@, or @/PANGO_STYLE_OBLIQUE/@.
-- Most fonts will either have a italic style or an oblique
-- style, but not both, and font matching in Pango will
-- match italic specifications with oblique fonts and vice-versa
-- if an exact match is not found.
fontDescriptionSetStyle ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> Pango.Enums.Style
    -- ^ /@style@/: the style for the font description
    -> m ()
fontDescriptionSetStyle :: FontDescription -> Style -> m ()
fontDescriptionSetStyle desc :: FontDescription
desc style :: Style
style = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    let style' :: CUInt
style' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Style -> Int) -> Style -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> Int
forall a. Enum a => a -> Int
fromEnum) Style
style
    Ptr FontDescription -> CUInt -> IO ()
pango_font_description_set_style Ptr FontDescription
desc' CUInt
style'
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontDescriptionSetStyleMethodInfo
instance (signature ~ (Pango.Enums.Style -> m ()), MonadIO m) => O.MethodInfo FontDescriptionSetStyleMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionSetStyle

#endif

-- method FontDescription::set_variant
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "variant"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Variant" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the variant type for the font description."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_set_variant" pango_font_description_set_variant :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    CUInt ->                                -- variant : TInterface (Name {namespace = "Pango", name = "Variant"})
    IO ()

-- | Sets the variant field of a font description. The t'GI.Pango.Enums.Variant'
-- can either be 'GI.Pango.Enums.VariantNormal' or 'GI.Pango.Enums.VariantSmallCaps'.
fontDescriptionSetVariant ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> Pango.Enums.Variant
    -- ^ /@variant@/: the variant type for the font description.
    -> m ()
fontDescriptionSetVariant :: FontDescription -> Variant -> m ()
fontDescriptionSetVariant desc :: FontDescription
desc variant :: Variant
variant = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    let variant' :: CUInt
variant' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Variant -> Int) -> Variant -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variant -> Int
forall a. Enum a => a -> Int
fromEnum) Variant
variant
    Ptr FontDescription -> CUInt -> IO ()
pango_font_description_set_variant Ptr FontDescription
desc' CUInt
variant'
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontDescriptionSetVariantMethodInfo
instance (signature ~ (Pango.Enums.Variant -> m ()), MonadIO m) => O.MethodInfo FontDescriptionSetVariantMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionSetVariant

#endif

-- method FontDescription::set_variations
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "settings"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_set_variations" pango_font_description_set_variations :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    CString ->                              -- settings : TBasicType TUTF8
    IO ()

-- | Sets the variations field of a font description. OpenType
-- font variations allow to select a font instance by specifying
-- values for a number of axes, such as width or weight.
-- 
-- The format of the variations string is AXIS1=VALUE,AXIS2=VALUE...,
-- with each AXIS a 4 character tag that identifies a font axis,
-- and each VALUE a floating point number. Unknown axes are ignored,
-- and values are clamped to their allowed range.
-- 
-- Pango does not currently have a way to find supported axes of
-- a font. Both harfbuzz or freetype have API for this.
-- 
-- /Since: 1.42/
fontDescriptionSetVariations ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'.
    -> T.Text
    -> m ()
fontDescriptionSetVariations :: FontDescription -> Text -> m ()
fontDescriptionSetVariations desc :: FontDescription
desc settings :: Text
settings = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    CString
settings' <- Text -> IO CString
textToCString Text
settings
    Ptr FontDescription -> CString -> IO ()
pango_font_description_set_variations Ptr FontDescription
desc' CString
settings'
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
settings'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontDescriptionSetVariationsMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.MethodInfo FontDescriptionSetVariationsMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionSetVariations

#endif

-- method FontDescription::set_variations_static
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "settings"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_set_variations_static" pango_font_description_set_variations_static :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    CString ->                              -- settings : TBasicType TUTF8
    IO ()

-- | Like 'GI.Pango.Structs.FontDescription.fontDescriptionSetVariations', except that no
-- copy of /@variations@/ is made. The caller must make sure that the
-- string passed in stays around until /@desc@/ has been freed
-- or the name is set again. This function can be used if
-- /@variations@/ is a static string such as a C string literal, or
-- if /@desc@/ is only needed temporarily.
-- 
-- /Since: 1.42/
fontDescriptionSetVariationsStatic ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> T.Text
    -> m ()
fontDescriptionSetVariationsStatic :: FontDescription -> Text -> m ()
fontDescriptionSetVariationsStatic desc :: FontDescription
desc settings :: Text
settings = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    CString
settings' <- Text -> IO CString
textToCString Text
settings
    Ptr FontDescription -> CString -> IO ()
pango_font_description_set_variations_static Ptr FontDescription
desc' CString
settings'
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
settings'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontDescriptionSetVariationsStaticMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.MethodInfo FontDescriptionSetVariationsStaticMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionSetVariationsStatic

#endif

-- method FontDescription::set_weight
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "weight"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Weight" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the weight for the font description."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_set_weight" pango_font_description_set_weight :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    CUInt ->                                -- weight : TInterface (Name {namespace = "Pango", name = "Weight"})
    IO ()

-- | Sets the weight field of a font description. The weight field
-- specifies how bold or light the font should be. In addition
-- to the values of the t'GI.Pango.Enums.Weight' enumeration, other intermediate
-- numeric values are possible.
fontDescriptionSetWeight ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> Pango.Enums.Weight
    -- ^ /@weight@/: the weight for the font description.
    -> m ()
fontDescriptionSetWeight :: FontDescription -> Weight -> m ()
fontDescriptionSetWeight desc :: FontDescription
desc weight :: Weight
weight = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    let weight' :: CUInt
weight' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Weight -> Int) -> Weight -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Weight -> Int
forall a. Enum a => a -> Int
fromEnum) Weight
weight
    Ptr FontDescription -> CUInt -> IO ()
pango_font_description_set_weight Ptr FontDescription
desc' CUInt
weight'
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontDescriptionSetWeightMethodInfo
instance (signature ~ (Pango.Enums.Weight -> m ()), MonadIO m) => O.MethodInfo FontDescriptionSetWeightMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionSetWeight

#endif

-- method FontDescription::to_filename
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , 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 "pango_font_description_to_filename" pango_font_description_to_filename :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    IO CString

-- | Creates a filename representation of a font description. The
-- filename is identical to the result from calling
-- 'GI.Pango.Structs.FontDescription.fontDescriptionToString', but with underscores instead of
-- characters that are untypical in filenames, and in lower case only.
fontDescriptionToFilename ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> m T.Text
    -- ^ __Returns:__ a new string that must be freed with 'GI.GLib.Functions.free'.
fontDescriptionToFilename :: FontDescription -> m Text
fontDescriptionToFilename desc :: FontDescription
desc = 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 FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    CString
result <- Ptr FontDescription -> IO CString
pango_font_description_to_filename Ptr FontDescription
desc'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "fontDescriptionToFilename" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data FontDescriptionToFilenameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo FontDescriptionToFilenameMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionToFilename

#endif

-- method FontDescription::to_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , 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 "pango_font_description_to_string" pango_font_description_to_string :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    IO CString

-- | Creates a string representation of a font description. See
-- 'GI.Pango.Functions.fontDescriptionFromString' for a description of the
-- format of the string representation. The family list in the
-- string description will only have a terminating comma if the
-- last word of the list is a valid style option.
fontDescriptionToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> m T.Text
    -- ^ __Returns:__ a new string that must be freed with 'GI.GLib.Functions.free'.
fontDescriptionToString :: FontDescription -> m Text
fontDescriptionToString desc :: FontDescription
desc = 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 FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    CString
result <- Ptr FontDescription -> IO CString
pango_font_description_to_string Ptr FontDescription
desc'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "fontDescriptionToString" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data FontDescriptionToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo FontDescriptionToStringMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionToString

#endif

-- method FontDescription::unset_fields
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontDescription"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "to_unset"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontMask" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "bitmask of fields in the @desc to unset."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_unset_fields" pango_font_description_unset_fields :: 
    Ptr FontDescription ->                  -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    CUInt ->                                -- to_unset : TInterface (Name {namespace = "Pango", name = "FontMask"})
    IO ()

-- | Unsets some of the fields in a t'GI.Pango.Structs.FontDescription.FontDescription'.  The unset
-- fields will get back to their default values.
fontDescriptionUnsetFields ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription'
    -> [Pango.Flags.FontMask]
    -- ^ /@toUnset@/: bitmask of fields in the /@desc@/ to unset.
    -> m ()
fontDescriptionUnsetFields :: FontDescription -> [FontMask] -> m ()
fontDescriptionUnsetFields desc :: FontDescription
desc toUnset :: [FontMask]
toUnset = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    let toUnset' :: CUInt
toUnset' = [FontMask] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FontMask]
toUnset
    Ptr FontDescription -> CUInt -> IO ()
pango_font_description_unset_fields Ptr FontDescription
desc' CUInt
toUnset'
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontDescriptionUnsetFieldsMethodInfo
instance (signature ~ ([Pango.Flags.FontMask] -> m ()), MonadIO m) => O.MethodInfo FontDescriptionUnsetFieldsMethodInfo FontDescription signature where
    overloadedMethod = fontDescriptionUnsetFields

#endif

-- method FontDescription::from_string
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "str"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "string representation of a font description."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Pango" , name = "FontDescription" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_description_from_string" pango_font_description_from_string :: 
    CString ->                              -- str : TBasicType TUTF8
    IO (Ptr FontDescription)

-- | Creates a new font description from a string representation in the
-- form \"[FAMILY-LIST] [STYLE-OPTIONS] [SIZE]\", where FAMILY-LIST is a
-- comma separated list of families optionally terminated by a comma,
-- STYLE_OPTIONS is a whitespace separated list of words where each word
-- describes one of style, variant, weight, stretch, or gravity, and SIZE
-- is a decimal number (size in points) or optionally followed by the
-- unit modifier \"px\" for absolute size. Any one of the options may
-- be absent.  If FAMILY-LIST is absent, then the family_name field of
-- the resulting font description will be initialized to 'P.Nothing'.  If
-- STYLE-OPTIONS is missing, then all style options will be set to the
-- default values. If SIZE is missing, the size in the resulting font
-- description will be set to 0.
fontDescriptionFromString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@str@/: string representation of a font description.
    -> m FontDescription
    -- ^ __Returns:__ a new t'GI.Pango.Structs.FontDescription.FontDescription'.
fontDescriptionFromString :: Text -> m FontDescription
fontDescriptionFromString str :: Text
str = IO FontDescription -> m FontDescription
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FontDescription -> m FontDescription)
-> IO FontDescription -> m FontDescription
forall a b. (a -> b) -> a -> b
$ do
    CString
str' <- Text -> IO CString
textToCString Text
str
    Ptr FontDescription
result <- CString -> IO (Ptr FontDescription)
pango_font_description_from_string CString
str'
    Text -> Ptr FontDescription -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "fontDescriptionFromString" Ptr FontDescription
result
    FontDescription
result' <- ((ManagedPtr FontDescription -> FontDescription)
-> Ptr FontDescription -> IO FontDescription
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FontDescription -> FontDescription
FontDescription) Ptr FontDescription
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
str'
    FontDescription -> IO FontDescription
forall (m :: * -> *) a. Monad m => a -> m a
return FontDescription
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveFontDescriptionMethod (t :: Symbol) (o :: *) :: * where
    ResolveFontDescriptionMethod "betterMatch" o = FontDescriptionBetterMatchMethodInfo
    ResolveFontDescriptionMethod "copy" o = FontDescriptionCopyMethodInfo
    ResolveFontDescriptionMethod "copyStatic" o = FontDescriptionCopyStaticMethodInfo
    ResolveFontDescriptionMethod "equal" o = FontDescriptionEqualMethodInfo
    ResolveFontDescriptionMethod "free" o = FontDescriptionFreeMethodInfo
    ResolveFontDescriptionMethod "hash" o = FontDescriptionHashMethodInfo
    ResolveFontDescriptionMethod "merge" o = FontDescriptionMergeMethodInfo
    ResolveFontDescriptionMethod "mergeStatic" o = FontDescriptionMergeStaticMethodInfo
    ResolveFontDescriptionMethod "toFilename" o = FontDescriptionToFilenameMethodInfo
    ResolveFontDescriptionMethod "toString" o = FontDescriptionToStringMethodInfo
    ResolveFontDescriptionMethod "unsetFields" o = FontDescriptionUnsetFieldsMethodInfo
    ResolveFontDescriptionMethod "getFamily" o = FontDescriptionGetFamilyMethodInfo
    ResolveFontDescriptionMethod "getGravity" o = FontDescriptionGetGravityMethodInfo
    ResolveFontDescriptionMethod "getSetFields" o = FontDescriptionGetSetFieldsMethodInfo
    ResolveFontDescriptionMethod "getSize" o = FontDescriptionGetSizeMethodInfo
    ResolveFontDescriptionMethod "getSizeIsAbsolute" o = FontDescriptionGetSizeIsAbsoluteMethodInfo
    ResolveFontDescriptionMethod "getStretch" o = FontDescriptionGetStretchMethodInfo
    ResolveFontDescriptionMethod "getStyle" o = FontDescriptionGetStyleMethodInfo
    ResolveFontDescriptionMethod "getVariant" o = FontDescriptionGetVariantMethodInfo
    ResolveFontDescriptionMethod "getVariations" o = FontDescriptionGetVariationsMethodInfo
    ResolveFontDescriptionMethod "getWeight" o = FontDescriptionGetWeightMethodInfo
    ResolveFontDescriptionMethod "setAbsoluteSize" o = FontDescriptionSetAbsoluteSizeMethodInfo
    ResolveFontDescriptionMethod "setFamily" o = FontDescriptionSetFamilyMethodInfo
    ResolveFontDescriptionMethod "setFamilyStatic" o = FontDescriptionSetFamilyStaticMethodInfo
    ResolveFontDescriptionMethod "setGravity" o = FontDescriptionSetGravityMethodInfo
    ResolveFontDescriptionMethod "setSize" o = FontDescriptionSetSizeMethodInfo
    ResolveFontDescriptionMethod "setStretch" o = FontDescriptionSetStretchMethodInfo
    ResolveFontDescriptionMethod "setStyle" o = FontDescriptionSetStyleMethodInfo
    ResolveFontDescriptionMethod "setVariant" o = FontDescriptionSetVariantMethodInfo
    ResolveFontDescriptionMethod "setVariations" o = FontDescriptionSetVariationsMethodInfo
    ResolveFontDescriptionMethod "setVariationsStatic" o = FontDescriptionSetVariationsStaticMethodInfo
    ResolveFontDescriptionMethod "setWeight" o = FontDescriptionSetWeightMethodInfo
    ResolveFontDescriptionMethod l o = O.MethodResolutionFailed l o

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

#endif