Extends.hs

{-# LANGUAGE ConstraintKinds, DataKinds, TypeFamilies, UndecidableInstances, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, PolyKinds, TypeOperators, NoImplicitPrelude #-}
module Extends where

import Prelude hiding (Extends,Class,Object,Super)

data Object = Object
  deriving Show

data Defined = Yes | No
type family Super (a :: *) :: *
type family Implements (a :: *) :: [*]

type family ExtendsList (a :: [*]) (b :: *) :: Defined where
  ExtendsList '[] y = No
  ExtendsList (x ': xs) y = Or (Extends' x y) (ExtendsList xs y)

type family Extends' (a :: *) (b :: *) :: Defined where
  Extends' a a = Yes
  Extends' Object a = No
  Extends' a b = Or (ExtendsList (Implements a) b) (Extends' (Super a) b)

type family Or (a :: Defined) (b :: Defined) :: Defined where
  Or No No = No
  Or a  b  = Yes

class Class c where

class (Class a, Class b) => Extends a b where

instance (Class a, Class b, Extends' a b ~ Yes) => Extends a b where

instance Class Object where

Main.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeFamilies, DataKinds, FlexibleContexts #-}
module Main where

import Prelude hiding (Extends,Class,Object,Super)

import Extends

data Stream = Stream
  deriving Show

instance Class Stream where

data SeqStream = SeqStream
  deriving Show

instance Class SeqStream where

data IStream = IStream
  deriving Show

instance Class IStream where

data AStream = AStream
  deriving Show

instance Class AStream where

data BStream = BStream
  deriving Show

instance Class BStream where

type instance Super Stream    = Object
type instance Super SeqStream = Stream
type instance Super IStream   = Object
type instance Super AStream   = Object
type instance Super BStream   = Object

type instance Implements Stream = '[IStream]
type instance Implements IStream = '[AStream, BStream]
type instance Implements AStream = '[]
type instance Implements BStream = '[]
type instance Implements SeqStream = '[]

main :: IO ()
main =
  print ("" :: ( Extends Object Object
               , Extends Stream Object
               , Extends IStream Object
               , Extends SeqStream Object
               , Extends SeqStream IStream
               , Extends Stream AStream
               , Extends SeqStream AStream
               ) => String)