{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE DefaultSignatures #-} module Data.Profunctor.Annotated where import Data.Profunctor import Data.Tagged class (Profunctor p, Profunctor q) => Annotatable e p q | q -> p where coindexed :: p a (e, b) -> q a b default coindexed :: (p ~ q) => p a (e, b) -> q a b coindexed = ((e, b) -> b) -> q a (e, b) -> q a b forall (p :: * -> * -> *) b c a. Profunctor p => (b -> c) -> p a b -> p a c rmap (e, b) -> b forall a b. (a, b) -> b snd data Annotated e p a b = Annotated {Annotated e p a b -> p a (e, b) runCoindexed :: (p a (e, b))} instance Profunctor p => Profunctor (Annotated e p) where dimap :: (a -> b) -> (c -> d) -> Annotated e p b c -> Annotated e p a d dimap f :: a -> b f g :: c -> d g (Annotated p :: p b (e, c) p) = p a (e, d) -> Annotated e p a d forall e (p :: * -> * -> *) a b. p a (e, b) -> Annotated e p a b Annotated ((a -> b) -> ((e, c) -> (e, d)) -> p b (e, c) -> p a (e, d) forall (p :: * -> * -> *) a b c d. Profunctor p => (a -> b) -> (c -> d) -> p b c -> p a d dimap a -> b f ((c -> d) -> (e, c) -> (e, d) forall (p :: * -> * -> *) a b c. Strong p => p a b -> p (c, a) (c, b) second' c -> d g) p b (e, c) p) instance Strong p => Strong (Annotated i p) where second' :: Annotated i p a b -> Annotated i p (c, a) (c, b) second' (Annotated p :: p a (i, b) p) = p (c, a) (i, (c, b)) -> Annotated i p (c, a) (c, b) forall e (p :: * -> * -> *) a b. p a (e, b) -> Annotated e p a b Annotated (((c, a) -> (c, a)) -> ((c, (i, b)) -> (i, (c, b))) -> p (c, a) (c, (i, b)) -> p (c, a) (i, (c, b)) forall (p :: * -> * -> *) a b c d. Profunctor p => (a -> b) -> (c -> d) -> p b c -> p a d dimap (c, a) -> (c, a) forall a. a -> a id (c, (i, b)) -> (i, (c, b)) forall a a b. (a, (a, b)) -> (a, (a, b)) reassoc (p (c, a) (c, (i, b)) -> p (c, a) (i, (c, b))) -> p (c, a) (c, (i, b)) -> p (c, a) (i, (c, b)) forall a b. (a -> b) -> a -> b $ p a (i, b) -> p (c, a) (c, (i, b)) forall (p :: * -> * -> *) a b c. Strong p => p a b -> p (c, a) (c, b) second' p a (i, b) p) where reassoc :: (a, (a, b)) -> (a, (a, b)) reassoc (c :: a c, (i :: a i, b :: b b)) = (a i, (a c, b b)) instance Profunctor p => Annotatable i p (Annotated i p) where coindexed :: p a (i, b) -> Annotated i p a b coindexed p :: p a (i, b) p = p a (i, b) -> Annotated i p a b forall e (p :: * -> * -> *) a b. p a (e, b) -> Annotated e p a b Annotated p a (i, b) p instance Annotatable e (Forget r) (Forget r) where coindexed :: Forget r a (e, b) -> Forget r a b coindexed (Forget f :: a -> r f) = ((a -> r) -> Forget r a b forall r a b. (a -> r) -> Forget r a b Forget a -> r f) instance Annotatable e (->) (->) where instance Functor f => Annotatable e (Star f) (Star f) where instance Functor f => Annotatable e (Costar f) (Costar f) where instance Annotatable e Tagged Tagged where