module Data.HFunctor.Route (
Pre(..)
, interpretPre, getPre, retractPre
, injectPre, mapPre
, preDivisible, preDivise, preContravariant
, Post(..)
, interpretPost, getPost, retractPost
, injectPost, mapPost
, postPlus, postAlt, postFunctor
, PreT(..)
, preDivisibleT, preDiviseT, preContravariantT
, PostT(..)
, postPlusT, postAltT, postFunctorT
) where
import Control.Natural
import Data.Functor.Contravariant
import Data.Functor.Contravariant.Divise
import Data.Functor.Contravariant.Divisible
import Data.Functor.Invariant
import Data.Functor.Plus
import Data.HFunctor
import Data.HFunctor.Interpret
import Data.Profunctor
import Data.Void
data Pre a f b = (a -> b) :>$<: f b
deriving a -> Pre a f b -> Pre a f a
(a -> b) -> Pre a f a -> Pre a f b
(forall a b. (a -> b) -> Pre a f a -> Pre a f b)
-> (forall a b. a -> Pre a f b -> Pre a f a) -> Functor (Pre a f)
forall a b. a -> Pre a f b -> Pre a f a
forall a b. (a -> b) -> Pre a f a -> Pre a f b
forall a (f :: * -> *) a b.
Functor f =>
a -> Pre a f b -> Pre a f a
forall a (f :: * -> *) a b.
Functor f =>
(a -> b) -> Pre a f a -> Pre a f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Pre a f b -> Pre a f a
$c<$ :: forall a (f :: * -> *) a b.
Functor f =>
a -> Pre a f b -> Pre a f a
fmap :: (a -> b) -> Pre a f a -> Pre a f b
$cfmap :: forall a (f :: * -> *) a b.
Functor f =>
(a -> b) -> Pre a f a -> Pre a f b
Functor
data Post a f b = (b -> a) :<$>: f b
instance Contravariant f => Contravariant (Post a f) where
contramap :: (a -> b) -> Post a f b -> Post a f a
contramap f :: a -> b
f (g :: b -> a
g :<$>: x :: f b
x) = b -> a
g (b -> a) -> (a -> b) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f (a -> a) -> f a -> Post a f a
forall a (f :: * -> *) b. (b -> a) -> f b -> Post a f b
:<$>: (a -> b) -> f b -> f a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
f f b
x
infixl 4 :>$<:
infixl 4 :<$>:
newtype PreT t f a = PreT { PreT t f a -> t (Pre a f) a
unPreT :: t (Pre a f) a }
instance (HFunctor t, forall x. Functor (t (Pre x f))) => Invariant (PreT t f) where
invmap :: (a -> b) -> (b -> a) -> PreT t f a -> PreT t f b
invmap f :: a -> b
f g :: b -> a
g = t (Pre b f) b -> PreT t f b
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a.
t (Pre a f) a -> PreT t f a
PreT
(t (Pre b f) b -> PreT t f b)
-> (PreT t f a -> t (Pre b f) b) -> PreT t f a -> PreT t f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pre a f ~> Pre b f) -> t (Pre a f) ~> t (Pre b f)
forall k k (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *).
HFunctor t =>
(f ~> g) -> t f ~> t g
hmap ((b -> a) -> Pre a f x -> Pre b f x
forall c a (f :: * -> *) b. (c -> a) -> Pre a f b -> Pre c f b
mapPre b -> a
g)
(t (Pre a f) b -> t (Pre b f) b)
-> (PreT t f a -> t (Pre a f) b) -> PreT t f a -> t (Pre b f) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> t (Pre a f) a -> t (Pre a f) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f
(t (Pre a f) a -> t (Pre a f) b)
-> (PreT t f a -> t (Pre a f) a) -> PreT t f a -> t (Pre a f) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreT t f a -> t (Pre a f) a
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a.
PreT t f a -> t (Pre a f) a
unPreT
instance HFunctor t => HFunctor (PreT t) where
hmap :: (f ~> g) -> PreT t f ~> PreT t g
hmap f :: f ~> g
f = t (Pre x g) x -> PreT t g x
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a.
t (Pre a f) a -> PreT t f a
PreT (t (Pre x g) x -> PreT t g x)
-> (PreT t f x -> t (Pre x g) x) -> PreT t f x -> PreT t g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pre x f ~> Pre x g) -> t (Pre x f) ~> t (Pre x g)
forall k k (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *).
HFunctor t =>
(f ~> g) -> t f ~> t g
hmap ((f ~> g) -> Pre x f ~> Pre x g
forall k k (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *).
HFunctor t =>
(f ~> g) -> t f ~> t g
hmap f ~> g
f) (t (Pre x f) x -> t (Pre x g) x)
-> (PreT t f x -> t (Pre x f) x) -> PreT t f x -> t (Pre x g) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreT t f x -> t (Pre x f) x
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a.
PreT t f a -> t (Pre a f) a
unPreT
instance Inject t => Inject (PreT t) where
inject :: f x -> PreT t f x
inject = t (Pre x f) x -> PreT t f x
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a.
t (Pre a f) a -> PreT t f a
PreT (t (Pre x f) x -> PreT t f x)
-> (f x -> t (Pre x f) x) -> f x -> PreT t f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pre x f x -> t (Pre x f) x
forall k (t :: (k -> *) -> k -> *) (f :: k -> *).
Inject t =>
f ~> t f
inject (Pre x f x -> t (Pre x f) x)
-> (f x -> Pre x f x) -> f x -> t (Pre x f) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> x
forall a. a -> a
id (x -> x) -> f x -> Pre x f x
forall a (f :: * -> *) b. (a -> b) -> f b -> Pre a f b
:>$<:)
instance Interpret t f => Interpret (PreT t) f where
interpret :: (g ~> f) -> PreT t g ~> f
interpret f :: g ~> f
f = (g ~> f) -> t g ~> f
forall k (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *).
Interpret t f =>
(g ~> f) -> t g ~> f
interpret g ~> f
f (t g x -> f x) -> (PreT t g x -> t g x) -> PreT t g x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pre x g ~> g) -> t (Pre x g) ~> t g
forall k k (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *).
HFunctor t =>
(f ~> g) -> t f ~> t g
hmap Pre x g ~> g
forall a (f :: * -> *) b. Pre a f b -> f b
getPre (t (Pre x g) x -> t g x)
-> (PreT t g x -> t (Pre x g) x) -> PreT t g x -> t g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreT t g x -> t (Pre x g) x
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a.
PreT t f a -> t (Pre a f) a
unPreT
newtype PostT t f a = PostT { PostT t f a -> t (Post a f) a
unPostT :: t (Post a f) a }
instance (HFunctor t, forall x. Contravariant (t (Post x f))) => Invariant (PostT t f) where
invmap :: (a -> b) -> (b -> a) -> PostT t f a -> PostT t f b
invmap f :: a -> b
f g :: b -> a
g = t (Post b f) b -> PostT t f b
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a.
t (Post a f) a -> PostT t f a
PostT
(t (Post b f) b -> PostT t f b)
-> (PostT t f a -> t (Post b f) b) -> PostT t f a -> PostT t f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Post a f ~> Post b f) -> t (Post a f) ~> t (Post b f)
forall k k (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *).
HFunctor t =>
(f ~> g) -> t f ~> t g
hmap ((a -> b) -> Post a f x -> Post b f x
forall a c (f :: * -> *) b. (a -> c) -> Post a f b -> Post c f b
mapPost a -> b
f)
(t (Post a f) b -> t (Post b f) b)
-> (PostT t f a -> t (Post a f) b) -> PostT t f a -> t (Post b f) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> a) -> t (Post a f) a -> t (Post a f) b
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap b -> a
g
(t (Post a f) a -> t (Post a f) b)
-> (PostT t f a -> t (Post a f) a) -> PostT t f a -> t (Post a f) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostT t f a -> t (Post a f) a
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a.
PostT t f a -> t (Post a f) a
unPostT
preDivisibleT
:: (forall m. Monoid m => Interpret t (AltConst m), Divisible g)
=> (f ~> g)
-> PreT t f ~> g
preDivisibleT :: (f ~> g) -> PreT t f ~> g
preDivisibleT f :: f ~> g
f = (f ~> g) -> t (Pre x f) x -> g x
forall (t :: (* -> *) -> * -> *) (g :: * -> *) (f :: * -> *) a b.
(forall m. Monoid m => Interpret t (AltConst m), Divisible g) =>
(f ~> g) -> t (Pre a f) b -> g a
preDivisible f ~> g
f (t (Pre x f) x -> g x)
-> (PreT t f x -> t (Pre x f) x) -> PreT t f x -> g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreT t f x -> t (Pre x f) x
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a.
PreT t f a -> t (Pre a f) a
unPreT
preDiviseT
:: (forall m. Semigroup m => Interpret t (AltConst m), Divise g)
=> (f ~> g)
-> PreT t f ~> g
preDiviseT :: (f ~> g) -> PreT t f ~> g
preDiviseT f :: f ~> g
f = (f ~> g) -> t (Pre x f) x -> g x
forall (t :: (* -> *) -> * -> *) (g :: * -> *) (f :: * -> *) a b.
(forall m. Semigroup m => Interpret t (AltConst m), Divise g) =>
(f ~> g) -> t (Pre a f) b -> g a
preDivise f ~> g
f (t (Pre x f) x -> g x)
-> (PreT t f x -> t (Pre x f) x) -> PreT t f x -> g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreT t f x -> t (Pre x f) x
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a.
PreT t f a -> t (Pre a f) a
unPreT
preContravariantT
:: (forall m. Interpret t (AltConst m), Contravariant g)
=> (f ~> g)
-> PreT t f ~> g
preContravariantT :: (f ~> g) -> PreT t f ~> g
preContravariantT f :: f ~> g
f = (f ~> g) -> t (Pre x f) x -> g x
forall (t :: (* -> *) -> * -> *) (g :: * -> *) (f :: * -> *) a b.
(forall m. Interpret t (AltConst m), Contravariant g) =>
(f ~> g) -> t (Pre a f) b -> g a
preContravariant f ~> g
f (t (Pre x f) x -> g x)
-> (PreT t f x -> t (Pre x f) x) -> PreT t f x -> g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreT t f x -> t (Pre x f) x
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a.
PreT t f a -> t (Pre a f) a
unPreT
preDivisible
:: (forall m. Monoid m => Interpret t (AltConst m), Divisible g)
=> (f ~> g)
-> t (Pre a f) b
-> g a
preDivisible :: (f ~> g) -> t (Pre a f) b -> g a
preDivisible f :: f ~> g
f = (g a -> g a -> g a) -> g a -> [g a] -> g a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a -> (a, a)) -> g a -> g a -> g a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide (\x :: a
x -> (a
x,a
x))) g a
forall (f :: * -> *) a. Divisible f => f a
conquer
([g a] -> g a) -> (t (Pre a f) b -> [g a]) -> t (Pre a f) b -> g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. Pre a f x -> g a) -> t (Pre a f) b -> [g a]
forall k (t :: (k -> *) -> k -> *) (f :: k -> *) b (a :: k).
(forall m. Monoid m => Interpret t (AltConst m)) =>
(forall (x :: k). f x -> b) -> t f a -> [b]
icollect ((f ~> g) -> Pre a f x -> g a
forall (g :: * -> *) (f :: * -> *) a b.
Contravariant g =>
(f ~> g) -> Pre a f b -> g a
interpretPre f ~> g
f)
preDivise
:: (forall m. Semigroup m => Interpret t (AltConst m), Divise g)
=> (f ~> g)
-> t (Pre a f) b
-> g a
preDivise :: (f ~> g) -> t (Pre a f) b -> g a
preDivise f :: f ~> g
f = (g a -> g a -> g a) -> NonEmpty (g a) -> g a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 g a -> g a -> g a
forall (f :: * -> *) a. Divise f => f a -> f a -> f a
(<:>) (NonEmpty (g a) -> g a)
-> (t (Pre a f) b -> NonEmpty (g a)) -> t (Pre a f) b -> g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. Pre a f x -> g a) -> t (Pre a f) b -> NonEmpty (g a)
forall k (t :: (k -> *) -> k -> *) (f :: k -> *) b (a :: k).
(forall m. Semigroup m => Interpret t (AltConst m)) =>
(forall (x :: k). f x -> b) -> t f a -> NonEmpty b
icollect1 ((f ~> g) -> Pre a f x -> g a
forall (g :: * -> *) (f :: * -> *) a b.
Contravariant g =>
(f ~> g) -> Pre a f b -> g a
interpretPre f ~> g
f)
preContravariant
:: (forall m. Interpret t (AltConst m), Contravariant g)
=> (f ~> g)
-> t (Pre a f) b
-> g a
preContravariant :: (f ~> g) -> t (Pre a f) b -> g a
preContravariant f :: f ~> g
f = (forall x. Pre a f x -> g a) -> t (Pre a f) b -> g a
forall k (t :: (k -> *) -> k -> *) b (f :: k -> *) (a :: k).
Interpret t (AltConst b) =>
(forall (x :: k). f x -> b) -> t f a -> b
iget ((f ~> g) -> Pre a f x -> g a
forall (g :: * -> *) (f :: * -> *) a b.
Contravariant g =>
(f ~> g) -> Pre a f b -> g a
interpretPre f ~> g
f)
postPlusT
:: (forall m. Monoid m => Interpret t (AltConst m), Plus g)
=> (f ~> g)
-> PostT t f ~> g
postPlusT :: (f ~> g) -> PostT t f ~> g
postPlusT f :: f ~> g
f = (f ~> g) -> t (Post x f) x -> g x
forall (t :: (* -> *) -> * -> *) (g :: * -> *) (f :: * -> *) a b.
(forall m. Monoid m => Interpret t (AltConst m), Plus g) =>
(f ~> g) -> t (Post a f) b -> g a
postPlus f ~> g
f (t (Post x f) x -> g x)
-> (PostT t f x -> t (Post x f) x) -> PostT t f x -> g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostT t f x -> t (Post x f) x
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a.
PostT t f a -> t (Post a f) a
unPostT
postAltT
:: (forall m. Semigroup m => Interpret t (AltConst m), Alt g)
=> (f ~> g)
-> PostT t f ~> g
postAltT :: (f ~> g) -> PostT t f ~> g
postAltT f :: f ~> g
f = (f ~> g) -> t (Post x f) x -> g x
forall (t :: (* -> *) -> * -> *) (g :: * -> *) (f :: * -> *) a b.
(forall m. Semigroup m => Interpret t (AltConst m), Alt g) =>
(f ~> g) -> t (Post a f) b -> g a
postAlt f ~> g
f (t (Post x f) x -> g x)
-> (PostT t f x -> t (Post x f) x) -> PostT t f x -> g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostT t f x -> t (Post x f) x
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a.
PostT t f a -> t (Post a f) a
unPostT
postFunctorT
:: (forall m. Interpret t (AltConst m), Functor g)
=> (f ~> g)
-> PostT t f ~> g
postFunctorT :: (f ~> g) -> PostT t f ~> g
postFunctorT f :: f ~> g
f = (f ~> g) -> t (Post x f) x -> g x
forall (t :: (* -> *) -> * -> *) (g :: * -> *) (f :: * -> *) a b.
(forall m. Interpret t (AltConst m), Functor g) =>
(f ~> g) -> t (Post a f) b -> g a
postFunctor f ~> g
f (t (Post x f) x -> g x)
-> (PostT t f x -> t (Post x f) x) -> PostT t f x -> g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostT t f x -> t (Post x f) x
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a.
PostT t f a -> t (Post a f) a
unPostT
postPlus
:: (forall m. Monoid m => Interpret t (AltConst m), Plus g)
=> (f ~> g)
-> t (Post a f) b
-> g a
postPlus :: (f ~> g) -> t (Post a f) b -> g a
postPlus f :: f ~> g
f = (g a -> g a -> g a) -> g a -> [g a] -> g a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr g a -> g a -> g a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
(<!>) g a
forall (f :: * -> *) a. Plus f => f a
zero ([g a] -> g a)
-> (t (Post a f) b -> [g a]) -> t (Post a f) b -> g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. Post a f x -> g a) -> t (Post a f) b -> [g a]
forall k (t :: (k -> *) -> k -> *) (f :: k -> *) b (a :: k).
(forall m. Monoid m => Interpret t (AltConst m)) =>
(forall (x :: k). f x -> b) -> t f a -> [b]
icollect ((f ~> g) -> Post a f x -> g a
forall (g :: * -> *) (f :: * -> *) a b.
Functor g =>
(f ~> g) -> Post a f b -> g a
interpretPost f ~> g
f)
postAlt
:: (forall m. Semigroup m => Interpret t (AltConst m), Alt g)
=> (f ~> g)
-> t (Post a f) b
-> g a
postAlt :: (f ~> g) -> t (Post a f) b -> g a
postAlt f :: f ~> g
f = (g a -> g a -> g a) -> NonEmpty (g a) -> g a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 g a -> g a -> g a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
(<!>) (NonEmpty (g a) -> g a)
-> (t (Post a f) b -> NonEmpty (g a)) -> t (Post a f) b -> g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. Post a f x -> g a) -> t (Post a f) b -> NonEmpty (g a)
forall k (t :: (k -> *) -> k -> *) (f :: k -> *) b (a :: k).
(forall m. Semigroup m => Interpret t (AltConst m)) =>
(forall (x :: k). f x -> b) -> t f a -> NonEmpty b
icollect1 ((f ~> g) -> Post a f x -> g a
forall (g :: * -> *) (f :: * -> *) a b.
Functor g =>
(f ~> g) -> Post a f b -> g a
interpretPost f ~> g
f)
postFunctor
:: (forall m. Interpret t (AltConst m), Functor g)
=> (f ~> g)
-> t (Post a f) b
-> g a
postFunctor :: (f ~> g) -> t (Post a f) b -> g a
postFunctor f :: f ~> g
f = (forall x. Post a f x -> g a) -> t (Post a f) b -> g a
forall k (t :: (k -> *) -> k -> *) b (f :: k -> *) (a :: k).
Interpret t (AltConst b) =>
(forall (x :: k). f x -> b) -> t f a -> b
iget ((f ~> g) -> Post a f x -> g a
forall (g :: * -> *) (f :: * -> *) a b.
Functor g =>
(f ~> g) -> Post a f b -> g a
interpretPost f ~> g
f)
retractPre :: Contravariant f => Pre a f b -> f a
retractPre :: Pre a f b -> f a
retractPre (f :: a -> b
f :>$<: x :: f b
x) = (a -> b) -> f b -> f a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
f f b
x
interpretPre :: Contravariant g => (f ~> g) -> Pre a f b -> g a
interpretPre :: (f ~> g) -> Pre a f b -> g a
interpretPre f :: f ~> g
f (g :: a -> b
g :>$<: x :: f b
x) = (a -> b) -> g b -> g a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
g (f b -> g b
f ~> g
f f b
x)
getPre :: Pre a f b -> f b
getPre :: Pre a f b -> f b
getPre (_ :>$<: x :: f b
x) = f b
x
mapPre :: (c -> a) -> Pre a f b -> Pre c f b
mapPre :: (c -> a) -> Pre a f b -> Pre c f b
mapPre f :: c -> a
f (g :: a -> b
g :>$<: x :: f b
x) = a -> b
g (a -> b) -> (c -> a) -> c -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> a
f (c -> b) -> f b -> Pre c f b
forall a (f :: * -> *) b. (a -> b) -> f b -> Pre a f b
:>$<: f b
x
injectPre :: Inject t => (a -> b) -> f b -> t (Pre a f) b
injectPre :: (a -> b) -> f b -> t (Pre a f) b
injectPre f :: a -> b
f x :: f b
x = Pre a f b -> t (Pre a f) b
forall k (t :: (k -> *) -> k -> *) (f :: k -> *).
Inject t =>
f ~> t f
inject (a -> b
f (a -> b) -> f b -> Pre a f b
forall a (f :: * -> *) b. (a -> b) -> f b -> Pre a f b
:>$<: f b
x)
retractPost :: Functor f => Post a f b -> f a
retractPost :: Post a f b -> f a
retractPost (f :: b -> a
f :<$>: x :: f b
x) = (b -> a) -> f b -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
f f b
x
interpretPost :: Functor g => (f ~> g) -> Post a f b -> g a
interpretPost :: (f ~> g) -> Post a f b -> g a
interpretPost f :: f ~> g
f (g :: b -> a
g :<$>: x :: f b
x) = (b -> a) -> g b -> g a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
g (f b -> g b
f ~> g
f f b
x)
getPost :: Post a f b -> f b
getPost :: Post a f b -> f b
getPost (_ :<$>: x :: f b
x) = f b
x
mapPost :: (a -> c) -> Post a f b -> Post c f b
mapPost :: (a -> c) -> Post a f b -> Post c f b
mapPost f :: a -> c
f (g :: b -> a
g :<$>: x :: f b
x) = a -> c
f (a -> c) -> (b -> a) -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g (b -> c) -> f b -> Post c f b
forall a (f :: * -> *) b. (b -> a) -> f b -> Post a f b
:<$>: f b
x
injectPost :: Inject t => (b -> a) -> f b -> t (Post a f) b
injectPost :: (b -> a) -> f b -> t (Post a f) b
injectPost f :: b -> a
f x :: f b
x = Post a f b -> t (Post a f) b
forall k (t :: (k -> *) -> k -> *) (f :: k -> *).
Inject t =>
f ~> t f
inject (b -> a
f (b -> a) -> f b -> Post a f b
forall a (f :: * -> *) b. (b -> a) -> f b -> Post a f b
:<$>: f b
x)
instance Functor f => Invariant (Post a f) where
invmap :: (a -> b) -> (b -> a) -> Post a f a -> Post a f b
invmap f :: a -> b
f g :: b -> a
g (h :: a -> a
h :<$>: x :: f a
x) = a -> a
h (a -> a) -> (b -> a) -> b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g (b -> a) -> f b -> Post a f b
forall a (f :: * -> *) b. (b -> a) -> f b -> Post a f b
:<$>: (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
x
instance Contravariant f => Invariant (Pre a f) where
invmap :: (a -> b) -> (b -> a) -> Pre a f a -> Pre a f b
invmap f :: a -> b
f g :: b -> a
g (h :: a -> a
h :>$<: x :: f a
x) = a -> b
f (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
h (a -> b) -> f b -> Pre a f b
forall a (f :: * -> *) b. (a -> b) -> f b -> Pre a f b
:>$<: (b -> a) -> f a -> f b
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap b -> a
g f a
x
instance HFunctor (Post a) where
hmap :: (f ~> g) -> Post a f ~> Post a g
hmap g :: f ~> g
g (f :: x -> a
f :<$>: x :: f x
x) = x -> a
f (x -> a) -> g x -> Post a g x
forall a (f :: * -> *) b. (b -> a) -> f b -> Post a f b
:<$>: f x -> g x
f ~> g
g f x
x
instance HFunctor (Pre a) where
hmap :: (f ~> g) -> Pre a f ~> Pre a g
hmap g :: f ~> g
g (f :: a -> x
f :>$<: x :: f x
x) = a -> x
f (a -> x) -> g x -> Pre a g x
forall a (f :: * -> *) b. (a -> b) -> f b -> Pre a f b
:>$<: f x -> g x
f ~> g
g f x
x
instance Monoid a => Inject (Post a) where
inject :: f x -> Post a f x
inject x :: f x
x = a -> x -> a
forall a b. a -> b -> a
const a
forall a. Monoid a => a
mempty (x -> a) -> f x -> Post a f x
forall a (f :: * -> *) b. (b -> a) -> f b -> Post a f b
:<$>: f x
x
instance Monoid a => HBind (Post a) where
hjoin :: Post a (Post a f) x -> Post a f x
hjoin (f :: x -> a
f :<$>: (g :: x -> a
g :<$>: x :: f x
x)) = (x -> a
f (x -> a) -> (x -> a) -> x -> a
forall a. Semigroup a => a -> a -> a
<> x -> a
g) (x -> a) -> f x -> Post a f x
forall a (f :: * -> *) b. (b -> a) -> f b -> Post a f b
:<$>: f x
x
instance Monoid a => Interpret (Post a) f where
retract :: Post a f x -> f x
retract (_ :<$>: x :: f x
x) = f x
x
instance (a ~ Void) => Inject (Pre a) where
inject :: f x -> Pre a f x
inject x :: f x
x = Void -> x
forall a. Void -> a
absurd (Void -> x) -> f x -> Pre Void f x
forall a (f :: * -> *) b. (a -> b) -> f b -> Pre a f b
:>$<: f x
x
instance (a ~ Void) => HBind (Pre a) where
hjoin :: Pre a (Pre a f) x -> Pre a f x
hjoin (_ :>$<: (_ :>$<: x :: f x
x)) = Void -> x
forall a. Void -> a
absurd (Void -> x) -> f x -> Pre Void f x
forall a (f :: * -> *) b. (a -> b) -> f b -> Pre a f b
:>$<: f x
x
instance (a ~ Void) => Interpret (Pre a) f where
retract :: Pre a f x -> f x
retract (_ :>$<: x :: f x
x) = f x
x
newtype ProPre t f a b = ProPre { ProPre t f a b -> t (Pre a f) b
unProPre :: t (Pre a f) b }
instance (HFunctor t, forall x. Functor (t (Pre x f))) => Profunctor (ProPre t f) where
dimap :: (a -> b) -> (c -> d) -> ProPre t f b c -> ProPre t f a d
dimap f :: a -> b
f g :: c -> d
g = t (Pre a f) d -> ProPre t f a d
forall k (t :: (* -> *) -> k -> *) (f :: * -> *) a (b :: k).
t (Pre a f) b -> ProPre t f a b
ProPre
(t (Pre a f) d -> ProPre t f a d)
-> (ProPre t f b c -> t (Pre a f) d)
-> ProPre t f b c
-> ProPre t f a d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pre b f ~> Pre a f) -> t (Pre b f) ~> t (Pre a f)
forall k k (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *).
HFunctor t =>
(f ~> g) -> t f ~> t g
hmap ((a -> b) -> Pre b f x -> Pre a f x
forall c a (f :: * -> *) b. (c -> a) -> Pre a f b -> Pre c f b
mapPre a -> b
f)
(t (Pre b f) d -> t (Pre a f) d)
-> (ProPre t f b c -> t (Pre b f) d)
-> ProPre t f b c
-> t (Pre a f) d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> d) -> t (Pre b f) c -> t (Pre b f) d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g
(t (Pre b f) c -> t (Pre b f) d)
-> (ProPre t f b c -> t (Pre b f) c)
-> ProPre t f b c
-> t (Pre b f) d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProPre t f b c -> t (Pre b f) c
forall k (t :: (* -> *) -> k -> *) (f :: * -> *) a (b :: k).
ProPre t f a b -> t (Pre a f) b
unProPre
newtype ProPost t f a b = ProPost { ProPost t f a b -> t (Post b f) a
unProPost :: t (Post b f) a }
instance (HFunctor t, forall x. Contravariant (t (Post x f))) => Profunctor (ProPost t f) where
dimap :: (a -> b) -> (c -> d) -> ProPost t f b c -> ProPost t f a d
dimap f :: a -> b
f g :: c -> d
g = t (Post d f) a -> ProPost t f a d
forall k (t :: (* -> *) -> k -> *) (f :: * -> *) (a :: k) b.
t (Post b f) a -> ProPost t f a b
ProPost
(t (Post d f) a -> ProPost t f a d)
-> (ProPost t f b c -> t (Post d f) a)
-> ProPost t f b c
-> ProPost t f a d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Post c f ~> Post d f) -> t (Post c f) ~> t (Post d f)
forall k k (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *).
HFunctor t =>
(f ~> g) -> t f ~> t g
hmap ((c -> d) -> Post c f x -> Post d f x
forall a c (f :: * -> *) b. (a -> c) -> Post a f b -> Post c f b
mapPost c -> d
g)
(t (Post c f) a -> t (Post d f) a)
-> (ProPost t f b c -> t (Post c f) a)
-> ProPost t f b c
-> t (Post d f) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> t (Post c f) b -> t (Post c f) a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
f
(t (Post c f) b -> t (Post c f) a)
-> (ProPost t f b c -> t (Post c f) b)
-> ProPost t f b c
-> t (Post c f) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProPost t f b c -> t (Post c f) b
forall k (t :: (* -> *) -> k -> *) (f :: * -> *) (a :: k) b.
ProPost t f a b -> t (Post b f) a
unProPost