{-# LANGUAGE UndecidableInstances #-}

module Pandora.Paradigm.Primary.Transformer.Reverse where

import Pandora.Pattern.Semigroupoid ((.))
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.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 ((/|\)))
import Pandora.Paradigm.Primary.Transformer.Backwards (Backwards (Backwards))
import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite))

newtype Reverse t a = Reverse (t a)

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

instance Pointable t (->) => Pointable (Reverse t) (->) where
	point :: a -> Reverse t a
point = t a -> Reverse t a
forall k (t :: k -> *) (a :: k). t a -> Reverse t a
Reverse (t a -> Reverse t a) -> (a -> t a) -> a -> Reverse t a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. a -> t a
forall (t :: * -> *) (source :: * -> * -> *) a.
Pointable t source =>
source a (t a)
point

instance Extractable t (->) => Extractable (Reverse t) (->) where
	extract :: Reverse t a -> a
extract (Reverse t a
x) = t a -> a
forall (t :: * -> *) (source :: * -> * -> *) a.
Extractable t source =>
source (t a) a
extract t a
x

instance Traversable t (->) (->) => Traversable (Reverse t) (->) (->) where
	a -> u b
f <<- :: (a -> u b) -> Reverse t a -> u (Reverse t b)
<<- Reverse t a
x = t b -> Reverse t b
forall k (t :: k -> *) (a :: k). t a -> Reverse t a
Reverse (t b -> Reverse t b) -> u (t b) -> u (Reverse t b)
forall (t :: * -> *) (source :: * -> * -> *)
       (target :: * -> * -> *) a b.
Covariant t source target =>
source a b -> target (t a) (t b)
-<$>- Backwards u (t b) -> Primary (Backwards u) (t b)
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run (u b -> Backwards u b
forall k (t :: k -> *) (a :: k). t a -> Backwards t a
Backwards (u b -> Backwards u b) -> (a -> u b) -> a -> Backwards u b
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. a -> u b
f (a -> Backwards u b) -> t a -> Backwards u (t b)
forall (t :: * -> *) (source :: * -> * -> *)
       (target :: * -> * -> *) (u :: * -> *) a b.
(Traversable t source target, Covariant u source target,
 Pointable u target, Semimonoidal u target (:*:) (:*:)) =>
source a (u b) -> target (t a) (u (t b))
<<- t a
x)

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

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

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

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

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

instance Hoistable Reverse where
	u ~> v
f /|\ :: (u ~> v) -> Reverse u ~> Reverse v
/|\ Reverse u a
x = v a -> Reverse v a
forall k (t :: k -> *) (a :: k). t a -> Reverse t a
Reverse (v a -> Reverse v a) -> v a -> Reverse v a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# u a -> v a
u ~> v
f u a
x