{-# 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.Objects.FontFace.FontFace' structure is used to represent a group of fonts with
-- the same family, slant, weight, width, but varying sizes.

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

module GI.Pango.Objects.FontFace
    ( 

-- * Exported types
    FontFace(..)                            ,
    IsFontFace                              ,
    toFontFace                              ,
    noFontFace                              ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveFontFaceMethod                   ,
#endif


-- ** describe #method:describe#

#if defined(ENABLE_OVERLOADING)
    FontFaceDescribeMethodInfo              ,
#endif
    fontFaceDescribe                        ,


-- ** getFaceName #method:getFaceName#

#if defined(ENABLE_OVERLOADING)
    FontFaceGetFaceNameMethodInfo           ,
#endif
    fontFaceGetFaceName                     ,


-- ** isSynthesized #method:isSynthesized#

#if defined(ENABLE_OVERLOADING)
    FontFaceIsSynthesizedMethodInfo         ,
#endif
    fontFaceIsSynthesized                   ,


-- ** listSizes #method:listSizes#

#if defined(ENABLE_OVERLOADING)
    FontFaceListSizesMethodInfo             ,
#endif
    fontFaceListSizes                       ,




    ) 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 qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Pango.Structs.FontDescription as Pango.FontDescription

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

instance GObject FontFace where
    gobjectType :: IO GType
gobjectType = IO GType
c_pango_font_face_get_type
    

-- | Convert 'FontFace' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue FontFace where
    toGValue :: FontFace -> IO GValue
toGValue o :: FontFace
o = do
        GType
gtype <- IO GType
c_pango_font_face_get_type
        FontFace -> (Ptr FontFace -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr FontFace
o (GType
-> (GValue -> Ptr FontFace -> IO ()) -> Ptr FontFace -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr FontFace -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO FontFace
fromGValue gv :: GValue
gv = do
        Ptr FontFace
ptr <- GValue -> IO (Ptr FontFace)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr FontFace)
        (ManagedPtr FontFace -> FontFace) -> Ptr FontFace -> IO FontFace
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr FontFace -> FontFace
FontFace Ptr FontFace
ptr
        
    

-- | Type class for types which can be safely cast to `FontFace`, for instance with `toFontFace`.
class (GObject o, O.IsDescendantOf FontFace o) => IsFontFace o
instance (GObject o, O.IsDescendantOf FontFace o) => IsFontFace o

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

-- | Cast to `FontFace`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toFontFace :: (MonadIO m, IsFontFace o) => o -> m FontFace
toFontFace :: o -> m FontFace
toFontFace = IO FontFace -> m FontFace
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FontFace -> m FontFace)
-> (o -> IO FontFace) -> o -> m FontFace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr FontFace -> FontFace) -> o -> IO FontFace
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr FontFace -> FontFace
FontFace

-- | A convenience alias for `Nothing` :: `Maybe` `FontFace`.
noFontFace :: Maybe FontFace
noFontFace :: Maybe FontFace
noFontFace = Maybe FontFace
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveFontFaceMethod (t :: Symbol) (o :: *) :: * where
    ResolveFontFaceMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveFontFaceMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveFontFaceMethod "describe" o = FontFaceDescribeMethodInfo
    ResolveFontFaceMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveFontFaceMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveFontFaceMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveFontFaceMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveFontFaceMethod "isSynthesized" o = FontFaceIsSynthesizedMethodInfo
    ResolveFontFaceMethod "listSizes" o = FontFaceListSizesMethodInfo
    ResolveFontFaceMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveFontFaceMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveFontFaceMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveFontFaceMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveFontFaceMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveFontFaceMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveFontFaceMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveFontFaceMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveFontFaceMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveFontFaceMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveFontFaceMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveFontFaceMethod "getFaceName" o = FontFaceGetFaceNameMethodInfo
    ResolveFontFaceMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveFontFaceMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveFontFaceMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveFontFaceMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveFontFaceMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveFontFaceMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method FontFace::describe
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "face"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontFace" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontFace" , 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_face_describe" pango_font_face_describe :: 
    Ptr FontFace ->                         -- face : TInterface (Name {namespace = "Pango", name = "FontFace"})
    IO (Ptr Pango.FontDescription.FontDescription)

-- | Returns the family, style, variant, weight and stretch of
-- a t'GI.Pango.Objects.FontFace.FontFace'. The size field of the resulting font description
-- will be unset.
fontFaceDescribe ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontFace a) =>
    a
    -- ^ /@face@/: a t'GI.Pango.Objects.FontFace.FontFace'
    -> m Pango.FontDescription.FontDescription
    -- ^ __Returns:__ a newly-created t'GI.Pango.Structs.FontDescription.FontDescription' structure
    --  holding the description of the face. Use 'GI.Pango.Structs.FontDescription.fontDescriptionFree'
    --  to free the result.
fontFaceDescribe :: a -> m FontDescription
fontFaceDescribe face :: a
face = 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 FontFace
face' <- a -> IO (Ptr FontFace)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
face
    Ptr FontDescription
result <- Ptr FontFace -> IO (Ptr FontDescription)
pango_font_face_describe Ptr FontFace
face'
    Text -> Ptr FontDescription -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "fontFaceDescribe" 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
Pango.FontDescription.FontDescription) Ptr FontDescription
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
face
    FontDescription -> IO FontDescription
forall (m :: * -> *) a. Monad m => a -> m a
return FontDescription
result'

#if defined(ENABLE_OVERLOADING)
data FontFaceDescribeMethodInfo
instance (signature ~ (m Pango.FontDescription.FontDescription), MonadIO m, IsFontFace a) => O.MethodInfo FontFaceDescribeMethodInfo a signature where
    overloadedMethod = fontFaceDescribe

#endif

-- method FontFace::get_face_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "face"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontFace" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontFace." , 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_face_get_face_name" pango_font_face_get_face_name :: 
    Ptr FontFace ->                         -- face : TInterface (Name {namespace = "Pango", name = "FontFace"})
    IO CString

-- | Gets a name representing the style of this face among the
-- different faces in the t'GI.Pango.Objects.FontFamily.FontFamily' for the face. This
-- name is unique among all faces in the family and is suitable
-- for displaying to users.
fontFaceGetFaceName ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontFace a) =>
    a
    -- ^ /@face@/: a t'GI.Pango.Objects.FontFace.FontFace'.
    -> m T.Text
    -- ^ __Returns:__ the face name for the face. This string is
    --   owned by the face object and must not be modified or freed.
fontFaceGetFaceName :: a -> m Text
fontFaceGetFaceName face :: a
face = 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 FontFace
face' <- a -> IO (Ptr FontFace)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
face
    CString
result <- Ptr FontFace -> IO CString
pango_font_face_get_face_name Ptr FontFace
face'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "fontFaceGetFaceName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
face
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data FontFaceGetFaceNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsFontFace a) => O.MethodInfo FontFaceGetFaceNameMethodInfo a signature where
    overloadedMethod = fontFaceGetFaceName

#endif

-- method FontFace::is_synthesized
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "face"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontFace" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontFace" , 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_face_is_synthesized" pango_font_face_is_synthesized :: 
    Ptr FontFace ->                         -- face : TInterface (Name {namespace = "Pango", name = "FontFace"})
    IO CInt

-- | Returns whether a t'GI.Pango.Objects.FontFace.FontFace' is synthesized by the underlying
-- font rendering engine from another face, perhaps by shearing, emboldening,
-- or lightening it.
-- 
-- /Since: 1.18/
fontFaceIsSynthesized ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontFace a) =>
    a
    -- ^ /@face@/: a t'GI.Pango.Objects.FontFace.FontFace'
    -> m Bool
    -- ^ __Returns:__ whether /@face@/ is synthesized.
fontFaceIsSynthesized :: a -> m Bool
fontFaceIsSynthesized face :: a
face = 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 FontFace
face' <- a -> IO (Ptr FontFace)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
face
    CInt
