{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An opaque structure, to be used to store sizing and positioning
-- values along with their unit.
-- 
-- /Since: 1.0/

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

module GI.Clutter.Structs.Units
    ( 

-- * Exported types
    Units(..)                               ,
    newZeroUnits                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copy]("GI.Clutter.Structs.Units#g:method:copy"), [free]("GI.Clutter.Structs.Units#g:method:free"), [toPixels]("GI.Clutter.Structs.Units#g:method:toPixels"), [toString]("GI.Clutter.Structs.Units#g:method:toString").
-- 
-- ==== Getters
-- [getUnitType]("GI.Clutter.Structs.Units#g:method:getUnitType"), [getUnitValue]("GI.Clutter.Structs.Units#g:method:getUnitValue").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveUnitsMethod                      ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    UnitsCopyMethodInfo                     ,
#endif
    unitsCopy                               ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    UnitsFreeMethodInfo                     ,
#endif
    unitsFree                               ,


-- ** fromCm #method:fromCm#

    unitsFromCm                             ,


-- ** fromEm #method:fromEm#

    unitsFromEm                             ,


-- ** fromEmForFont #method:fromEmForFont#

    unitsFromEmForFont                      ,


-- ** fromMm #method:fromMm#

    unitsFromMm                             ,


-- ** fromPixels #method:fromPixels#

    unitsFromPixels                         ,


-- ** fromPt #method:fromPt#

    unitsFromPt                             ,


-- ** fromString #method:fromString#

    unitsFromString                         ,


-- ** getUnitType #method:getUnitType#

#if defined(ENABLE_OVERLOADING)
    UnitsGetUnitTypeMethodInfo              ,
#endif
    unitsGetUnitType                        ,


-- ** getUnitValue #method:getUnitValue#

#if defined(ENABLE_OVERLOADING)
    UnitsGetUnitValueMethodInfo             ,
#endif
    unitsGetUnitValue                       ,


-- ** toPixels #method:toPixels#

#if defined(ENABLE_OVERLOADING)
    UnitsToPixelsMethodInfo                 ,
#endif
    unitsToPixels                           ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    UnitsToStringMethodInfo                 ,
#endif
    unitsToString                           ,




    ) 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.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.Clutter.Enums as Clutter.Enums

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

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

foreign import ccall "clutter_units_get_type" c_clutter_units_get_type :: 
    IO GType

type instance O.ParentTypes Units = '[]
instance O.HasParentTypes Units

instance B.Types.TypedObject Units where
    glibType :: IO GType
glibType = IO GType
c_clutter_units_get_type

instance B.Types.GBoxed Units

-- | Convert 'Units' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Units) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_clutter_units_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Units -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Units
P.Nothing = Ptr GValue -> Ptr Units -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr Units
forall a. Ptr a
FP.nullPtr :: FP.Ptr Units)
    gvalueSet_ Ptr GValue
gv (P.Just Units
obj) = Units -> (Ptr Units -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Units
obj (Ptr GValue -> Ptr Units -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Units)
gvalueGet_ Ptr GValue
gv = do
        Ptr Units
ptr <- Ptr GValue -> IO (Ptr Units)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr Units)
        if Ptr Units
ptr Ptr Units -> Ptr Units -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Units
forall a. Ptr a
FP.nullPtr
        then Units -> Maybe Units
forall a. a -> Maybe a
P.Just (Units -> Maybe Units) -> IO Units -> IO (Maybe Units)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Units -> Units) -> Ptr Units -> IO Units
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Units -> Units
Units Ptr Units
ptr
        else Maybe Units -> IO (Maybe Units)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Units
forall a. Maybe a
P.Nothing
        
    

-- | Construct a `Units` struct initialized to zero.
newZeroUnits :: MonadIO m => m Units
newZeroUnits :: forall (m :: * -> *). MonadIO m => m Units
newZeroUnits = IO Units -> m Units
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Units -> m Units) -> IO Units -> m Units
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr Units)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
32 IO (Ptr Units) -> (Ptr Units -> IO Units) -> IO Units
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Units -> Units) -> Ptr Units -> IO Units
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Units -> Units
Units

