{-# LANGUAGE ScopedTypeVariables #-}
module Data.Profunctor.Reflector where

import Data.Tagged

import Data.Profunctor
import Data.Profunctor.MStrong
import Data.Distributive

class MStrong p => Reflector p where
  reflected :: Applicative f => p a b -> p (f a) (f b)

instance Reflector (->) where
  reflected :: (a -> b) -> f a -> f b
reflected = (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

instance Traversable f => Reflector (Costar f) where
  reflected :: Costar f a b -> Costar f (f a) (f b)
reflected (Costar f :: f a -> b
f) = (f (f a) -> f b) -> Costar f (f a) (f b)
forall (f :: * -> *) d c. (f d -> c) -> Costar f d c
Costar ((f a -> b) -> f (f a) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> b
f (f (f a) -> f b) -> (f (f a) -> f (f a)) -> f (f a) -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (f a) -> f (f a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA)

instance Reflector Tagged where
  reflected :: Tagged a b -> Tagged (f a) (f b)
reflected (Tagged b :: b
b) = f b -> Tagged (f a) (f b)
forall k (s :: k) b. b -> Tagged s b
Tagged (b -> f b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b)

instance Distributive f => Reflector (Star f) where
  reflected :: Star f a b -> Star f (f a) (f b)
reflected (Star f :: a -> f b
f) = (f a -> f (f b)) -> Star f (f a) (f b)
forall (f :: * -> *) d c. (d -> f c) -> Star f d c
Star ((a -> f b) -> f a -> f (f b)
forall (g :: * -> *) (f :: * -> *) a b.
(Distributive g, Functor f) =>
(a -> g b) -> f a -> g (f b)
collect a -> f b
f)

-- instance (MStrong p, Corepresentable p, Traversable f, Corep p ~ f) => Reflector p where
--   reflected p = cotabulate . go $ cosieve p
--     where
--       go :: forall g a b. Applicative g => (f a -> b) -> f (g a) -> (g b)
--       go f fga = f <$> sequenceA fga