module Pandora.Paradigm.Primary.Functor.Identity where

import Pandora.Pattern.Category ((.), ($))
import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), comap))
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.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))

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 :: * -> * -> *) a b. Category m => m a b -> m a b
$ a -> b
f a
x

instance Pointable Identity where
	point :: a |-> Identity
point = a |-> Identity
forall a. a -> Identity a
Identity

instance Extractable Identity where
	extract :: a <-| Identity
extract (Identity a
x) = a
x

instance Applicative 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) -> b -> Identity b
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ a -> b
f a
x

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

instance Distributive Identity where
	u a
x >>- :: u a -> (a -> Identity b) -> (Identity :. u) := b
>>- a -> Identity b
f = u b -> (Identity :. u) := b
forall a. a -> Identity a
Identity (u b -> (Identity :. u) := b) -> u b -> (Identity :. u) := b
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ b <-| Identity
forall (t :: * -> *) a. Extractable t => a <-| t
extract (b <-| Identity) -> (a -> Identity b) -> a -> b
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. a -> Identity b
f (a -> b) -> u a -> u b
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> u a
x

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

instance Monad Identity

instance Extendable Identity where
	Identity a
x =>> :: Identity a -> (Identity a -> b) -> Identity b
=>> Identity a -> b
f = b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (Identity a -> b) -> Identity a -> Identity b
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. Identity a -> b
f (Identity a -> Identity b) -> Identity a -> Identity b
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ Identity a
x

instance Comonad Identity

instance Representable Identity where
	type Representation Identity = ()
	() <#> :: Representation Identity -> a <-| Identity
<#> Identity a
x = a
x
	tabulate :: (Representation Identity -> a) -> Identity a
tabulate Representation Identity -> a
f = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> a -> Identity a
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ Representation Identity -> a
f ()

instance Adjoint Identity Identity where
	a
x -| :: a -> (Identity a -> b) -> Identity b
-| Identity a -> b
f = b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (a -> b) -> a -> Identity b
forall (m :: * -> * -> *) b c a.
Category 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.
Category 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 :: * -> * -> *) a b. Category m => m a b -> m a b
$ a
x
	Identity a
x |- :: Identity a -> (a -> Identity b) -> b
|- a -> Identity b
g = b <-| Identity
forall (t :: * -> *) a. Extractable t => a <-| t
extract (b <-| Identity) -> (Identity a -> Identity b) -> Identity a -> b
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. Identity b <-| Identity
forall (t :: * -> *) a. Extractable t => a <-| t
extract (Identity b <-| Identity)
-> (Identity a -> Identity (Identity b))
-> Identity a
-> Identity b
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. (a -> Identity b) -> Identity a -> Identity (Identity b)
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
comap a -> Identity b
g (Identity a -> b) -> Identity a -> b
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ 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 :: * -> * -> *) a b. Category m => m a b -> m a b
$ 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 :: * -> * -> *) a b. Category m => m a b -> m a b
$ 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 :: * -> * -> *) a b. Category m => m a b -> m a b
$ 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 :: * -> * -> *) a b. Category m => m a b -> m a b
$ 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 :: * -> * -> *) a b. Category m => m a b -> m a b
$ a -> a
forall a. Group a => a -> a
invert a
x