instance tag ~ 'AttrSet => Constructible Units tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr Units -> Units) -> [AttrOp Units tag] -> m Units
new ManagedPtr Units -> Units
_ [AttrOp Units tag]
attrs = do
        Units
o <- m Units
forall (m :: * -> *). MonadIO m => m Units
newZeroUnits
        Units -> [AttrOp Units 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set Units
o [AttrOp Units tag]
[AttrOp Units 'AttrSet]
attrs
        Units -> m Units
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Units
o



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

-- method Units::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "units"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Units" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #ClutterUnits to copy"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Units" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_units_copy" clutter_units_copy :: 
    Ptr Units ->                            -- units : TInterface (Name {namespace = "Clutter", name = "Units"})
    IO (Ptr Units)

-- | Copies /@units@/
-- 
-- /Since: 1.0/
unitsCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Units
    -- ^ /@units@/: the t'GI.Clutter.Structs.Units.Units' to copy
    -> m Units
    -- ^ __Returns:__ the newly created copy of a
    --   t'GI.Clutter.Structs.Units.Units' structure. Use 'GI.Clutter.Structs.Units.unitsFree' to free
    --   the allocated resources
unitsCopy :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Units -> m Units
unitsCopy Units
units = IO Units -> m Units
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Units -> m Units) -> IO Units -> m Units
forall a b. (a -> b) -> a -> b
$ do
    Ptr Units
units' <- Units -> IO (Ptr Units)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Units
units
    Ptr Units
result <- Ptr Units -> IO (Ptr Units)
clutter_units_copy Ptr Units
units'
    Text -> Ptr Units -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"unitsCopy" Ptr Units
result
    Units
result' <- ((ManagedPtr Units -> Units) -> Ptr Units -> IO Units
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Units -> Units
Units) Ptr Units
result
    Units -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Units
units
    Units -> IO Units
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Units
result'

#if defined(ENABLE_OVERLOADING)
data UnitsCopyMethodInfo
instance (signature ~ (m Units), MonadIO m) => O.OverloadedMethod UnitsCopyMethodInfo Units signature where
    overloadedMethod = unitsCopy

instance O.OverloadedMethodInfo UnitsCopyMethodInfo Units where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Units.unitsCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-Units.html#v:unitsCopy"
        })


#endif

-- method Units::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "units"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Units" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #ClutterUnits to free"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_units_free" clutter_units_free :: 
    Ptr Units ->                            -- units : TInterface (Name {namespace = "Clutter", name = "Units"})
    IO ()

-- | Frees the resources allocated by /@units@/
-- 
-- You should only call this function on a t'GI.Clutter.Structs.Units.Units'
-- created using 'GI.Clutter.Structs.Units.unitsCopy'
-- 
-- /Since: 1.0/
unitsFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Units
    -- ^ /@units@/: the t'GI.Clutter.Structs.Units.Units' to free
    -> m ()
unitsFree :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Units -> m ()
unitsFree Units
units = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Units
units' <- Units -> IO (Ptr Units)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Units
units
    Ptr Units -> IO ()
clutter_units_free Ptr Units
units'
    Units -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Units
units
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data UnitsFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod UnitsFreeMethodInfo Units signature where
    overloadedMethod = unitsFree

instance O.OverloadedMethodInfo UnitsFreeMethodInfo Units where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Units.unitsFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-Units.html#v:unitsFree"
        })


#endif

-- method Units::get_unit_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "units"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Units" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterUnits" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "UnitType" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_units_get_unit_type" clutter_units_get_unit_type :: 
    Ptr Units ->                            -- units : TInterface (Name {namespace = "Clutter", name = "Units"})
    IO CUInt

-- | Retrieves the unit type of the value stored inside /@units@/
-- 
-- /Since: 1.0/
unitsGetUnitType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Units
    -- ^ /@units@/: a t'GI.Clutter.Structs.Units.Units'
    -> m Clutter.Enums.UnitType
    -- ^ __Returns:__ a unit type
unitsGetUnitType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Units -> m UnitType
unitsGetUnitType Units
units = IO UnitType -> m UnitType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UnitType -> m UnitType) -> IO UnitType -> m UnitType
forall a b. (a -> b) -> a -> b
$ do
    Ptr Units
units' <- Units -> IO (Ptr Units)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Units
units
    CUInt
result <- Ptr Units -> IO CUInt
clutter_units_get_unit_type Ptr Units
units'
    let result' :: UnitType
result' = (Int -> UnitType
forall a. Enum a => Int -> a
toEnum (Int -> UnitType) -> (CUInt -> Int) -> CUInt -> UnitType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    Units -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Units
units
    UnitType -> IO UnitType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return UnitType
result'

#if defined(ENABLE_OVERLOADING)
data UnitsGetUnitTypeMethodInfo
instance (signature ~ (m Clutter.Enums.UnitType), MonadIO m) => O.OverloadedMethod UnitsGetUnitTypeMethodInfo Units signature where
    overloadedMethod = unitsGetUnitType

instance O.OverloadedMethodInfo UnitsGetUnitTypeMethodInfo Units where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Units.unitsGetUnitType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-Units.html#v:unitsGetUnitType"
        })


#endif

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

foreign import ccall "clutter_units_get_unit_value" clutter_units_get_unit_value :: 
    Ptr Units ->                            -- units : TInterface (Name {namespace = "Clutter", name = "Units"})
    IO CFloat

-- | Retrieves the value stored inside /@units@/
-- 
-- /Since: 1.0/
unitsGetUnitValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Units
    -- ^ /@units@/: a t'GI.Clutter.Structs.Units.Units'
    -> m Float
    -- ^ __Returns:__ the value stored inside a t'GI.Clutter.Structs.Units.Units'
unitsGetUnitValue :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Units -> m Float
unitsGetUnitValue Units
units = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr Units
units' <- Units -> IO (Ptr Units)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Units
units
    CFloat
result <- Ptr Units -> IO CFloat
clutter_units_get_unit_value Ptr Units
units'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Units -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Units
units
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data UnitsGetUnitValueMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod UnitsGetUnitValueMethodInfo Units signature where
    overloadedMethod = unitsGetUnitValue

instance O.OverloadedMethodInfo UnitsGetUnitValueMethodInfo Units where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Units.unitsGetUnitValue",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-Units.html#v:unitsGetUnitValue"
        })


#endif

-- method Units::to_pixels
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "units"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Units" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "units to convert" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFloat)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_units_to_pixels" clutter_units_to_pixels :: 
    Ptr Units ->                            -- units : TInterface (Name {namespace = "Clutter", name = "Units"})
    IO CFloat

-- | Converts a value in t'GI.Clutter.Structs.Units.Units' to pixels
-- 
-- /Since: 1.0/
unitsToPixels ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Units
    -- ^ /@units@/: units to convert
    -> m Float
    -- ^ __Returns:__ the value in pixels
unitsToPixels :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Units -> m Float
unitsToPixels Units
units = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr Units
units' <- Units -> IO (Ptr Units)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Units
units
    CFloat
result <- Ptr Units -> IO CFloat
clutter_units_to_pixels Ptr Units
units'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Units -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Units
units
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data UnitsToPixelsMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod UnitsToPixelsMethodInfo Units signature where
    overloadedMethod = unitsToPixels

instance O.OverloadedMethodInfo UnitsToPixelsMethodInfo Units where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Units.unitsToPixels",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-Units.html#v:unitsToPixels"
        })


#endif

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

-- | Converts /@units@/ into a string
-- 
-- See 'GI.Clutter.Functions.unitsFromString' for the units syntax and for
-- examples of output
-- 
-- Fractional values are truncated to the second decimal
-- position for em, mm and cm, and to the first decimal position for
-- typographic points. Pixels are integers.
-- 
-- /Since: 1.0/
unitsToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Units
    -- ^ /@units@/: a t'GI.Clutter.Structs.Units.Units'
    -> m T.Text
    -- ^ __Returns:__ a newly allocated string containing the encoded
    --   t'GI.Clutter.Structs.Units.Units' value. Use 'GI.GLib.Functions.free' to free the string
unitsToString :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Units -> m Text
unitsToString Units
units = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Units
units' <- Units -> IO (Ptr Units)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Units
units
    CString
result <- Ptr Units -> IO CString
clutter_units_to_string Ptr Units
units'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"unitsToString" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    Units -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Units
units
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data UnitsToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod UnitsToStringMethodInfo Units signature where
    overloadedMethod = unitsToString

instance O.OverloadedMethodInfo UnitsToStringMethodInfo Units where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Units.unitsToString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-Units.html#v:unitsToString"
        })


#endif

-- method Units::from_cm
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "units"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Units" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterUnits" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cm"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "centimeters" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_units_from_cm" clutter_units_from_cm :: 
    Ptr Units ->                            -- units : TInterface (Name {namespace = "Clutter", name = "Units"})
    CFloat ->                               -- cm : TBasicType TFloat
    IO ()

-- | Stores a value in centimeters inside /@units@/
-- 
-- /Since: 1.2/
unitsFromCm ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Float
    -- ^ /@cm@/: centimeters
    -> m (Units)
unitsFromCm :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Float -> m Units
unitsFromCm Float
cm = IO Units -> m Units
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Units -> m Units) -> IO Units -> m Units
forall a b. (a -> b) -> a -> b
$ do
    Ptr Units
units <- Int -> IO (Ptr Units)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
32 :: IO (Ptr Units)
    let cm' :: CFloat
cm' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
cm
    Ptr Units -> CFloat -> IO ()
clutter_units_from_cm Ptr Units
units CFloat
cm'
    Units
units' <- ((ManagedPtr Units -> Units) -> Ptr Units -> IO Units
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Units -> Units
Units) Ptr Units
units
    Units -> IO Units
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Units
units'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Units::from_em
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "units"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Units" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterUnits" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "em"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "em" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_units_from_em" clutter_units_from_em :: 
    Ptr Units ->                            -- units : TInterface (Name {namespace = "Clutter", name = "Units"})
    CFloat ->                               -- em : TBasicType TFloat
    IO ()

-- | Stores a value in em inside /@units@/, using the default font
-- name as returned by 'GI.Clutter.Objects.Backend.backendGetFontName'
-- 
-- /Since: 1.0/
unitsFromEm ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Float
    -- ^ /@em@/: em
    -> m (Units)
unitsFromEm :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Float -> m Units
unitsFromEm Float
em = IO Units -> m Units
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Units -> m Units) -> IO Units -> m Units
forall a b. (a -> b) -> a -> b
$ do
    Ptr Units
units <- Int -> IO (Ptr Units)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
32 :: IO (Ptr Units)
    let em' :: CFloat
em' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
em
    Ptr Units -> CFloat -> IO ()
clutter_units_from_em Ptr Units
units CFloat
em'
    Units
units' <- ((ManagedPtr Units -> Units) -> Ptr Units -> IO Units
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Units -> Units
Units) Ptr Units
units
    Units -> IO Units
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Units
units'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Units::from_em_for_font
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "units"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Units" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterUnits" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "font_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the font name and size"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "em"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "em" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_units_from_em_for_font" clutter_units_from_em_for_font :: 
    Ptr Units ->                            -- units : TInterface (Name {namespace = "Clutter", name = "Units"})
    CString ->                              -- font_name : TBasicType TUTF8
    CFloat ->                               -- em : TBasicType TFloat
    IO ()

-- | Stores a value in em inside /@units@/ using /@fontName@/
-- 
-- /Since: 1.0/
unitsFromEmForFont ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (T.Text)
    -- ^ /@fontName@/: the font name and size
    -> Float
    -- ^ /@em@/: em
    -> m (Units)
unitsFromEmForFont :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> Float -> m Units
unitsFromEmForFont Maybe Text
fontName Float
em = IO Units -> m Units
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Units -> m Units) -> IO Units -> m Units
forall a b. (a -> b) -> a -> b
$ do
    Ptr Units
units <- Int -> IO (Ptr Units)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
32 :: IO (Ptr Units)
    CString
maybeFontName <- case Maybe Text
fontName of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jFontName -> do
            CString
jFontName' <- Text -> IO CString
textToCString Text
jFontName
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jFontName'
    let em' :: CFloat
em' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
em
    Ptr Units -> CString -> CFloat -> IO ()
clutter_units_from_em_for_font Ptr Units
units CString
maybeFontName CFloat
em'
    Units
units' <- ((ManagedPtr Units -> Units) -> Ptr Units -> IO Units
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Units -> Units
Units) Ptr Units
units
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeFontName
    Units -> IO Units
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Units
units'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Units::from_mm
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "units"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Units" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterUnits" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mm"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "millimeters" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_units_from_mm" clutter_units_from_mm :: 
    Ptr Units ->                            -- units : TInterface (Name {namespace = "Clutter", name = "Units"})
    CFloat ->                               -- mm : TBasicType TFloat
    IO ()

-- | Stores a value in millimiters inside /@units@/
-- 
-- /Since: 1.0/
unitsFromMm ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Float
    -- ^ /@mm@/: millimeters
    -> m (Units)
unitsFromMm :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Float -> m Units
unitsFromMm Float
mm = IO Units -> m Units
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Units -> m Units) -> IO Units -> m Units
forall a b. (a -> b) -> a -> b
$ do
    Ptr Units
units <- Int -> IO (Ptr Units)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
32 :: IO (Ptr Units)
    let mm' :: CFloat
mm' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
mm
    Ptr Units -> CFloat -> IO ()
clutter_units_from_mm Ptr Units
units CFloat
mm'
    Units
units' <- ((ManagedPtr Units -> Units) -> Ptr Units -> IO Units
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Units -> Units
Units) Ptr Units
units
    Units -> IO Units
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Units
units'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Units::from_pixels
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "units"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Units" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterUnits" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "px"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pixels" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_units_from_pixels" clutter_units_from_pixels :: 
    Ptr Units ->                            -- units : TInterface (Name {namespace = "Clutter", name = "Units"})
    Int32 ->                                -- px : TBasicType TInt
    IO ()

-- | Stores a value in pixels inside /@units@/
-- 
-- /Since: 1.0/
unitsFromPixels ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@px@/: pixels
    -> m (Units)
unitsFromPixels :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Int32 -> m Units
unitsFromPixels Int32
px = IO Units -> m Units
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Units -> m Units) -> IO Units -> m Units
forall a b. (a -> b) -> a -> b
$ do
    Ptr Units
units <- Int -> IO (Ptr Units)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
32 :: IO (Ptr Units)
    Ptr Units -> Int32 -> IO ()
clutter_units_from_pixels Ptr Units
units Int32
px
    Units
units' <- ((ManagedPtr Units -> Units) -> Ptr Units -> IO Units
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Units -> Units
Units) Ptr Units
units
    Units -> IO Units
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Units
units'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Units::from_pt
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "units"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Units" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterUnits" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pt"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "typographic points" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_units_from_pt" clutter_units_from_pt :: 
    Ptr Units ->                            -- units : TInterface (Name {namespace = "Clutter", name = "Units"})
    CFloat ->                               -- pt : TBasicType TFloat
    IO ()

-- | Stores a value in typographic points inside /@units@/
-- 
-- /Since: 1.0/
unitsFromPt ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Float
    -- ^ /@pt@/: typographic points
    -> m (Units)
unitsFromPt :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Float -> m Units
unitsFromPt Float
pt = IO Units -> m Units
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Units -> m Units) -> IO Units -> m Units
forall a b. (a -> b) -> a -> b
$ do
    Ptr Units
units <- Int -> IO (Ptr Units)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
32 :: IO (Ptr Units)
    let pt' :: CFloat
pt' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
pt
    Ptr Units -> CFloat -> IO ()
clutter_units_from_pt Ptr Units
units CFloat
pt'
    Units
units' <- ((ManagedPtr Units -> Units) -> Ptr Units -> IO Units
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Units -> Units
Units) Ptr Units
units
    Units -> IO Units
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Units
units'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Units::from_string
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "units"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Units" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterUnits" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "str"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the string to convert"
--                 , 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 "clutter_units_from_string" clutter_units_from_string :: 
    Ptr Units ->                            -- units : TInterface (Name {namespace = "Clutter", name = "Units"})
    CString ->                              -- str : TBasicType TUTF8
    IO CInt

-- | Parses a value and updates /@units@/ with it
-- 
-- A t'GI.Clutter.Structs.Units.Units' expressed in string should match:
-- 
-- >
-- >  units: wsp* unit-value wsp* unit-name? wsp*
-- >  unit-value: number
-- >  unit-name: 'px' | 'pt' | 'mm' | 'em' | 'cm'
-- >  number: digit+
-- >          | digit* sep digit+
-- >  sep: '.' | ','
-- >  digit: '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9'
-- >  wsp: (#0x20 | #0x9 | #0xA | #0xB | #0xC | #0xD)+
-- 
-- 
-- For instance, these are valid strings:
-- 
-- >
-- >  10 px
-- >  5.1 em
-- >  24 pt
-- >  12.6 mm
-- >  .3 cm
-- 
-- 
-- While these are not:
-- 
-- >
-- >  42 cats
-- >  omg!1!ponies
-- 
-- 
-- If no unit is specified, pixels are assumed.
-- 
-- /Since: 1.0/
unitsFromString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@str@/: the string to convert
    -> m ((Bool, Units))
    -- ^ __Returns:__ 'P.True' if the string was successfully parsed,
    --   and 'P.False' otherwise
unitsFromString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m (Bool, Units)
unitsFromString Text
str = IO (Bool, Units) -> m (Bool, Units)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Units) -> m (Bool, Units))
-> IO (Bool, Units) -> m (Bool, Units)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Units
units <- Int -> IO (Ptr Units)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
32 :: IO (Ptr Units)
    CString
str' <- Text -> IO CString
textToCString Text
str
    CInt
result <- Ptr Units -> CString -> IO CInt
clutter_units_from_string Ptr Units
units CString
str'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Units
units' <- ((ManagedPtr Units -> Units) -> Ptr Units -> IO Units
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Units -> Units
Units) Ptr Units
units
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
str'
    (Bool, Units) -> IO (Bool, Units)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Units
units')

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveUnitsMethod (t :: Symbol) (o :: *) :: * where
    ResolveUnitsMethod "copy" o = UnitsCopyMethodInfo
    ResolveUnitsMethod "free" o = UnitsFreeMethodInfo
    ResolveUnitsMethod "toPixels" o = UnitsToPixelsMethodInfo
    ResolveUnitsMethod "toString" o = UnitsToStringMethodInfo
    ResolveUnitsMethod "getUnitType" o = UnitsGetUnitTypeMethodInfo
    ResolveUnitsMethod "getUnitValue" o = UnitsGetUnitValueMethodInfo
    ResolveUnitsMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif