{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TypeOperators #-}
module Data.Parameterized.ClassesC
( TestEqualityC(..)
, OrdC(..)
) where
import Data.Type.Equality ((:~:)(..))
import Data.Maybe (isJust)
import Data.Parameterized.Classes (OrderingF, toOrdering)
import Data.Parameterized.Some (Some(..))
class TestEqualityC (t :: (k -> *) -> *) where
testEqualityC :: (forall x y. f x -> f y -> Maybe (x :~: y))
-> t f
-> t f
-> Bool
class TestEqualityC t => OrdC (t :: (k -> *) -> *) where
compareC :: (forall x y. f x -> g y -> OrderingF x y)
-> t f
-> t g
-> Ordering
instance TestEqualityC Some where
testEqualityC subterms (Some someone) (Some something) =
isJust (subterms someone something)
instance OrdC Some where
compareC subterms (Some someone) (Some something) =
toOrdering (subterms someone something)