module Pandora.Paradigm.Primary.Functor.Endo where

import Pandora.Core.Interpreted (Interpreted (Primary, run, unite, (=#-)))
import Pandora.Pattern.Semigroupoid ((.))
import Pandora.Pattern.Category (identity, (<--))
import Pandora.Pattern.Functor.Invariant (Invariant ((<!<)))
import Pandora.Pattern.Object.Semigroup (Semigroup ((+)))
import Pandora.Pattern.Object.Monoid (Monoid (zero))
import Pandora.Paradigm.Algebraic.Exponential ()
import Pandora.Paradigm.Algebraic.Product ((:*:) ((:*:)))
import Pandora.Paradigm.Algebraic ((>-|-<-|-))

newtype Endo a = Endo { Endo a -> a -> a
endo :: a -> a }

instance Interpreted (->) Endo where
	type Primary Endo a = a -> a
	run :: ((->) < Endo a) < Primary Endo a
run ~(Endo a -> a
x) = Primary Endo a
a -> a
x
	unite :: ((->) < Primary Endo a) < Endo a
unite = ((->) < Primary Endo a) < Endo a
forall a. (a -> a) -> Endo a
Endo

instance Invariant Endo where
	a -> b
f <!< :: (a -> b) -> (b -> a) -> Endo a -> Endo b
<!< b -> a
g = (((b -> a
g (b -> a) -> (a -> b) -> (b -> a) :*: (a -> b)
forall s a. s -> a -> s :*: a
:*: a -> b
f) ((b -> a) :*: (a -> b)) -> (a -> a) -> b -> b
forall (m :: * -> * -> *) (p :: * -> * -> *) a b c d.
(Contravariant m m (Flip p d), Covariant m m (p b),
 Interpreted m (Flip p d)) =>
(m a b :*: m c d) -> m (p b c) (p a d)
>-|-<-|-) (Primary Endo a -> Primary Endo b) -> Endo a -> Endo b
forall (m :: * -> * -> *) (t :: * -> *) (u :: * -> *) a b.
(Interpreted m t, Semigroupoid m, Interpreted m u) =>
((m < Primary t a) < Primary u b) -> (m < t a) < u b
=#-)

instance Semigroup (Endo a) where
	Endo a -> a
f + :: Endo a -> Endo a -> Endo a
+ Endo a -> a
g = (a -> a) -> Endo a
forall a. (a -> a) -> Endo a
Endo ((a -> a) -> Endo a) -> (a -> a) -> Endo a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- a -> a
g (a -> a) -> (a -> a) -> a -> a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. a -> a
f

instance Monoid (Endo a) where
	zero :: Endo a
zero = (a -> a) -> Endo a
forall a. (a -> a) -> Endo a
Endo a -> a
forall (m :: * -> * -> *) a. Category m => m a a
identity