{-# 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