{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
module Fresnel.Profunctor.Recall
( -- * Recall profunctor
  Recall(..)
) where

import Data.Bifunctor
import Data.Coerce
import Data.Functor.Const
import Data.Profunctor
import Data.Profunctor.Rep as Pro
import Data.Profunctor.Sieve
import Data.Profunctor.Unsafe

-- Recall profunctor

-- | @'Recall' e@ is dual to @'Forget' r@: it ignores the argument parameter, substituting in one of its own.
newtype Recall e a b = Recall { Recall e a b -> e -> b
runRecall :: e -> b }
  deriving (Functor (Recall e a)
a -> Recall e a a
Functor (Recall e a)
-> (forall a. a -> Recall e a a)
-> (forall a b.
    Recall e a (a -> b) -> Recall e a a -> Recall e a b)
-> (forall a b c.
    (a -> b -> c) -> Recall e a a -> Recall e a b -> Recall e a c)
-> (forall a b. Recall e a a -> Recall e a b -> Recall e a b)
-> (forall a b. Recall e a a -> Recall e a b -> Recall e a a)
-> Applicative (Recall e a)
Recall e a a -> Recall e a b -> Recall e a b
Recall e a a -> Recall e a b -> Recall e a a
Recall e a (a -> b) -> Recall e a a -> Recall e a b
(a -> b -> c) -> Recall e a a -> Recall e a b -> Recall e a c
forall a. a -> Recall e a a
forall e a. Functor (Recall e a)
forall a b. Recall e a a -> Recall e a b -> Recall e a a
forall a b. Recall e a a -> Recall e a b -> Recall e a b
forall a b. Recall e a (a -> b) -> Recall e a a -> Recall e a b
forall e a a. a -> Recall e a a
forall a b c.
(a -> b -> c) -> Recall e a a -> Recall e a b -> Recall e a c
forall e a a b. Recall e a a -> Recall e a b -> Recall e a a
forall e a a b. Recall e a a -> Recall e a b -> Recall e a b
forall e a a b. Recall e a (a -> b) -> Recall e a a -> Recall e a b
forall e a a b c.
(a -> b -> c) -> Recall e a a -> Recall e a b -> Recall e a c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Recall e a a -> Recall e a b -> Recall e a a
$c<* :: forall e a a b. Recall e a a -> Recall e a b -> Recall e a a
*> :: Recall e a a -> Recall e a b -> Recall e a b
$c*> :: forall e a a b. Recall e a a -> Recall e a b -> Recall e a b
liftA2 :: (a -> b -> c) -> Recall e a a -> Recall e a b -> Recall e a c
$cliftA2 :: forall e a a b c.
(a -> b -> c) -> Recall e a a -> Recall e a b -> Recall e a c
<*> :: Recall e a (a -> b) -> Recall e a a -> Recall e a b
$c<*> :: forall e a a b. Recall e a (a -> b) -> Recall e a a -> Recall e a b
pure :: a -> Recall e a a
$cpure :: forall e a a. a -> Recall e a a
$cp1Applicative :: forall e a. Functor (Recall e a)
Applicative, a -> Recall e a b -> Recall e a a
(a -> b) -> Recall e a a -> Recall e a b
(forall a b. (a -> b) -> Recall e a a -> Recall e a b)
-> (forall a b. a -> Recall e a b -> Recall e a a)
-> Functor (Recall e a)
forall a b. a -> Recall e a b -> Recall e a a
forall a b. (a -> b) -> Recall e a a -> Recall e a b
forall e a a b. a -> Recall e a b -> Recall e a a
forall e a a b. (a -> b) -> Recall e a a -> Recall e a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Recall e a b -> Recall e a a
$c<$ :: forall e a a b. a -> Recall e a b -> Recall e a a
fmap :: (a -> b) -> Recall e a a -> Recall e a b
$cfmap :: forall e a a b. (a -> b) -> Recall e a a -> Recall e a b
Functor, Applicative (Recall e a)
a -> Recall e a a
Applicative (Recall e a)
-> (forall a b.
    Recall e a a -> (a -> Recall e a b) -> Recall e a b)
-> (forall a b. Recall e a a -> Recall e a b -> Recall e a b)
-> (forall a. a -> Recall e a a)
-> Monad (Recall e a)
Recall e a a -> (a -> Recall e a b) -> Recall e a b
Recall e a a -> Recall e a b -> Recall e a b
forall a. a -> Recall e a a
forall e a. Applicative (Recall e a)
forall a b. Recall e a a -> Recall e a b -> Recall e a b
forall a b. Recall e a a -> (a -> Recall e a b) -> Recall e a b
forall e a a. a -> Recall e a a
forall e a a b. Recall e a a -> Recall e a b -> Recall e a b
forall e a a b. Recall e a a -> (a -> Recall e a b) -> Recall e a b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Recall e a a
$creturn :: forall e a a. a -> Recall e a a
>> :: Recall e a a -> Recall e a b -> Recall e a b
$c>> :: forall e a a b. Recall e a a -> Recall e a b -> Recall e a b
>>= :: Recall e a a -> (a -> Recall e a b) -> Recall e a b
$c>>= :: forall e a a b. Recall e a a -> (a -> Recall e a b) -> Recall e a b
$cp1Monad :: forall e a. Applicative (Recall e a)
Monad, Semigroup (Recall e a b)
Recall e a b
Semigroup (Recall e a b)
-> Recall e a b
-> (Recall e a b -> Recall e a b -> Recall e a b)
-> ([Recall e a b] -> Recall e a b)
-> Monoid (Recall e a b)
[Recall e a b] -> Recall e a b
Recall e a b -> Recall e a b -> Recall e a b
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall e a b. Monoid b => Semigroup (Recall e a b)
forall e a b. Monoid b => Recall e a b
forall e a b. Monoid b => [Recall e a b] -> Recall e a b
forall e a b.
Monoid b =>
Recall e a b -> Recall e a b -> Recall e a b
mconcat :: [Recall e a b] -> Recall e a b
$cmconcat :: forall e a b. Monoid b => [Recall e a b] -> Recall e a b
mappend :: Recall e a b -> Recall e a b -> Recall e a b
$cmappend :: forall e a b.
Monoid b =>
Recall e a b -> Recall e a b -> Recall e a b
mempty :: Recall e a b
$cmempty :: forall e a b. Monoid b => Recall e a b
$cp1Monoid :: forall e a b. Monoid b => Semigroup (Recall e a b)
Monoid, b -> Recall e a b -> Recall e a b
NonEmpty (Recall e a b) -> Recall e a b
Recall e a b -> Recall e a b -> Recall e a b
(Recall e a b -> Recall e a b -> Recall e a b)
-> (NonEmpty (Recall e a b) -> Recall e a b)
-> (forall b. Integral b => b -> Recall e a b -> Recall e a b)
-> Semigroup (Recall e a b)
forall b. Integral b => b -> Recall e a b -> Recall e a b
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall e a b.
Semigroup b =>
NonEmpty (Recall e a b) -> Recall e a b
forall e a b.
Semigroup b =>
Recall e a b -> Recall e a b -> Recall e a b
forall e a b b.
(Semigroup b, Integral b) =>
b -> Recall e a b -> Recall e a b
stimes :: b -> Recall e a b -> Recall e a b
$cstimes :: forall e a b b.
(Semigroup b, Integral b) =>
b -> Recall e a b -> Recall e a b
sconcat :: NonEmpty (Recall e a b) -> Recall e a b
$csconcat :: forall e a b.
Semigroup b =>
NonEmpty (Recall e a b) -> Recall e a b
<> :: Recall e a b -> Recall e a b -> Recall e a b
$c<> :: forall e a b.
Semigroup b =>
Recall e a b -> Recall e a b -> Recall e a b
Semigroup)

instance Bifunctor (Recall e) where
  bimap :: (a -> b) -> (c -> d) -> Recall e a c -> Recall e b d
bimap a -> b
_ c -> d
g = (e -> d) -> Recall e b d
forall e a b. (e -> b) -> Recall e a b
Recall ((e -> d) -> Recall e b d)
-> (Recall e a c -> e -> d) -> Recall e a c -> Recall e b d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> d) -> (e -> c) -> e -> d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g ((e -> c) -> e -> d)
-> (Recall e a c -> e -> c) -> Recall e a c -> e -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Recall e a c -> e -> c
forall e a b. Recall e a b -> e -> b
runRecall
  second :: (b -> c) -> Recall e a b -> Recall e a c
