module Data.GI.CodeGen.GObject
    ( isGObject
    , apiIsGObject
    , nameIsGObject
    ) where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif

import Data.GI.CodeGen.API
import Data.GI.CodeGen.Code
import Data.GI.CodeGen.Type

-- Returns whether the given type is a descendant of the given parent.
typeDoParentSearch :: Name -> Type -> CodeGen e Bool
typeDoParentSearch :: forall e. Name -> Type -> CodeGen e Bool
typeDoParentSearch Name
parent (TInterface Name
n) = Name -> CodeGen e API
forall e. HasCallStack => Name -> CodeGen e API
findAPIByName Name
n CodeGen e API
-> (API
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall a b.
ReaderT CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
-> (a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) b)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                                           Name
-> Name
-> API
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall e. Name -> Name -> API -> CodeGen e Bool
apiDoParentSearch Name
parent Name
n
typeDoParentSearch Name
_ Type
_ = Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall a.
a
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

apiDoParentSearch :: Name -> Name -> API -> CodeGen e Bool
apiDoParentSearch :: forall e. Name -> Name -> API -> CodeGen e Bool
apiDoParentSearch Name
parent Name
n API
api
    | Name
parent Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n = Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall a.
a
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    | Bool
otherwise   = case API
api of
      APIObject Object
o ->
        case Object -> Maybe Name
objParent Object
o of
          Just  Name
p -> Name
-> Type
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall e. Name -> Type -> CodeGen e Bool
typeDoParentSearch Name
parent (Name -> Type
TInterface Name
p)
          Maybe Name
Nothing -> Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall a.
a
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      APIInterface Interface
iface ->
        do let prs :: [Name]
prs = Interface -> [Name]
ifPrerequisites Interface
iface
           [(Name, API)]
prereqs <- [Name] -> [API] -> [(Name, API)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
prs ([API] -> [(Name, API)])
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) [API]
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     [(Name, API)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Name
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) API)
-> [Name]
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) [API]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Name
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) API
forall e. HasCallStack => Name -> CodeGen e API
findAPIByName [Name]
prs
           [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) [Bool]
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Name, API)
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool)
-> [(Name, API)]
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Name
 -> API
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool)
-> (Name, API)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Name
-> Name
-> API
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall e. Name -> Name -> API -> CodeGen e Bool
apiDoParentSearch Name
parent)) [(Name, API)]
prereqs
      API
_ -> Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall a.
a
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Check whether the given type descends from GObject.
isGObject :: Type -> CodeGen e Bool
isGObject :: forall e. Type -> CodeGen e Bool
isGObject = Name -> Type -> CodeGen e Bool
forall e. Name -> Type -> CodeGen e Bool
typeDoParentSearch (Name -> Type -> CodeGen e Bool) -> Name -> Type -> CodeGen e Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Name
Name Text
"GObject" Text
"Object"

-- | Check whether the given name descends from GObject.
nameIsGObject :: Name -> CodeGen e Bool
nameIsGObject :: forall e. Name -> CodeGen e Bool
nameIsGObject Name
n = Name -> CodeGen e API
forall e. HasCallStack => Name -> CodeGen e API
findAPIByName Name
n CodeGen e API
-> (API
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall a b.
ReaderT CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
-> (a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) b)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Name
-> API
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall e. Name -> API -> CodeGen e Bool
apiIsGObject Name
n

-- | Check whether the given API descends from GObject.
apiIsGObject :: Name -> API -> CodeGen e Bool
apiIsGObject :: forall e. Name -> API -> CodeGen e Bool
apiIsGObject = Name -> Name -> API -> CodeGen e Bool
forall e. Name -> Name -> API -> CodeGen e Bool
apiDoParentSearch (Name -> Name -> API -> CodeGen e Bool)
-> Name -> Name -> API -> CodeGen e Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Name
Name Text
"GObject" Text
"Object"