module Pandora.Paradigm.Primary.Functor.Identity where

import Pandora.Pattern.Semigroupoid ((.))
import Pandora.Pattern.Morphism.Flip (Flip (Flip))
import Pandora.Pattern.Morphism.Straight (Straight (Straight))
import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))
import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))
import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult))
import Pandora.Pattern.Functor.Monoidal (Monoidal (unit))
import Pandora.Pattern.Functor.Bindable (Bindable ((=<<)))
import Pandora.Pattern.Functor.Extendable (Extendable ((<<=)))
import Pandora.Pattern.Functor.Monad (Monad)
import Pandora.Pattern.Functor.Comonad (Comonad)
--import Pandora.Pattern.Functor.Representable (Representable (Representation, (<#>), tabulate))
import Pandora.Pattern.Functor.Adjoint (Adjoint ((-|), (|-)))
import Pandora.Pattern.Object.Setoid (Setoid ((==)))
import Pandora.Pattern.Object.Chain (Chain ((<=>)))
import Pandora.Pattern.Object.Semigroup (Semigroup ((+)))
import Pandora.Pattern.Object.Monoid (Monoid (zero))
import Pandora.Pattern.Object.Ringoid (Ringoid ((*)))
import Pandora.Pattern.Object.Quasiring (Quasiring (one))
import Pandora.Pattern.Object.Semilattice (Infimum ((/\)), Supremum ((\/)))
import Pandora.Pattern.Object.Lattice (Lattice)
import Pandora.Pattern.Object.Group (Group (invert))
import Pandora.Paradigm.Primary.Algebraic.Exponential (type (<--), type (-->))
import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)))
import Pandora.Paradigm.Primary.Algebraic.One (One (One))
import Pandora.Paradigm.Primary.Algebraic (extract, (<-|-<-|-))
import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (!))

newtype Identity a = Identity a

instance Covariant (->) (->) Identity where
	a -> b
f <-|- :: (a -> b) -> Identity a -> Identity b
<-|- Identity a
x = b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> b -> Identity b
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
! a -> b
f a
x

instance Semimonoidal (-->) (:*:) (:*:) Identity where
	mult :: (Identity a :*: Identity b) --> Identity (a :*: b)
mult = ((Identity a :*: Identity b) -> Identity (a :*: b))
-> (Identity a :*: Identity b) --> Identity (a :*: b)
forall (v :: * -> * -> *) a e. v a e -> Straight v a e
Straight (((Identity a :*: Identity b) -> Identity (a :*: b))
 -> (Identity a :*: Identity b) --> Identity (a :*: b))
-> ((Identity a :*: Identity b) -> Identity (a :*: b))
-> (Identity a :*: Identity b) --> Identity (a :*: b)
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
! (a :*: b) -> Identity (a :*: b)
forall a. a -> Identity a
Identity ((a :*: b) -> Identity (a :*: b))
-> ((Identity a :*: Identity b) -> a :*: b)
-> (Identity a :*: Identity b)
-> Identity (a :*: b)
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (Identity a -> a
forall (t :: * -> *) a. Extractable t => t a -> a
extract (Identity a -> a)
-> (Identity b -> b) -> (Identity a -> a) :*: (Identity b -> b)
forall s a. s -> a -> s :*: a
:*: Identity b -> b
forall (t :: * -> *) a. Extractable t => t a -> a
extract ((Identity a -> a) :*: (Identity b -> b))
-> (Identity a :*: Identity b) -> a :*: b
forall (m :: * -> * -> *) (p :: * -> * -> *) a b c d.
(Covariant m m (p a), Covariant m m (Flip p d),
 Interpreted m (Flip p d)) =>
(m a b :*: m c d) -> m (p a c) (p b d)
<-|-<-|-)

instance Monoidal (-->) (-->) (:*:) (:*:) Identity where
	unit :: Proxy (:*:) -> (Unit (:*:) --> a) --> Identity a
unit Proxy (:*:)
_ = ((One --> a) -> Identity a)
-> Straight (->) (One --> a) (Identity a)
forall (v :: * -> * -> *) a e. v a e -> Straight v a e
Straight (((One --> a) -> Identity a)
 -> Straight (->) (One --> a) (Identity a))
-> ((One --> a) -> Identity a)
-> Straight (->) (One --> a) (Identity a)
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
! a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a)
-> ((One --> a) -> a) -> (One --> a) -> Identity a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. ((One -> a) -> One -> a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
! One
One) ((One -> a) -> a) -> ((One --> a) -> One -> a) -> (One --> a) -> a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (One --> a) -> One -> a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
run

instance Semimonoidal (<--) (:*:) (:*:) Identity where
	mult :: (Identity a :*: Identity b) <-- Identity (a :*: b)
mult = (Identity (a :*: b) -> Identity a :*: Identity b)
-> (Identity a :*: Identity b) <-- Identity (a :*: b)
forall (v :: * -> * -> *) a e. v e a -> Flip v a e
Flip ((Identity (a :*: b) -> Identity a :*: Identity b)
 -> (Identity a :*: Identity b) <-- Identity (a :*: b))
-> (Identity (a :*: b) -> Identity a :*: Identity b)
-> (Identity a :*: Identity b) <-- Identity (a :*: b)
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
! \(Identity (a
x :*: b
y)) -> a -> Identity a
forall a. a -> Identity a
Identity a
x Identity a -> Identity b -> Identity a :*: Identity b
forall s a. s -> a -> s :*: a
:*: b -> Identity b
forall a. a -> Identity a
Identity b
y