second = (b -> c) -> Recall e a b -> Recall e a c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

instance Profunctor (Recall e) where
  dimap :: (a -> b) -> (c -> d) -> Recall e b c -> Recall e a d
dimap a -> b
_ c -> d
g = (e -> d) -> Recall e a d
forall e a b. (e -> b) -> Recall e a b
Recall ((e -> d) -> Recall e a d)
-> (Recall e b c -> e -> d) -> Recall e b c -> Recall e a d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> d) -> (e -> c) -> e -> d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g ((e -> c) -> e -> d)
-> (Recall e b c -> e -> c) -> Recall e b c -> e -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Recall e b c -> e -> c
forall e a b. Recall e a b -> e -> b
runRecall
  lmap :: (a -> b) -> Recall e b c -> Recall e a c
lmap = (Recall e b c -> Recall e a c)
-> (a -> b) -> Recall e b c -> Recall e a c
forall a b. a -> b -> a
const Recall e b c -> Recall e a c
coerce
  rmap :: (b -> c) -> Recall e a b -> Recall e a c
rmap = (b -> c) -> Recall e a b -> Recall e a c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  #. :: q b c -> Recall e a b -> Recall e a c
(#.) = (Recall e a b -> Recall e a c)
-> q b c -> Recall e a b -> Recall e a c
forall a b. a -> b -> a
const Recall e a b -> Recall e a c
coerce
  .# :: Recall e b c -> q a b -> Recall e a c
(.#) = (Recall e b c -> Recall e a c)
-> (q a b -> Recall e b c) -> q a b -> Recall e a c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Recall e b c -> Recall e a c
coerce ((q a b -> Recall e b c) -> q a b -> Recall e a c)
-> (Recall e b c -> q a b -> Recall e b c)
-> Recall e b c
-> q a b
-> Recall e a c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Recall e b c -> q a b -> Recall e b c
forall a b. a -> b -> a
const

instance Choice (Recall e) where
  left' :: Recall e a b -> Recall e (Either a c) (Either b c)
left'  = (e -> Either b c) -> Recall e (Either a c) (Either b c)
forall e a b. (e -> b) -> Recall e a b
Recall ((e -> Either b c) -> Recall e (Either a c) (Either b c))
-> (Recall e a b -> e -> Either b c)
-> Recall e a b
-> Recall e (Either a c) (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Either b c) -> (e -> b) -> e -> Either b c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either b c
forall a b. a -> Either a b
Left  ((e -> b) -> e -> Either b c)
-> (Recall e a b -> e -> b) -> Recall e a b -> e -> Either b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Recall e a b -> e -> b
forall e a b. Recall e a b -> e -> b
runRecall
  right' :: Recall e a b -> Recall e (Either c a) (Either c b)
right' = (e -> Either c b) -> Recall e (Either c a) (Either c b)
forall e a b. (e -> b) -> Recall e a b
Recall ((e -> Either c b) -> Recall e (Either c a) (Either c b))
-> (Recall e a b -> e -> Either c b)
-> Recall e a b
-> Recall e (Either c a) (Either c b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Either c b) -> (e -> b) -> e -> Either c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either c b
forall a b. b -> Either a b
Right ((e -> b) -> e -> Either c b)
-> (Recall e a b -> e -> b) -> Recall e a b -> e -> Either c b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Recall e a b -> e -> b
forall e a b. Recall e a b -> e -> b
runRecall

instance Closed (Recall e) where
  closed :: Recall e a b -> Recall e (x -> a) (x -> b)
closed = (e -> x -> b) -> Recall e (x -> a) (x -> b)
forall e a b. (e -> b) -> Recall e a b
Recall ((e -> x -> b) -> Recall e (x -> a) (x -> b))
-> (Recall e a b -> e -> x -> b)
-> Recall e a b
-> Recall e (x -> a) (x -> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> x -> b) -> (e -> b) -> e -> x -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> x -> b
forall a b. a -> b -> a
const ((e -> b) -> e -> x -> b)
-> (Recall e a b -> e -> b) -> Recall e a b -> e -> x -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Recall e a b -> e -> b
forall e a b. Recall e a b -> e -> b
runRecall

instance Costrong (Recall e) where
  unfirst :: Recall e (a, d) (b, d) -> Recall e a b
unfirst  = (e -> b) -> Recall e a b
forall e a b. (e -> b) -> Recall e a b
Recall ((e -> b) -> Recall e a b)
-> (Recall e (a, d) (b, d) -> e -> b)
-> Recall e (a, d) (b, d)
-> Recall e a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, d) -> b) -> (e -> (b, d)) -> e -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, d) -> b
forall a b. (a, b) -> a
fst ((e -> (b, d)) -> e -> b)
-> (Recall e (a, d) (b, d) -> e -> (b, d))
-> Recall e (a, d) (b, d)
-> e
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Recall e (a, d) (b, d) -> e -> (b, d)
forall e a b. Recall e a b -> e -> b
runRecall
  unsecond :: Recall e (d, a) (d, b) -> Recall e a b
unsecond = (e -> b) -> Recall e a b
forall e a b. (e -> b) -> Recall e a b
Recall ((e -> b) -> Recall e a b)
-> (Recall e (d, a) (d, b) -> e -> b)
-> Recall e (d, a) (d, b)
-> Recall e a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((d, b) -> b) -> (e -> (d, b)) -> e -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (d, b) -> b
forall a b. (a, b) -> b
snd ((e -> (d, b)) -> e -> b)
-> (Recall e (d, a) (d, b) -> e -> (d, b))
-> Recall e (d, a) (d, b)
-> e
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Recall e (d, a) (d, b) -> e -> (d, b)
forall e a b. Recall e a b -> e -> b
runRecall

instance Sieve (Recall e) ((->) e) where
  sieve :: Recall e a b -> a -> e -> b
sieve = (e -> b) -> a -> e -> b
forall a b. a -> b -> a
const ((e -> b) -> a -> e -> b)
-> (Recall e a b -> e -> b) -> Recall e a b -> a -> e -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Recall e a b -> e -> b
forall e a b. Recall e a b -> e -> b
runRecall

instance Cosieve (Recall e) (Const e) where
  cosieve :: Recall e a b -> Const e a -> b
cosieve = (Const e a -> e) -> (e -> b) -> Const e a -> b
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap Const e a -> e
forall a k (b :: k). Const a b -> a
getConst ((e -> b) -> Const e a -> b)
-> (Recall e a b -> e -> b) -> Recall e a b -> Const e a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Recall e a b -> e -> b
forall e a b. Recall e a b -> e -> b
runRecall

instance Pro.Corepresentable (Recall e) where
  type Corep (Recall e) = Const e

  cotabulate :: (Corep (Recall e) d -> c) -> Recall e d c
cotabulate = (e -> c) -> Recall e d c
forall e a b. (e -> b) -> Recall e a b
Recall ((e -> c) -> Recall e d c)
-> ((Const e d -> c) -> e -> c) -> (Const e d -> c) -> Recall e d c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> Const e d) -> (Const e d -> c) -> e -> c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap e -> Const e d
forall k a (b :: k). a -> Const a b
Const