{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Pango.Structs.AttrFontDesc
(
AttrFontDesc(..) ,
newZeroAttrFontDesc ,
#if defined(ENABLE_OVERLOADING)
ResolveAttrFontDescMethod ,
#endif
attrFontDescNew ,
#if defined(ENABLE_OVERLOADING)
attrFontDesc_attr ,
#endif
getAttrFontDescAttr ,
#if defined(ENABLE_OVERLOADING)
attrFontDesc_desc ,
#endif
clearAttrFontDescDesc ,
getAttrFontDescDesc ,
setAttrFontDescDesc ,
) where
import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P
import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import {-# SOURCE #-} qualified GI.Pango.Structs.Attribute as Pango.Attribute
import {-# SOURCE #-} qualified GI.Pango.Structs.FontDescription as Pango.FontDescription
newtype AttrFontDesc = AttrFontDesc (SP.ManagedPtr AttrFontDesc)
deriving (AttrFontDesc -> AttrFontDesc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttrFontDesc -> AttrFontDesc -> Bool
$c/= :: AttrFontDesc -> AttrFontDesc -> Bool
== :: AttrFontDesc -> AttrFontDesc -> Bool
$c== :: AttrFontDesc -> AttrFontDesc -> Bool
Eq)
instance SP.ManagedPtrNewtype AttrFontDesc where
toManagedPtr :: AttrFontDesc -> ManagedPtr AttrFontDesc
toManagedPtr (AttrFontDesc ManagedPtr AttrFontDesc
p) = ManagedPtr AttrFontDesc
p
instance BoxedPtr AttrFontDesc where
boxedPtrCopy :: AttrFontDesc -> IO AttrFontDesc
boxedPtrCopy = \AttrFontDesc
p -> forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr AttrFontDesc
p (forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
16 forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr AttrFontDesc -> AttrFontDesc
AttrFontDesc)
boxedPtrFree :: AttrFontDesc -> IO ()
boxedPtrFree = \AttrFontDesc
x -> forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr AttrFontDesc
x forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr AttrFontDesc where
boxedPtrCalloc :: IO (Ptr AttrFontDesc)
boxedPtrCalloc = forall a. Int -> IO (Ptr a)
callocBytes Int
16
newZeroAttrFontDesc :: MonadIO m => m AttrFontDesc
newZeroAttrFontDesc :: forall (m :: * -> *). MonadIO m => m AttrFontDesc
newZeroAttrFontDesc = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr AttrFontDesc -> AttrFontDesc
AttrFontDesc
instance tag ~ 'AttrSet => Constructible AttrFontDesc tag where
new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr AttrFontDesc -> AttrFontDesc)
-> [AttrOp AttrFontDesc tag] -> m AttrFontDesc
new ManagedPtr AttrFontDesc -> AttrFontDesc
_ [AttrOp AttrFontDesc tag]
attrs = do
AttrFontDesc
o <- forall (m :: * -> *). MonadIO m => m AttrFontDesc
newZeroAttrFontDesc
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set AttrFontDesc
o [AttrOp AttrFontDesc tag]
attrs
forall (m :: * -> *) a. Monad m => a -> m a
return AttrFontDesc
o
getAttrFontDescAttr :: MonadIO m => AttrFontDesc -> m Pango.Attribute.Attribute
getAttrFontDescAttr :: forall (m :: * -> *). MonadIO m => AttrFontDesc -> m Attribute
getAttrFontDescAttr AttrFontDesc
s = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AttrFontDesc
s forall a b. (a -> b) -> a -> b
$ \Ptr AttrFontDesc
ptr -> do
let val :: Ptr Attribute
val = Ptr AttrFontDesc
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: (Ptr Pango.Attribute.Attribute)
Attribute
val' <- (forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Attribute -> Attribute
Pango.Attribute.Attribute) Ptr Attribute
val
forall (m :: * -> *) a. Monad m => a -> m a
return Attribute
val'
#if defined(ENABLE_OVERLOADING)
data AttrFontDescAttrFieldInfo
instance AttrInfo AttrFontDescAttrFieldInfo where
type AttrBaseTypeConstraint AttrFontDescAttrFieldInfo = (~) AttrFontDesc
type AttrAllowedOps AttrFontDescAttrFieldInfo = '[ 'AttrGet]
type AttrSetTypeConstraint AttrFontDescAttrFieldInfo = (~) (Ptr Pango.Attribute.Attribute)
type AttrTransferTypeConstraint AttrFontDescAttrFieldInfo = (~)(Ptr Pango.Attribute.Attribute)
type AttrTransferType AttrFontDescAttrFieldInfo = (Ptr Pango.Attribute.Attribute)
type AttrGetType AttrFontDescAttrFieldInfo = Pango.Attribute.Attribute
type AttrLabel AttrFontDescAttrFieldInfo = "attr"
type AttrOrigin AttrFontDescAttrFieldInfo = AttrFontDesc
attrGet = getAttrFontDescAttr
attrSet = undefined
attrConstruct = undefined
attrClear = undefined
attrTransfer = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Pango.Structs.AttrFontDesc.attr"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.27/docs/GI-Pango-Structs-AttrFontDesc.html#g:attr:attr"
})
attrFontDesc_attr :: AttrLabelProxy "attr"
attrFontDesc_attr = AttrLabelProxy
#endif
getAttrFontDescDesc :: MonadIO m => AttrFontDesc -> m (Maybe Pango.FontDescription.FontDescription)
getAttrFontDescDesc :: forall (m :: * -> *).
MonadIO m =>
AttrFontDesc -> m (Maybe FontDescription)
getAttrFontDescDesc AttrFontDesc
s = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AttrFontDesc
s forall a b. (a -> b) -> a -> b
$ \Ptr AttrFontDesc
ptr -> do
Ptr FontDescription
val <- forall a. Storable a => Ptr a -> IO a
peek (Ptr AttrFontDesc
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12) :: IO (Ptr Pango.FontDescription.FontDescription)
Maybe FontDescription
result <- forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr FontDescription
val forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
val' -> do
FontDescription
val'' <- (forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr FontDescription -> FontDescription
Pango.FontDescription.FontDescription) Ptr FontDescription
val'
forall (m :: * -> *) a. Monad m => a -> m a
return FontDescription
val''
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FontDescription
result
setAttrFontDescDesc :: MonadIO m => AttrFontDesc -> Ptr Pango.FontDescription.FontDescription -> m ()
setAttrFontDescDesc :: forall (m :: * -> *).
MonadIO m =>
AttrFontDesc -> Ptr FontDescription -> m ()
setAttrFontDescDesc AttrFontDesc
s Ptr FontDescription
val = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AttrFontDesc
s forall a b. (a -> b) -> a -> b
$ \Ptr AttrFontDesc
ptr -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr AttrFontDesc
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12) (Ptr FontDescription
val :: Ptr Pango.FontDescription.FontDescription)
clearAttrFontDescDesc :: MonadIO m => AttrFontDesc -> m ()
clearAttrFontDescDesc :: forall (m :: * -> *). MonadIO m => AttrFontDesc -> m ()
clearAttrFontDescDesc AttrFontDesc
s = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AttrFontDesc
s forall a b. (a -> b) -> a -> b
$ \Ptr AttrFontDesc
ptr -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr AttrFontDesc
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12) (forall a. Ptr a
FP.nullPtr :: Ptr Pango.FontDescription.FontDescription)
#if defined(ENABLE_OVERLOADING)
data AttrFontDescDescFieldInfo
instance AttrInfo AttrFontDescDescFieldInfo where
type AttrBaseTypeConstraint AttrFontDescDescFieldInfo = (~) AttrFontDesc
type AttrAllowedOps AttrFontDescDescFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
type AttrSetTypeConstraint AttrFontDescDescFieldInfo = (~) (Ptr Pango.FontDescription.FontDescription)
type AttrTransferTypeConstraint AttrFontDescDescFieldInfo = (~)(Ptr Pango.FontDescription.FontDescription)
type AttrTransferType AttrFontDescDescFieldInfo = (Ptr Pango.FontDescription.FontDescription)
type AttrGetType AttrFontDescDescFieldInfo = Maybe Pango.FontDescription.FontDescription
type AttrLabel AttrFontDescDescFieldInfo = "desc"
type AttrOrigin AttrFontDescDescFieldInfo = AttrFontDesc
attrGet = getAttrFontDescDesc
attrSet = setAttrFontDescDesc
attrConstruct = undefined
attrClear = clearAttrFontDescDesc
attrTransfer _ v = do
return v
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Pango.Structs.AttrFontDesc.desc"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.27/docs/GI-Pango-Structs-AttrFontDesc.html#g:attr:desc"
})
attrFontDesc_desc :: AttrLabelProxy "desc"
attrFontDesc_desc = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList AttrFontDesc
type instance O.AttributeList AttrFontDesc = AttrFontDescAttributeList
type AttrFontDescAttributeList = ('[ '("attr", AttrFontDescAttrFieldInfo), '("desc", AttrFontDescDescFieldInfo)] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "pango_attr_font_desc_new" pango_attr_font_desc_new ::
Ptr Pango.FontDescription.FontDescription ->
IO (Ptr Pango.Attribute.Attribute)
attrFontDescNew ::
(B.CallStack.HasCallStack, MonadIO m) =>
Pango.FontDescription.FontDescription
-> m Pango.Attribute.Attribute
attrFontDescNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FontDescription -> m Attribute
attrFontDescNew FontDescription
desc = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Ptr FontDescription
desc' <- forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
Ptr Attribute
result <- Ptr FontDescription -> IO (Ptr Attribute)
pango_attr_font_desc_new Ptr FontDescription
desc'
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"attrFontDescNew" Ptr Attribute
result
Attribute
result' <- (forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Attribute -> Attribute
Pango.Attribute.Attribute) Ptr Attribute
result
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
forall (m :: * -> *) a. Monad m => a -> m a
return Attribute
result'
#if defined(ENABLE_OVERLOADING)
#endif
#if defined(ENABLE_OVERLOADING)
type family ResolveAttrFontDescMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveAttrFontDescMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveAttrFontDescMethod t AttrFontDesc, O.OverloadedMethod info AttrFontDesc p) => OL.IsLabel t (AttrFontDesc -> p) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.overloadedMethod @info
#else
fromLabel _ = O.overloadedMethod @info
#endif
#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveAttrFontDescMethod t AttrFontDesc, O.OverloadedMethod info AttrFontDesc p, R.HasField t AttrFontDesc p) => R.HasField t AttrFontDesc p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveAttrFontDescMethod t AttrFontDesc, O.OverloadedMethodInfo info AttrFontDesc) => OL.IsLabel t (O.MethodProxy info AttrFontDesc) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif