{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GtkFixedLayout@ is a layout manager which can place child widgets
-- at fixed positions.
-- 
-- Most applications should never use this layout manager; fixed positioning
-- and sizing requires constant recalculations on where children need to be
-- positioned and sized. Other layout managers perform this kind of work
-- internally so that application developers don\'t need to do it. Specifically,
-- widgets positioned in a fixed layout manager will need to take into account:
-- 
-- * Themes, which may change widget sizes.
-- * Fonts other than the one you used to write the app will of course
-- change the size of widgets containing text; keep in mind that
-- users may use a larger font because of difficulty reading the
-- default, or they may be using a different OS that provides different
-- fonts.
-- * Translation of text into other languages changes its size. Also,
-- display of non-English text will use a different font in many
-- cases.
-- 
-- 
-- In addition, @GtkFixedLayout@ does not pay attention to text direction and
-- thus may produce unwanted results if your app is run under right-to-left
-- languages such as Hebrew or Arabic. That is: normally GTK will order
-- containers appropriately depending on the text direction, e.g. to put labels
-- to the right of the thing they label when using an RTL language;
-- @GtkFixedLayout@ won\'t be able to do that for you.
-- 
-- Finally, fixed positioning makes it kind of annoying to add\/remove UI
-- elements, since you have to reposition all the other  elements. This is a
-- long-term maintenance problem for your application.

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

module GI.Gtk.Objects.FixedLayout
    ( 

-- * Exported types
    FixedLayout(..)                         ,
    IsFixedLayout                           ,
    toFixedLayout                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [allocate]("GI.Gtk.Objects.LayoutManager#g:method:allocate"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [layoutChanged]("GI.Gtk.Objects.LayoutManager#g:method:layoutChanged"), [measure]("GI.Gtk.Objects.LayoutManager#g:method:measure"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getLayoutChild]("GI.Gtk.Objects.LayoutManager#g:method:getLayoutChild"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRequestMode]("GI.Gtk.Objects.LayoutManager#g:method:getRequestMode"), [getWidget]("GI.Gtk.Objects.LayoutManager#g:method:getWidget").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveFixedLayoutMethod                ,
#endif

-- ** new #method:new#

    fixedLayoutNew                          ,




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

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

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

foreign import ccall "gtk_fixed_layout_get_type"
    c_gtk_fixed_layout_get_type :: IO B.Types.GType

instance B.Types.TypedObject FixedLayout where
    glibType :: IO GType
glibType = IO GType
c_gtk_fixed_layout_get_type

instance B.Types.GObject FixedLayout

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

instance O.HasParentTypes FixedLayout
type instance O.ParentTypes FixedLayout = '[Gtk.LayoutManager.LayoutManager, GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveFixedLayoutMethod (t :: Symbol) (o :: *) :: * where
    ResolveFixedLayoutMethod "allocate" o = Gtk.LayoutManager.LayoutManagerAllocateMethodInfo
    ResolveFixedLayoutMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveFixedLayoutMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveFixedLayoutMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveFixedLayoutMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveFixedLayoutMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveFixedLayoutMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveFixedLayoutMethod "layoutChanged" o = Gtk.LayoutManager.LayoutManagerLayoutChangedMethodInfo
    ResolveFixedLayoutMethod "measure" o = Gtk.LayoutManager.LayoutManagerMeasureMethodInfo
    ResolveFixedLayoutMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveFixedLayoutMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveFixedLayoutMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveFixedLayoutMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveFixedLayoutMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveFixedLayoutMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveFixedLayoutMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveFixedLayoutMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveFixedLayoutMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveFixedLayoutMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveFixedLayoutMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveFixedLayoutMethod "getLayoutChild" o = Gtk.LayoutManager.LayoutManagerGetLayoutChildMethodInfo
    ResolveFixedLayoutMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveFixedLayoutMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveFixedLayoutMethod "getRequestMode" o = Gtk.LayoutManager.LayoutManagerGetRequestModeMethodInfo
    ResolveFixedLayoutMethod "getWidget" o = Gtk.LayoutManager.LayoutManagerGetWidgetMethodInfo
    ResolveFixedLayoutMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveFixedLayoutMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveFixedLayoutMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveFixedLayoutMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

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

foreign import ccall "gtk_fixed_layout_new" gtk_fixed_layout_new :: 
    IO (Ptr FixedLayout)

-- | Creates a new @GtkFixedLayout@.
fixedLayoutNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m FixedLayout
    -- ^ __Returns:__ the newly created @GtkFixedLayout@
fixedLayoutNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m FixedLayout
fixedLayoutNew  = IO FixedLayout -> m FixedLayout
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FixedLayout -> m FixedLayout)
-> IO FixedLayout -> m FixedLayout
forall a b. (a -> b) -> a -> b
$ do
    Ptr FixedLayout
result <- IO (Ptr FixedLayout)
gtk_fixed_layout_new
    Text -> Ptr FixedLayout -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fixedLayoutNew" Ptr FixedLayout
result
    FixedLayout
result' <- ((ManagedPtr FixedLayout -> FixedLayout)
-> Ptr FixedLayout -> IO FixedLayout
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FixedLayout -> FixedLayout
FixedLayout) Ptr FixedLayout
result
    FixedLayout -> IO FixedLayout
forall (m :: * -> *) a. Monad m => a -> m a
return FixedLayout
result'

#if defined(ENABLE_OVERLOADING)
#endif