module Data.GI.Base.Overloading
(
ParentTypes
, IsDescendantOf
, AttributeList
, ResolveAttribute
, HasAttribute
, HasAttr
, SignalList
, ResolveSignal
, HasSignal
) where
import GHC.Exts (Constraint)
import GHC.TypeLits
type family JoinLists (as :: [a]) (bs :: [a]) :: [a] where
JoinLists '[] bs = bs
JoinLists (a ': as) bs = a ': JoinLists as bs
type family FindElement (m :: Symbol) (ms :: [(Symbol, *)]) (d :: *) :: * where
FindElement m '[] d = d
FindElement m ('(m, o) ': ms) d = o
FindElement m ('(m', o) ': ms) d = FindElement m ms d
data AncestorCheck t a = HasAncestor a t | DoesNotHaveRequiredAncestor Symbol t Symbol a
type family CheckForAncestorType t (a :: *) (as :: [*]) :: AncestorCheck * * where
CheckForAncestorType t a '[] =
'DoesNotHaveRequiredAncestor "Error: Required ancestor" a "not found for type" t
CheckForAncestorType t a (a ': as) = 'HasAncestor a t
CheckForAncestorType t a (b ': as) = CheckForAncestorType t a as
type family IsDescendantOf (parent :: *) (descendant :: *) :: Constraint where
IsDescendantOf d d = () ~ ()
IsDescendantOf p d = CheckForAncestorType d p (ParentTypes d) ~ 'HasAncestor p d
type family ParentTypes a :: [*]
type family AttributeList a :: [(Symbol, *)]
data UnknownAttribute (msg1 :: Symbol) (s :: Symbol) (msg2 :: Symbol) (o :: *)
type family ResolveAttribute (s :: Symbol) (o :: *) :: * where
ResolveAttribute s o = FindElement s (AttributeList o)
(UnknownAttribute "Error: could not find attribute" s "for object" o)
type family IsElem (e :: Symbol) (es :: [(Symbol, *)]) (success :: k) (failure :: k) :: k where
IsElem e '[] success failure = failure
IsElem e ( '(e, t) ': es) success failure = success
IsElem e ( '(other, t) ': es) s f = IsElem e es s f
data AttributeCheck a t = HasAttribute
| DoesNotHaveAttribute Symbol a Symbol t
type family HasAttribute (attr :: Symbol) (o :: *) where
HasAttribute attr o = IsElem attr (AttributeList o)
'HasAttribute
('DoesNotHaveAttribute "Error: attribute" attr "not found for type" o)
~ 'HasAttribute
class HasAttr (attr :: Symbol) (o :: *)
instance HasAttribute attr o => HasAttr attr o
type family SignalList a :: [(Symbol, *)]
data UnknownSignal (msg1 :: Symbol) (s :: Symbol) (msg2 :: Symbol) (o :: *)
type family ResolveSignal (s :: Symbol) (o :: *) :: * where
ResolveSignal s o = FindElement s (SignalList o)
(UnknownSignal "Error: could not find signal" s "for object" o)
data SignalCheck s t = HasSignal
| DoesNotHaveSignal Symbol s Symbol t
type family HasSignal (s :: Symbol) (o :: *) where
HasSignal s o = IsElem s (SignalList o)
'HasSignal
('DoesNotHaveSignal "Error: signal" s "not found for type" o)
~ 'HasSignal