{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Gtk.Objects.CClosureExpression
    ( 

-- * Exported types
    CClosureExpression(..)                  ,
    IsCClosureExpression                    ,
    toCClosureExpression                    ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bind]("GI.Gtk.Objects.Expression#g:method:bind"), [evaluate]("GI.Gtk.Objects.Expression#g:method:evaluate"), [isStatic]("GI.Gtk.Objects.Expression#g:method:isStatic"), [ref]("GI.Gtk.Objects.Expression#g:method:ref"), [unref]("GI.Gtk.Objects.Expression#g:method:unref"), [watch]("GI.Gtk.Objects.Expression#g:method:watch").
-- 
-- ==== Getters
-- [getValueType]("GI.Gtk.Objects.Expression#g:method:getValueType").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveCClosureExpressionMethod         ,
#endif

-- ** new #method:new#

    cClosureExpressionNew                   ,




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

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

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

foreign import ccall "gtk_cclosure_expression_get_type"
    c_gtk_cclosure_expression_get_type :: IO B.Types.GType

instance B.Types.TypedObject CClosureExpression where
    glibType :: IO GType
glibType = IO GType
c_gtk_cclosure_expression_get_type

-- | Type class for types which can be safely cast to `CClosureExpression`, for instance with `toCClosureExpression`.
class (SP.BoxedPtr o, SP.TypedObject o, O.IsDescendantOf CClosureExpression o) => IsCClosureExpression o
instance (SP.BoxedPtr o, SP.TypedObject o, O.IsDescendantOf CClosureExpression o) => IsCClosureExpression o

instance O.HasParentTypes CClosureExpression
type instance O.ParentTypes CClosureExpression = '[Gtk.Expression.Expression]

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

--- XXX Missing getter and/or setter, so no GValue instance could be generated.
#if defined(ENABLE_OVERLOADING)
type family ResolveCClosureExpressionMethod (t :: Symbol) (o :: *) :: * where
    ResolveCClosureExpressionMethod "bind" o = Gtk.Expression.ExpressionBindMethodInfo
    ResolveCClosureExpressionMethod "evaluate" o = Gtk.Expression.ExpressionEvaluateMethodInfo
    ResolveCClosureExpressionMethod "isStatic" o = Gtk.Expression.ExpressionIsStaticMethodInfo
    ResolveCClosureExpressionMethod "ref" o = Gtk.Expression.ExpressionRefMethodInfo
    ResolveCClosureExpressionMethod "unref" o = Gtk.Expression.ExpressionUnrefMethodInfo
    ResolveCClosureExpressionMethod "watch" o = Gtk.Expression.ExpressionWatchMethodInfo
    ResolveCClosureExpressionMethod "getValueType" o = Gtk.Expression.ExpressionGetValueTypeMethodInfo
    ResolveCClosureExpressionMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- XXX Wrapping a foreign struct/union with no known destructor or size, leak?
instance BoxedPtr CClosureExpression where
    boxedPtrCopy :: CClosureExpression -> IO CClosureExpression
boxedPtrCopy = CClosureExpression -> IO CClosureExpression
forall (m :: * -> *) a. Monad m => a -> m a
return
    boxedPtrFree :: CClosureExpression -> IO ()
boxedPtrFree = \CClosureExpression
_x -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- method CClosureExpression::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "value_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the type of the value that this expression evaluates to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "marshal"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "ClosureMarshal" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "marshaller used for creating a closure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_params"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the number of params needed for evaluating @closure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "params"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 2
--                 (TInterface Name { namespace = "Gtk" , name = "Expression" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "expressions for each parameter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "callback_func"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Callback" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "callback used for creating a closure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 5
--           , argDestroy = 6
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data used for creating a closure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_destroy"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "ClosureNotify" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destroy notify for @user_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_params"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just "the number of params needed for evaluating @closure"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Expression" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_cclosure_expression_new" gtk_cclosure_expression_new :: 
    CGType ->                               -- value_type : TBasicType TGType
    FunPtr GObject.Callbacks.C_ClosureMarshal -> -- marshal : TInterface (Name {namespace = "GObject", name = "ClosureMarshal"})
    Word32 ->                               -- n_params : TBasicType TUInt
    Ptr (Ptr Gtk.Expression.Expression) ->  -- params : TCArray False (-1) 2 (TInterface (Name {namespace = "Gtk", name = "Expression"}))
    FunPtr GObject.Callbacks.C_Callback ->  -- callback_func : TInterface (Name {namespace = "GObject", name = "Callback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GObject.Callbacks.C_ClosureNotify -> -- user_destroy : TInterface (Name {namespace = "GObject", name = "ClosureNotify"})
    IO (Ptr Gtk.Expression.Expression)

-- | This function is a variant of 'GI.Gtk.Objects.ClosureExpression.closureExpressionNew' that
-- creates a t'GI.GObject.Structs.Closure.Closure' by calling @/g_cclosure_new()/@ with the given
-- /@callbackFunc@/, /@userData@/ and /@userDestroy@/.
cClosureExpressionNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    -- ^ /@valueType@/: the type of the value that this expression evaluates to
    -> Maybe (GObject.Callbacks.ClosureMarshal)
    -- ^ /@marshal@/: marshaller used for creating a closure
    -> [Gtk.Expression.Expression]
    -- ^ /@params@/: expressions for each parameter
    -> GObject.Callbacks.Callback
    -- ^ /@callbackFunc@/: callback used for creating a closure
    -> m Gtk.Expression.Expression
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.Expression.Expression'
cClosureExpressionNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GType
-> Maybe ClosureMarshal -> [Expression] -> IO () -> m Expression
cClosureExpressionNew GType
valueType Maybe ClosureMarshal
marshal [Expression]
params IO ()
callbackFunc = IO Expression -> m Expression
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Expression -> m Expression) -> IO Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ do
    let nParams :: Word32
nParams = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [Expression] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Expression]
params
    let valueType' :: CGType
valueType' = GType -> CGType
gtypeToCGType GType
valueType
    FunPtr C_ClosureMarshal
maybeMarshal <- case Maybe ClosureMarshal
marshal of
        Maybe ClosureMarshal
Nothing -> FunPtr C_ClosureMarshal -> IO (FunPtr C_ClosureMarshal)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_ClosureMarshal
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just ClosureMarshal
jMarshal -> do
            FunPtr C_ClosureMarshal
jMarshal' <- C_ClosureMarshal -> IO (FunPtr C_ClosureMarshal)
GObject.Callbacks.mk_ClosureMarshal (Maybe (Ptr (FunPtr C_ClosureMarshal))
-> ClosureMarshal -> C_ClosureMarshal
GObject.Callbacks.wrap_ClosureMarshal Maybe (Ptr (FunPtr C_ClosureMarshal))
forall a. Maybe a
Nothing ClosureMarshal
jMarshal)
            FunPtr C_ClosureMarshal -> IO (FunPtr C_ClosureMarshal)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_ClosureMarshal
jMarshal'
    [Ptr Expression]
params' <- (Expression -> IO (Ptr Expression))
-> [Expression] -> IO [Ptr Expression]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expression -> IO (Ptr Expression)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
B.ManagedPtr.disownManagedPtr [Expression]
params
    Ptr (Ptr Expression)
params'' <- [Ptr Expression] -> IO (Ptr (Ptr Expression))
forall a. [Ptr a] -> IO (Ptr (Ptr a))
packPtrArray [Ptr Expression]
params'
    FunPtr (IO ())
callbackFunc' <- IO () -> IO (FunPtr (IO ()))
GObject.Callbacks.mk_Callback (Maybe (Ptr (FunPtr (IO ()))) -> IO () -> IO ()
GObject.Callbacks.wrap_Callback Maybe (Ptr (FunPtr (IO ())))
forall a. Maybe a
Nothing IO ()
callbackFunc)
    let userData :: Ptr ()
userData = FunPtr (IO ()) -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr (IO ())
callbackFunc'
    let userDestroy :: FunPtr (Ptr a -> Ptr b -> IO ())
userDestroy = FunPtr (Ptr a -> Ptr b -> IO ())
forall a b. FunPtr (Ptr a -> Ptr b -> IO ())
SP.safeFreeFunPtrPtr'
    Ptr Expression
result <- CGType
-> FunPtr C_ClosureMarshal
-> Word32
-> Ptr (Ptr Expression)
-> FunPtr (IO ())
-> Ptr ()
-> FunPtr C_ClosureNotify
-> IO (Ptr Expression)
gtk_cclosure_expression_new CGType
valueType' FunPtr C_ClosureMarshal
maybeMarshal Word32
nParams Ptr (Ptr Expression)
params'' FunPtr (IO ())
callbackFunc' Ptr ()
userData FunPtr C_ClosureNotify
forall a b. FunPtr (Ptr a -> Ptr b -> IO ())
userDestroy
    Text -> Ptr Expression -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"cClosureExpressionNew" Ptr Expression
result
    Expression
result' <- ((ManagedPtr Expression -> Expression)
-> Ptr Expression -> IO Expression
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Expression -> Expression
Gtk.Expression.Expression) Ptr Expression
result
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_ClosureMarshal -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ClosureMarshal
maybeMarshal
    (Expression -> IO ()) -> [Expression] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Expression -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [Expression]
params
    Expression -> IO Expression
forall (m :: * -> *) a. Monad m => a -> m a
return Expression
result'

#if defined(ENABLE_OVERLOADING)
#endif