Skip to content

Instantly share code, notes, and snippets.

@sjoerdvisscher
Created March 26, 2017 17:18
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save sjoerdvisscher/4089ec1750d731a2e80d0d22e9ab4e39 to your computer and use it in GitHub Desktop.
Save sjoerdvisscher/4089ec1750d731a2e80d0d22e9ab4e39 to your computer and use it in GitHub Desktop.
HasSuperClasses for Constraint product.
class (c x, d x) => (c :&: d) x
instance (c x, d x) => (c :&: d) x
instance (HasSuperClasses c, HasSuperClasses d, Distr (SuperClasses c)) => HasSuperClasses (c :&: d) where
type SuperClasses (c :&: d) = (c :&: d) ': SuperClasses c ++ SuperClasses d
superClasses = h superClasses superClasses
where
h :: forall x. c x :- FoldConstraints (SuperClasses c) x
-> d x :- FoldConstraints (SuperClasses d) x
-> (c :&: d) x :- FoldConstraints (SuperClasses (c :&: d)) x
h l r = Sub $ case (h2 (Proxy :: Proxy x) (l . Sub Dict) (r . Sub Dict)) of Dict -> Dict
h2 :: forall x. (c x, d x) => Proxy x
-> (c :&: d) x :- FoldConstraints (SuperClasses c) x
-> (c :&: d) x :- FoldConstraints (SuperClasses d) x
-> Dict (FoldConstraints (SuperClasses c ++ SuperClasses d) x)
h2 p (Sub Dict) (Sub Dict) = distr p (Proxy :: Proxy (SuperClasses c)) (Proxy :: Proxy (SuperClasses d))
containsSelf = Sub Dict
class Distr cs where
distr :: (FoldConstraints cs x, FoldConstraints ds x) => Proxy x -> Proxy cs -> Proxy ds -> Dict (FoldConstraints (cs ++ ds) x)
instance Distr '[] where
distr _ _ _ = Dict
instance Distr cs => Distr (c ': cs) where
distr x _ ds = case distr x (Proxy :: Proxy cs) ds of Dict -> Dict
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment