module Pandora.Paradigm.Primary.Transformer.Backwards where

import Pandora.Core.Morphism ((&))
import Pandora.Pattern.Category ((.), ($))
import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))
import Pandora.Pattern.Functor.Contravariant (Contravariant ((>$<)))
import Pandora.Pattern.Functor.Extractable (Extractable (extract))
import Pandora.Pattern.Functor.Pointable (Pointable (point))
import Pandora.Pattern.Functor.Applicative (Applicative ((<*>)))
import Pandora.Pattern.Functor.Traversable (Traversable ((->>)))
import Pandora.Pattern.Functor.Distributive (Distributive ((>>-)))
import Pandora.Pattern.Transformer.Liftable (Liftable (lift))
import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower))
import Pandora.Pattern.Transformer.Hoistable (Hoistable (hoist))
import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite))

newtype Backwards t a = Backwards (t a)

instance Covariant t => Covariant (Backwards t) where
	a -> b
f <$> :: (a -> b) -> Backwards t a -> Backwards t b
<$> Backwards t a
x = t b -> Backwards t b
forall k (t :: k -> *) (a :: k). t a -> Backwards t a
Backwards (t b -> Backwards t b) -> t b -> Backwards t b
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ a -> b
f (a -> b) -> t a -> t b
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> t a
x

instance Pointable t => Pointable (Backwards t) where
	point :: a |-> Backwards t
point = t a -> Backwards t a
forall k (t :: k -> *) (a :: k). t a -> Backwards t a
Backwards (t a -> Backwards t a) -> (a -> t a) -> a |-> Backwards t
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. a -> t a
forall (t :: * -> *) a. Pointable t => a |-> t
point

instance Extractable t => Extractable (Backwards t) where
	extract :: a <-| Backwards t
extract (Backwards t a
x) = a <-| t
forall (t :: * -> *) a. Extractable t => a <-| t
extract t a
x

instance Applicative t => Applicative (Backwards t) where
	Backwards t (a -> b)
f <*> :: Backwards t (a -> b) -> Backwards t a -> Backwards t b
<*> Backwards t a
x = t b -> Backwards t b
forall k (t :: k -> *) (a :: k). t a -> Backwards t a
Backwards (a -> (a -> b) -> b
forall a b. a -> (a -> b) -> b
(&) (a -> (a -> b) -> b) -> t a -> t ((a -> b) -> b)
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> t a
x t ((a -> b) -> b) -> t (a -> b) -> t b
forall (t :: * -> *) a b. Applicative t => t (a -> b) -> t a -> t b
<*> t (a -> b)
f)

instance Traversable t => Traversable (Backwards t) where
	Backwards t a
x ->> :: Backwards t a -> (a -> u b) -> (u :. Backwards t) := b
->> a -> u b
f = t b -> Backwards t b
forall k (t :: k -> *) (a :: k). t a -> Backwards t a
Backwards (t b -> Backwards t b) -> u (t b) -> (u :. Backwards t) := b
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> (t a
x t a -> (a -> u b) -> u (t b)
forall (t :: * -> *) (u :: * -> *) a b.
(Traversable t, Pointable u, Applicative u) =>
t a -> (a -> u b) -> (u :. t) := b
->> a -> u b
f)

instance Distributive t => Distributive (Backwards t) where
	u a
x >>- :: u a -> (a -> Backwards t b) -> (Backwards t :. u) := b
>>- a -> Backwards t b
f = t (u b) -> (Backwards t :. u) := b
forall k (t :: k -> *) (a :: k). t a -> Backwards t a
Backwards (t (u b) -> (Backwards t :. u) := b)
-> t (u b) -> (Backwards t :. u) := b
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ u a
x u a -> (a -> t b) -> t (u b)
forall (t :: * -> *) (u :: * -> *) a b.
(Distributive t, Covariant u) =>
u a -> (a -> t b) -> (t :. u) := b
>>- Backwards t b -> t b
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run (Backwards t b -> t b) -> (a -> Backwards t b) -> a -> t b
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. a -> Backwards t b
f

instance Contravariant t => Contravariant (Backwards t) where
	a -> b
f >$< :: (a -> b) -> Backwards t b -> Backwards t a
>$< Backwards t b
x = t a -> Backwards t a
forall k (t :: k -> *) (a :: k). t a -> Backwards t a
Backwards (t a -> Backwards t a) -> t a -> Backwards t a
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ a -> b
f (a -> b) -> t b -> t a
forall (t :: * -> *) a b. Contravariant t => (a -> b) -> t b -> t a
>$< t b
x

instance Interpreted (Backwards t) where
	type Primary (Backwards t) a = t a
	run :: Backwards t a -> Primary (Backwards t) a
run ~(Backwards t a
x) = t a
Primary (Backwards t) a
x
	unite :: Primary (Backwards t) a -> Backwards t a
unite = Primary (Backwards t) a -> Backwards t a
forall k (t :: k -> *) (a :: k). t a -> Backwards t a
Backwards

instance Liftable Backwards where
	lift :: u ~> Backwards u
lift = u a -> Backwards u a
forall k (t :: k -> *) (a :: k). t a -> Backwards t a
Backwards

instance Lowerable Backwards where
	lower :: Backwards u ~> u
lower = Backwards u a -> u a
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run

instance Hoistable Backwards where
	hoist :: (u ~> v) -> Backwards u ~> Backwards v
hoist u ~> v
f (Backwards u a
x) = v a -> Backwards v a
forall k (t :: k -> *) (a :: k). t a -> Backwards t a
Backwards (v a -> Backwards v a) -> v a -> Backwards v a
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ u a -> v a
u ~> v
f u a
x