module Pandora.Paradigm.Primary.Functor.Constant 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.Invariant (Invariant ((<$<)))
import Pandora.Pattern.Functor.Bivariant (Bivariant ((<->)))
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 ()
import Pandora.Pattern.Morphism.Flip (Flip (Flip))

newtype Constant a b = Constant a

instance Covariant (->) (->) (Constant a) where
	a -> b
_ <$> :: (a -> b) -> Constant a a -> Constant a b
<$> Constant a
x = a -> Constant a b
forall k a (b :: k). a -> Constant a b
Constant a
x

instance Covariant (->) (->) (Flip Constant b) where
	a -> b
f <$> :: (a -> b) -> Flip Constant b a -> Flip Constant b b
<$> Flip (Constant a
x) = Constant b b -> Flip Constant b b
forall (v :: * -> * -> *) a e. v e a -> Flip v a e
Flip (Constant b b -> Flip Constant b b)
-> (b -> Constant b b) -> b -> Flip Constant b b
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. b -> Constant b b
forall k a (b :: k). a -> Constant a b
Constant (b -> Flip Constant b b) -> b -> Flip Constant b b
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
$ a -> b
f a
x

instance Contravariant (->) (->) (Constant a) where
	a -> b
_ >$< :: (a -> b) -> Constant a b -> Constant a a
>$< Constant a
x = a -> Constant a a
forall k a (b :: k). a -> Constant a b
Constant a
x

instance Invariant (Constant a) where
	a -> b
_ <$< :: (a -> b) -> (b -> a) -> Constant a a -> Constant a b
<$< b -> a
_ = \(Constant a
x) -> a -> Constant a b
forall k a (b :: k). a -> Constant a b
Constant a
x

instance Bivariant (->) (->) (->) Constant where
	a -> b
f <-> :: (a -> b) -> (c -> d) -> Constant a c -> Constant b d
<-> c -> d
_ = \(Constant a
x) -> b -> Constant b d
forall k a (b :: k). a -> Constant a b
Constant (b -> Constant b d) -> b -> Constant b d
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
$ a -> b
f a
x

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

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

instance Semigroup a => Semigroup (Constant a b) where
	Constant a
x + :: Constant a b -> Constant a b -> Constant a b
+ Constant a
y = a -> Constant a b
forall k a (b :: k). a -> Constant a b
Constant (a -> Constant a b) -> a -> Constant a b
forall (m :: * -> * -> *) a b. Category m => 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 (Constant a b) where
	 zero :: Constant a b
zero = a -> Constant a b
forall k a (b :: k). a -> Constant a b
Constant a
forall a. Monoid a => a
zero

instance Ringoid a => Ringoid (Constant a b) where
	Constant a
x * :: Constant a b -> Constant a b -> Constant a b
* Constant a
y = a -> Constant a b
forall k a (b :: k). a -> Constant a b
Constant (a -> Constant a b) -> a -> Constant a b
forall (m :: * -> * -> *) a b. Category m => 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 (Constant a b) where
	 one :: Constant a b
one = a -> Constant a b
forall k a (b :: k). a -> Constant a b
Constant a
forall a. Quasiring a => a
one

instance Infimum a => Infimum (Constant a b) where
	Constant a
x /\ :: Constant a b -> Constant a b -> Constant a b
/\ Constant a
y = a -> Constant a b
forall k a (b :: k). a -> Constant a b
Constant (a -> Constant a b) -> a -> Constant a b
forall (m :: * -> * -> *) a b. Category m => 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 (Constant a b) where
	Constant a
x \/ :: Constant a b -> Constant a b -> Constant a b
\/ Constant a
y = a -> Constant a b
forall k a (b :: k). a -> Constant a b
Constant (a -> Constant a b) -> a -> Constant a b
forall (m :: * -> * -> *) a b. Category m => 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 (Constant a b) where

instance Group a => Group (Constant a b) where
	invert :: Constant a b -> Constant a b
invert (Constant a
x) = a -> Constant a b
forall k a (b :: k). a -> Constant a b
Constant (a -> Constant a b) -> a -> Constant a b
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
$ a -> a
forall a. Group a => a -> a
invert a
x