{-# LANGUAGE MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, RankNTypes, DefaultSignatures, TypeApplications, UndecidableInstances, PackageImports #-} module Data.Reflection.Constraint where import Prelude hiding (Functor, (<$>), map) import Control.Categorical.Functor import Data.Constraint import Data.Function (on) import Data.Morphism.Iso import Data.Proxy import Data.Reflection (Reifies (..), reify) newtype Reflected c s a = Reflected { Reflected c s a -> a unReflected :: a } unReflected' :: proxy s -> Reflected c s a -> a unReflected' :: proxy s -> Reflected c s a -> a unReflected' _ = Reflected c s a -> a forall k (c :: k) k (s :: k) a. Reflected c s a -> a unReflected class Functor (Iso (->)) (->) (Methods c) => Reifiable c where data Methods c a reifiable :: Reifies s (Methods c a) => Dict (c (Reflected c s a)) default reifiable :: c (Reflected c s a) => Dict (c (Reflected c s a)) reifiable = Dict (c (Reflected c s a)) forall (a :: Constraint). a => Dict a Dict reifiable' :: (Reifiable c, Reifies s (Methods c a)) => proxy s -> Dict (c (Reflected c s a)) reifiable' :: proxy s -> Dict (c (Reflected c s a)) reifiable' _ = Dict (c (Reflected c s a)) forall (c :: * -> Constraint) k (s :: k) a. (Reifiable c, Reifies s (Methods c a)) => Dict (c (Reflected c s a)) reifiable by :: ∀ c f a . (Reifiable c, Functor (Iso (->)) (->) f) => Methods c a -> (∀ a . c a => f a) -> f a by :: Methods c a -> (forall a. c a => f a) -> f a by methods :: Methods c a methods a :: forall a. c a => f a a = Methods c a -> (forall s. Reifies s (Methods c a) => Proxy s -> f a) -> f a forall a r. a -> (forall s. Reifies s a => Proxy s -> r) -> r reify Methods c a methods (\ proxy :: Proxy s proxy -> (Reflected c s a -> a) -> (a -> Reflected c s a) -> Iso (->) (Reflected c s a) a forall k (s :: k -> k -> *) (a :: k) (b :: k). s a b -> s b a -> Iso s a b Iso (Proxy s -> Reflected c s a -> a forall k k (proxy :: k -> *) (s :: k) (c :: k) a. proxy s -> Reflected c s a -> a unReflected' Proxy s proxy) (forall s a. a -> Reflected c s a forall k k (c :: k) (s :: k) a. a -> Reflected c s a Reflected @c) Iso (->) (Reflected c s a) a -> f (Reflected c s a) -> f a forall α (s :: α -> α -> *) (f :: α -> *) (a :: α) (b :: α). Functor s (->) f => s a b -> f a -> f b <$> Dict (c (Reflected c s a)) -> (c (Reflected c s a) => f (Reflected c s a)) -> f (Reflected c s a) forall (a :: Constraint) b. Dict a -> (a => b) -> b withDict (Proxy s -> Dict (c (Reflected c s a)) forall k (c :: * -> Constraint) (s :: k) a (proxy :: k -> *). (Reifiable c, Reifies s (Methods c a)) => proxy s -> Dict (c (Reflected c s a)) reifiable' Proxy s proxy) c (Reflected c s a) => f (Reflected c s a) forall a. c a => f a a) instance Reifiable Eq where newtype Methods Eq a = EqMethods { Methods Eq a -> a -> a -> Bool eqMethod :: a -> a -> Bool } instance Reifiable Ord where newtype Methods Ord a = OrdMethods { Methods Ord a -> a -> a -> Ordering compareMethod :: a -> a -> Ordering } instance Reifiable Semigroup where newtype Methods Semigroup a = SemigroupMethods { Methods Semigroup a -> a -> a -> a combineMethod :: a -> a -> a } instance Reifiable Monoid where data Methods Monoid a = MonoidMethods { Methods Monoid a -> Methods Semigroup a semigroupMethods :: Methods Semigroup a , Methods Monoid a -> a memptyMethod :: a } instance {-# OVERLAPPING #-} Functor (Iso (->)) (->) (Methods Ord) where map :: Iso (->) a b -> Methods Ord a -> Methods Ord b map (Iso _ f :: b -> a f) (OrdMethods cmp) = (b -> b -> Ordering) -> Methods Ord b forall a. (a -> a -> Ordering) -> Methods Ord a OrdMethods (a -> a -> Ordering cmp (a -> a -> Ordering) -> (b -> a) -> b -> b -> Ordering forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c `on` b -> a f) instance {-# OVERLAPPING #-} Functor (Iso (->)) (->) (Methods Eq) where map :: Iso (->) a b -> Methods Eq a -> Methods Eq b map (Iso _ f :: b -> a f) (EqMethods eq) = (b -> b -> Bool) -> Methods Eq b forall a. (a -> a -> Bool) -> Methods Eq a EqMethods (a -> a -> Bool eq (a -> a -> Bool) -> (b -> a) -> b -> b -> Bool forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c `on` b -> a f) instance {-# OVERLAPPING #-} Functor (Iso (->)) (->) (Methods Semigroup) where map :: Iso (->) a b -> Methods Semigroup a -> Methods Semigroup b map (Iso f :: a -> b f f' :: b -> a f') (SemigroupMethods (<>)) = (b -> b -> b) -> Methods Semigroup b forall a. (a -> a -> a) -> Methods Semigroup a SemigroupMethods (\ a :: b a b :: b b -> a -> b f (b -> a f' b a a -> a -> a <> b -> a f' b b)) instance {-# OVERLAPPING #-} Functor (Iso (->)) (->) (Methods Monoid) where map :: Iso (->) a b -> Methods Monoid a -> Methods Monoid b map φ :: Iso (->) a b φ@(Iso f :: a -> b f _) (MonoidMethods sg mempty) = Methods Semigroup b -> b -> Methods Monoid b forall a. Methods Semigroup a -> a -> Methods Monoid a MonoidMethods (Iso (->) a b φ Iso (->) a b -> Methods Semigroup a -> Methods Semigroup b forall α (s :: α -> α -> *) (f :: α -> *) (a :: α) (b :: α). Functor s (->) f => s a b -> f a -> f b <$> Methods Semigroup a sg) (a -> b f a mempty) instance Reifies s (Methods Eq a) => Eq (Reflected Eq s a) where == :: Reflected Eq s a -> Reflected Eq s a -> Bool (==) = (Methods Eq a -> a -> a -> Bool forall a. Methods Eq a -> a -> a -> Bool eqMethod (Methods Eq a -> a -> a -> Bool) -> (Proxy s -> Methods Eq a) -> Proxy s -> a -> a -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Proxy s -> Methods Eq a forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a reflect) (Proxy s forall k (t :: k). Proxy t Proxy @s) (a -> a -> Bool) -> (Reflected Eq s a -> a) -> Reflected Eq s a -> Reflected Eq s a -> Bool forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c `on` Reflected Eq s a -> a forall k (c :: k) k (s :: k) a. Reflected c s a -> a unReflected instance Reifies s (Methods Ord a) => Eq (Reflected Ord s a) where x :: Reflected Ord s a x == :: Reflected Ord s a -> Reflected Ord s a -> Bool == y :: Reflected Ord s a y = Ordering EQ Ordering -> Ordering -> Bool forall a. Eq a => a -> a -> Bool == Reflected Ord s a -> Reflected Ord s a -> Ordering forall a. Ord a => a -> a -> Ordering compare Reflected Ord s a x Reflected Ord s a y instance Reifies s (Methods Ord a) => Ord (Reflected Ord s a) where compare :: Reflected Ord s a -> Reflected Ord s a -> Ordering compare = (Methods Ord a -> a -> a -> Ordering forall a. Methods Ord a -> a -> a -> Ordering compareMethod (Methods Ord a -> a -> a -> Ordering) -> (Proxy s -> Methods Ord a) -> Proxy s -> a -> a -> Ordering forall b c a. (b -> c) -> (a -> b) -> a -> c . Proxy s -> Methods Ord a forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a reflect) (Proxy s forall k (t :: k). Proxy t Proxy @s) (a -> a -> Ordering) -> (Reflected Ord s a -> a) -> Reflected Ord s a -> Reflected Ord s a -> Ordering forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c `on` Reflected Ord s a -> a forall k (c :: k) k (s :: k) a. Reflected c s a -> a unReflected instance Reifies s (Methods Semigroup a) => Semigroup (Reflected Semigroup s a) where a :: Reflected Semigroup s a a <> :: Reflected Semigroup s a -> Reflected Semigroup s a -> Reflected Semigroup s a <> b :: Reflected Semigroup s a b = a -> Reflected Semigroup s a forall k k (c :: k) (s :: k) a. a -> Reflected c s a Reflected (a -> Reflected Semigroup s a) -> a -> Reflected Semigroup s a forall a b. (a -> b) -> a -> b $ ((Methods Semigroup a -> a -> a -> a forall a. Methods Semigroup a -> a -> a -> a combineMethod (Methods Semigroup a -> a -> a -> a) -> (Proxy s -> Methods Semigroup a) -> Proxy s -> a -> a -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . Proxy s -> Methods Semigroup a forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a reflect) (Proxy s forall k (t :: k). Proxy t Proxy @s) (a -> a -> a) -> (Reflected Semigroup s a -> a) -> Reflected Semigroup s a -> Reflected Semigroup s a -> a forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c `on` Reflected Semigroup s a -> a forall k (c :: k) k (s :: k) a. Reflected c s a -> a unReflected) Reflected Semigroup s a a Reflected Semigroup s a b instance Reifies s (Methods Monoid a) => Semigroup (Reflected Monoid s a) where a :: Reflected Monoid s a a <> :: Reflected Monoid s a -> Reflected Monoid s a -> Reflected Monoid s a <> b :: Reflected Monoid s a b = a -> Reflected Monoid s a forall k k (c :: k) (s :: k) a. a -> Reflected c s a Reflected (a -> Reflected Monoid s a) -> a -> Reflected Monoid s a forall a b. (a -> b) -> a -> b $ ((Methods Semigroup a -> a -> a -> a forall a. Methods Semigroup a -> a -> a -> a combineMethod (Methods Semigroup a -> a -> a -> a) -> (Proxy s -> Methods Semigroup a) -> Proxy s -> a -> a -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . Methods Monoid a -> Methods Semigroup a forall a. Methods Monoid a -> Methods Semigroup a semigroupMethods (Methods Monoid a -> Methods Semigroup a) -> (Proxy s -> Methods Monoid a) -> Proxy s -> Methods Semigroup a forall b c a. (b -> c) -> (a -> b) -> a -> c . Proxy s -> Methods Monoid a forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a reflect) (Proxy s forall k (t :: k). Proxy t Proxy @s) (a -> a -> a) -> (Reflected Monoid s a -> a) -> Reflected Monoid s a -> Reflected Monoid s a -> a forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c `on` Reflected Monoid s a -> a forall k (c :: k) k (s :: k) a. Reflected c s a -> a unReflected) Reflected Monoid s a a Reflected Monoid s a b instance Reifies s (Methods Monoid a) => Monoid (Reflected Monoid s a) where mempty :: Reflected Monoid s a mempty = a -> Reflected Monoid s a forall k k (c :: k) (s :: k) a. a -> Reflected c s a Reflected (a -> Reflected Monoid s a) -> a -> Reflected Monoid s a forall a b. (a -> b) -> a -> b $ (Methods Monoid a -> a forall a. Methods Monoid a -> a memptyMethod (Methods Monoid a -> a) -> (Proxy s -> Methods Monoid a) -> Proxy s -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . Proxy s -> Methods Monoid a forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a reflect) (Proxy s forall k (t :: k). Proxy t Proxy @s)