{-# LANGUAGE ScopedTypeVariables #-}
module Data.GI.CodeGen.Inheritance
( fullObjectPropertyList
, fullInterfacePropertyList
, fullObjectSignalList
, fullInterfaceSignalList
, fullObjectMethodList
, fullInterfaceMethodList
, instanceTree
) where
import Control.Monad (foldM, when)
import qualified Data.Map as M
#if !MIN_VERSION_base(4,13,0)
import Data.Monoid ((<>))
#endif
import Data.Text (Text)
import Data.GI.CodeGen.API
import Data.GI.CodeGen.Code (findAPIByName, CodeGen, line)
import Data.GI.CodeGen.Util (tshow)
import Data.GI.CodeGen.Fixups (dropMovedItems)
getParent :: API -> Maybe Name
getParent :: API -> Maybe Name
getParent (APIObject Object
o) = Maybe Name -> Maybe Name
rename forall a b. (a -> b) -> a -> b
$ Object -> Maybe Name
objParent Object
o
where
rename :: Maybe Name -> Maybe Name
rename :: Maybe Name -> Maybe Name
rename (Just (Name Text
"GObject" Text
"InitiallyUnowned")) =
forall a. a -> Maybe a
Just (Text -> Text -> Name
Name Text
"GObject" Text
"Object")
rename Maybe Name
x = Maybe Name
x
getParent API
_ = forall a. Maybe a
Nothing
instanceTree :: Name -> CodeGen e [Name]
instanceTree :: forall e. Name -> CodeGen e [Name]
instanceTree Name
n = do
API
api <- forall e. HasCallStack => Name -> CodeGen e API
findAPIByName Name
n
case API -> Maybe Name
getParent API
api of
Just Name
p -> (Name
p forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Name -> CodeGen e [Name]
instanceTree Name
p
Maybe Name
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
class Inheritable i where
ifInheritables :: Interface -> [i]
objInheritables :: Object -> [i]
iName :: i -> Text
instance Inheritable Property where
ifInheritables :: Interface -> [Property]
ifInheritables = Interface -> [Property]
ifProperties
objInheritables :: Object -> [Property]
objInheritables = Object -> [Property]
objProperties
iName :: Property -> Text
iName = Property -> Text
propName
instance Inheritable Signal where
ifInheritables :: Interface -> [Signal]
ifInheritables = Interface -> [Signal]
ifSignals
objInheritables :: Object -> [Signal]
objInheritables = Object -> [Signal]
objSignals
iName :: Signal -> Text
iName = Signal -> Text
sigName
instance Inheritable Method where
ifInheritables :: Interface -> [Method]
ifInheritables = Interface -> [Method]
ifMethods
objInheritables :: Object -> [Method]
objInheritables = Object -> [Method]
objMethods
iName :: Method -> Text
iName = Name -> Text
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Name
methodName
apiInheritables :: Inheritable i => Name -> CodeGen e [(Name, i)]
apiInheritables :: forall i e. Inheritable i => Name -> CodeGen e [(Name, i)]
apiInheritables Name
n = do
API
api <- forall e. HasCallStack => Name -> CodeGen e API
findAPIByName Name
n
case API -> Maybe API
dropMovedItems API
api of
Just (APIInterface Interface
iface) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((,) Name
n) (forall i. Inheritable i => Interface -> [i]
ifInheritables Interface
iface)
Just (APIObject Object
object) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((,) Name
n) (forall i. Inheritable i => Object -> [i]
objInheritables Object
object)
Maybe API
_ -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"apiInheritables : Unexpected API : " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Name
n
fullAPIInheritableList :: Inheritable i => Name -> CodeGen e [(Name, i)]
fullAPIInheritableList :: forall i e. Inheritable i => Name -> CodeGen e [(Name, i)]
fullAPIInheritableList Name
n = do
API
api <- forall e. HasCallStack => Name -> CodeGen e API
findAPIByName Name
n
case API
api of
APIInterface Interface
iface -> forall i e.
Inheritable i =>
Name -> Interface -> CodeGen e [(Name, i)]
fullInterfaceInheritableList Name
n Interface
iface
APIObject Object
object -> forall i e.
Inheritable i =>
Name -> Object -> CodeGen e [(Name, i)]
fullObjectInheritableList Name
n Object
object
API
_ -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"FullAPIInheritableList : Unexpected API : " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Name
n
fullObjectInheritableList :: Inheritable i => Name -> Object ->
CodeGen e [(Name, i)]
fullObjectInheritableList :: forall i e.
Inheritable i =>
Name -> Object -> CodeGen e [(Name, i)]
fullObjectInheritableList Name
n Object
obj = do
[Name]
iT <- forall e. Name -> CodeGen e [Name]
instanceTree Name
n
forall a. [a] -> [a] -> [a]
(++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall i e. Inheritable i => Name -> CodeGen e [(Name, i)]
apiInheritables (Name
n forall a. a -> [a] -> [a]
: [Name]
iT))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall i e. Inheritable i => Name -> CodeGen e [(Name, i)]
apiInheritables (Object -> [Name]
objInterfaces Object
obj))
fullInterfaceInheritableList :: Inheritable i => Name -> Interface ->
CodeGen e [(Name, i)]
fullInterfaceInheritableList :: forall i e.
Inheritable i =>
Name -> Interface -> CodeGen e [(Name, i)]
fullInterfaceInheritableList Name
n Interface
iface =
forall a. [a] -> [a] -> [a]
(++) (forall a b. (a -> b) -> [a] -> [b]
map ((,) Name
n) (forall i. Inheritable i => Interface -> [i]
ifInheritables Interface
iface))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall i e. Inheritable i => Name -> CodeGen e [(Name, i)]
fullAPIInheritableList (Interface -> [Name]
ifPrerequisites Interface
iface))
removeDuplicates :: forall i e. (Eq i, Show i, Inheritable i) =>
Bool -> [(Name, i)] -> CodeGen e [(Name, i)]
removeDuplicates :: forall i e.
(Eq i, Show i, Inheritable i) =>
Bool -> [(Name, i)] -> CodeGen e [(Name, i)]
removeDuplicates Bool
verbose [(Name, i)]
inheritables =
([(Text, (Bool, Name, i))] -> [(Name, i)]
filterTainted forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Map Text (Bool, Name, i)
-> (Name, i) -> CodeGen e (Map Text (Bool, Name, i))
filterDups forall k a. Map k a
M.empty [(Name, i)]
inheritables
where
filterDups :: M.Map Text (Bool, Name, i) -> (Name, i) ->
CodeGen e (M.Map Text (Bool, Name, i))
filterDups :: Map Text (Bool, Name, i)
-> (Name, i) -> CodeGen e (Map Text (Bool, Name, i))
filterDups Map Text (Bool, Name, i)
m (Name
name, i
prop) =
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (forall i. Inheritable i => i -> Text
iName i
prop) Map Text (Bool, Name, i)
m of
Just (Bool
tainted, Name
n, i
p)
| Bool
tainted -> forall (m :: * -> *) a. Monad m => a -> m a
return Map Text (Bool, Name, i)
m
| (i
p forall a. Eq a => a -> a -> Bool
== i
prop) -> forall (m :: * -> *) a. Monad m => a -> m a
return Map Text (Bool, Name, i)
m
| Bool
otherwise ->
do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose forall a b. (a -> b) -> a -> b
$ do
forall e. Text -> CodeGen e ()
line Text
"--- XXX Duplicated object with different types:"
forall e. Text -> CodeGen e ()
line forall a b. (a -> b) -> a -> b
$ Text
" --- " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Name
n forall a. Semigroup a => a -> a -> a
<> Text
" -> " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow i
p
forall e. Text -> CodeGen e ()
line forall a b. (a -> b) -> a -> b
$ Text
" --- " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Name
name forall a. Semigroup a => a -> a -> a
<> Text
" -> " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow i
prop
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (forall i. Inheritable i => i -> Text
iName i
prop) (Bool
True, Name
n, i
p) Map Text (Bool, Name, i)
m
Maybe (Bool, Name, i)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (forall i. Inheritable i => i -> Text
iName i
prop) (Bool
False, Name
name, i
prop) Map Text (Bool, Name, i)
m
filterTainted :: [(Text, (Bool, Name, i))] -> [(Name, i)]
filterTainted :: [(Text, (Bool, Name, i))] -> [(Name, i)]
filterTainted [(Text, (Bool, Name, i))]
xs =
[(Name
name, i
prop) | (Text
_, (Bool
_, Name
name, i
prop)) <- [(Text, (Bool, Name, i))]
xs]
fullObjectPropertyList :: Name -> Object -> CodeGen e [(Name, Property)]
fullObjectPropertyList :: forall e. Name -> Object -> CodeGen e [(Name, Property)]
fullObjectPropertyList Name
n Object
o = forall i e.
Inheritable i =>
Name -> Object -> CodeGen e [(Name, i)]
fullObjectInheritableList Name
n Object
o forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall i e.
(Eq i, Show i, Inheritable i) =>
Bool -> [(Name, i)] -> CodeGen e [(Name, i)]
removeDuplicates Bool
True
fullInterfacePropertyList :: Name -> Interface -> CodeGen e [(Name, Property)]
fullInterfacePropertyList :: forall e. Name -> Interface -> CodeGen e [(Name, Property)]
fullInterfacePropertyList Name
n Interface
i = forall i e.
Inheritable i =>
Name -> Interface -> CodeGen e [(Name, i)]
fullInterfaceInheritableList Name
n Interface
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall i e.
(Eq i, Show i, Inheritable i) =>
Bool -> [(Name, i)] -> CodeGen e [(Name, i)]
removeDuplicates Bool
True
fullObjectSignalList :: Name -> Object -> CodeGen e [(Name, Signal)]
fullObjectSignalList :: forall e. Name -> Object -> CodeGen e [(Name, Signal)]
fullObjectSignalList Name
n Object
o = forall i e.
Inheritable i =>
Name -> Object -> CodeGen e [(Name, i)]
fullObjectInheritableList Name
n Object
o forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall i e.
(Eq i, Show i, Inheritable i) =>
Bool -> [(Name, i)] -> CodeGen e [(Name, i)]
removeDuplicates Bool
True
fullInterfaceSignalList :: Name -> Interface -> CodeGen e [(Name, Signal)]
fullInterfaceSignalList :: forall e. Name -> Interface -> CodeGen e [(Name, Signal)]
fullInterfaceSignalList Name
n Interface
i = forall i e.
Inheritable i =>
Name -> Interface -> CodeGen e [(Name, i)]
fullInterfaceInheritableList Name
n Interface
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall i e.
(Eq i, Show i, Inheritable i) =>
Bool -> [(Name, i)] -> CodeGen e [(Name, i)]
removeDuplicates Bool
True
fullObjectMethodList :: Name -> Object -> CodeGen e [(Name, Method)]
fullObjectMethodList :: forall e. Name -> Object -> CodeGen e [(Name, Method)]
fullObjectMethodList Name
n Object
o = forall i e.
Inheritable i =>
Name -> Object -> CodeGen e [(Name, i)]
fullObjectInheritableList Name
n Object
o forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall i e.
(Eq i, Show i, Inheritable i) =>
Bool -> [(Name, i)] -> CodeGen e [(Name, i)]
removeDuplicates Bool
False
fullInterfaceMethodList :: Name -> Interface -> CodeGen e [(Name, Method)]
fullInterfaceMethodList :: forall e. Name -> Interface -> CodeGen e [(Name, Method)]
fullInterfaceMethodList Name
n Interface
i = forall i e.
Inheritable i =>
Name -> Interface -> CodeGen e [(Name, i)]
fullInterfaceInheritableList Name
n Interface
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall i e.
(Eq i, Show i, Inheritable i) =>
Bool -> [(Name, i)] -> CodeGen e [(Name, i)]
removeDuplicates Bool
False