result <- Ptr FontFace -> IO CInt
pango_font_face_is_synthesized Ptr FontFace
face'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
face
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FontFaceIsSynthesizedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFontFace a) => O.MethodInfo FontFaceIsSynthesizedMethodInfo a signature where
    overloadedMethod = fontFaceIsSynthesized

#endif

-- method FontFace::list_sizes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "face"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontFace" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontFace." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sizes"
--           , argType = TCArray False (-1) 2 (TBasicType TInt)
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "\n        location to store a pointer to an array of int. This array\n        should be freed with g_free()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "n_sizes"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "location to store the number of elements in @sizes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_sizes"
--              , argType = TBasicType TInt
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just "location to store the number of elements in @sizes"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_face_list_sizes" pango_font_face_list_sizes :: 
    Ptr FontFace ->                         -- face : TInterface (Name {namespace = "Pango", name = "FontFace"})
    Ptr (Ptr Int32) ->                      -- sizes : TCArray False (-1) 2 (TBasicType TInt)
    Ptr Int32 ->                            -- n_sizes : TBasicType TInt
    IO ()

-- | List the available sizes for a font. This is only applicable to bitmap
-- fonts. For scalable fonts, stores 'P.Nothing' at the location pointed to by
-- /@sizes@/ and 0 at the location pointed to by /@nSizes@/. The sizes returned
-- are in Pango units and are sorted in ascending order.
-- 
-- /Since: 1.4/
fontFaceListSizes ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontFace a) =>
    a
    -- ^ /@face@/: a t'GI.Pango.Objects.FontFace.FontFace'.
    -> m ((Maybe [Int32]))
fontFaceListSizes :: a -> m (Maybe [Int32])
fontFaceListSizes face :: a
face = IO (Maybe [Int32]) -> m (Maybe [Int32])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Int32]) -> m (Maybe [Int32]))
-> IO (Maybe [Int32]) -> m (Maybe [Int32])
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontFace
face' <- a -> IO (Ptr FontFace)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
face
    Ptr (Ptr Int32)
sizes <- IO (Ptr (Ptr Int32))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Int32))
    Ptr Int32
nSizes <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr FontFace -> Ptr (Ptr Int32) -> Ptr Int32 -> IO ()
pango_font_face_list_sizes Ptr FontFace
face' Ptr (Ptr Int32)
sizes Ptr Int32
nSizes
    Int32
nSizes' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
nSizes
    Ptr Int32
sizes' <- Ptr (Ptr Int32) -> IO (Ptr Int32)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Int32)
sizes
    Maybe [Int32]
maybeSizes' <- Ptr Int32 -> (Ptr Int32 -> IO [Int32]) -> IO (Maybe [Int32])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Int32
sizes' ((Ptr Int32 -> IO [Int32]) -> IO (Maybe [Int32]))
-> (Ptr Int32 -> IO [Int32]) -> IO (Maybe [Int32])
forall a b. (a -> b) -> a -> b
$ \sizes'' :: Ptr Int32
sizes'' -> do
        [Int32]
sizes''' <- (Int32 -> Ptr Int32 -> IO [Int32]
forall a b. (Integral a, Storable b) => a -> Ptr b -> IO [b]
unpackStorableArrayWithLength Int32
nSizes') Ptr Int32
sizes''
        Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
sizes''
        [Int32] -> IO [Int32]
forall (m :: * -> *) a. Monad m => a -> m a
return [Int32]
sizes'''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
face
    Ptr (Ptr Int32) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Int32)
sizes
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
nSizes
    Maybe [Int32] -> IO (Maybe [Int32])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Int32]
maybeSizes'

#if defined(ENABLE_OVERLOADING)
data FontFaceListSizesMethodInfo
instance (signature ~ (m ((Maybe [Int32]))), MonadIO m, IsFontFace a) => O.MethodInfo FontFaceListSizesMethodInfo a signature where
    overloadedMethod = fontFaceListSizes

#endif