instance Monoidal (<--) (-->) (:*:) (:*:) Identity where
	unit :: Proxy (:*:) -> (Unit (:*:) --> a) <-- Identity a
unit Proxy (:*:)
_ = (Identity a -> One --> a) -> Flip (->) (One --> a) (Identity a)
forall (v :: * -> * -> *) a e. v e a -> Flip v a e
Flip ((Identity a -> One --> a) -> Flip (->) (One --> a) (Identity a))
-> (Identity a -> One --> a) -> Flip (->) (One --> a) (Identity a)
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
! \(Identity a
x) -> (One -> a) -> One --> a
forall (v :: * -> * -> *) a e. v a e -> Straight v a e
Straight (\One
_ -> a
x)

instance Traversable (->) (->) Identity where
	a -> u b
f <<- :: (a -> u b) -> Identity a -> u (Identity b)
<<- Identity a
x = b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> u b -> u (Identity b)
forall (source :: * -> * -> *) (target :: * -> * -> *)
       (t :: * -> *) a b.
Covariant source target t =>
source a b -> target (t a) (t b)
<-|- a -> u b
f a
x

instance Bindable (->) Identity where
	a -> Identity b
f =<< :: (a -> Identity b) -> Identity a -> Identity b
=<< Identity a
x = a -> Identity b
f a
x

instance Monad (->) Identity

instance Extendable (->) Identity where
	Identity a -> b
f <<= :: (Identity a -> b) -> Identity a -> Identity b
<<= Identity a
x = b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (Identity a -> b) -> Identity a -> Identity b
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. Identity a -> b
f (Identity a -> Identity b) -> Identity a -> Identity b
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
! Identity a
x

instance Comonad (->) Identity

--instance Representable Identity where
	--type Representation Identity = ()
	--() <#> Identity x = x
	--tabulate f = Identity ! f ()

instance Adjoint (->) (->) Identity Identity where
	Identity a -> b
f -| :: (Identity a -> b) -> a -> Identity b
-| a
x = b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (a -> b) -> a -> Identity b
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. Identity a -> b
f (Identity a -> b) -> (a -> Identity a) -> a -> b
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity b) -> a -> Identity b
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
! a
x
	a -> Identity b
g |- :: (a -> Identity b) -> Identity a -> b
|- Identity a
x = Identity b -> b
forall (t :: * -> *) a. Extractable t => t a -> a
extract (Identity b -> b) -> (Identity a -> Identity b) -> Identity a -> b
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. Identity (Identity b) -> Identity b
forall (t :: * -> *) a. Extractable t => t a -> a
extract (Identity (Identity b) -> Identity b)
-> (Identity a -> Identity (Identity b))
-> Identity a
-> Identity b
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (a -> Identity b
g (a -> Identity b) -> Identity a -> Identity (Identity b)
forall (source :: * -> * -> *) (target :: * -> * -> *)
       (t :: * -> *) a b.
Covariant source target t =>
source a b -> target (t a) (t b)
<-|-) (Identity a -> b) -> Identity a -> b
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
! Identity a
x

instance Setoid a => Setoid (Identity a) where
	Identity a
x == :: Identity a -> Identity a -> Boolean
== Identity a
y = a
x a -> a -> Boolean
forall a. Setoid a => a -> a -> Boolean
== a
y

instance Chain a => Chain (Identity a) where
	Identity a
x <=> :: Identity a -> Identity a -> Ordering
<=> Identity a
y = a
x a -> a -> Ordering
forall a. Chain a => a -> a -> Ordering
<=> a
y

instance Semigroup a => Semigroup (Identity a) where
	Identity a
x + :: Identity a -> Identity a -> Identity a
+ Identity a
y = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> a -> Identity a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
! a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
+ a
y

instance Monoid a => Monoid (Identity a) where
	 zero :: Identity a
zero = a -> Identity a
forall a. a -> Identity a
Identity a
forall a. Monoid a => a
zero

instance Ringoid a => Ringoid (Identity a) where
	Identity a
x * :: Identity a -> Identity a -> Identity a
* Identity a
y = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> a -> Identity a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
! a
x a -> a -> a
forall a. Ringoid a => a -> a -> a
* a
y

instance Quasiring a => Quasiring (Identity a) where
	 one :: Identity a
one = a -> Identity a
forall a. a -> Identity a
Identity a
forall a. Quasiring a => a
one

instance Infimum a => Infimum (Identity a) where
	Identity a
x /\ :: Identity a -> Identity a -> Identity a
/\ Identity a
y = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> a -> Identity a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
! a
x a -> a -> a
forall a. Infimum a => a -> a -> a
/\ a
y

instance Supremum a => Supremum (Identity a) where
	Identity a
x \/ :: Identity a -> Identity a -> Identity a
\/ Identity a
y = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> a -> Identity a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
! a
x a -> a -> a
forall a. Supremum a => a -> a -> a
\/ a
y

instance Lattice a => Lattice (Identity a) where

instance Group a => Group (Identity a) where
	invert :: Identity a -> Identity a
invert (Identity a
x) = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> a -> Identity a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
! a -> a
forall a. Group a => a -> a
invert a
x