module Data.Profunctor.Remember where

import Data.Profunctor

-- This is just Tagged + Closed, so it doesn't add anything new.
newtype Remember r a b = Remember (r -> b)
  deriving a -> Remember r a b -> Remember r a a
(a -> b) -> Remember r a a -> Remember r a b
(forall a b. (a -> b) -> Remember r a a -> Remember r a b)
-> (forall a b. a -> Remember r a b -> Remember r a a)
-> Functor (Remember r a)
forall a b. a -> Remember r a b -> Remember r a a
forall a b. (a -> b) -> Remember r a a -> Remember r a b
forall r a a b. a -> Remember r a b -> Remember r a a
forall r a a b. (a -> b) -> Remember r a a -> Remember r a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Remember r a b -> Remember r a a
$c<$ :: forall r a a b. a -> Remember r a b -> Remember r a a
fmap :: (a -> b) -> Remember r a a -> Remember r a b
$cfmap :: forall r a a b. (a -> b) -> Remember r a a -> Remember r a b
Functor

instance Profunctor (Remember r) where
  dimap :: (a -> b) -> (c -> d) -> Remember r b c -> Remember r a d
dimap _ g :: c -> d
g (Remember x :: r -> c
x) = (r -> d) -> Remember r a d
forall r a b. (r -> b) -> Remember r a b
Remember (c -> d
g (c -> d) -> (r -> c) -> r -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> c
x)

instance Choice (Remember r) where
  left' :: Remember r a b -> Remember r (Either a c) (Either b c)
left' (Remember x :: r -> b
x) = (r -> Either b c) -> Remember r (Either a c) (Either b c)
forall r a b. (r -> b) -> Remember r a b
Remember (b -> Either b c
forall a b. a -> Either a b
Left (b -> Either b c) -> (r -> b) -> r -> Either b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> b
x)

instance Closed (Remember r) where
  closed :: Remember r a b -> Remember r (x -> a) (x -> b)
closed (Remember x :: r -> b
x) = (r -> x -> b) -> Remember r (x -> a) (x -> b)
forall r a b. (r -> b) -> Remember r a b
Remember (\r :: r
r _ -> r -> b
x r
r)

instance Costrong (Remember r) where
  unfirst :: Remember r (a, d) (b, d) -> Remember r a b
unfirst (Remember x :: r -> (b, d)
x) = (r -> b) -> Remember r a b
forall r a b. (r -> b) -> Remember r a b
Remember ((b, d) -> b
forall a b. (a, b) -> a
fst ((b, d) -> b) -> (r -> (b, d)) -> r -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> (b, d)
x)