module Pandora.Paradigm.Primary.Functor.Maybe where

import Pandora.Core.Functor (type (:.), type (:=))
import Pandora.Pattern.Category (identity, (.), ($))
import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))
import Pandora.Pattern.Functor.Avoidable (Avoidable (empty))
import Pandora.Pattern.Functor.Pointable (Pointable (point))
import Pandora.Pattern.Functor.Alternative (Alternative ((<+>)))
import Pandora.Pattern.Functor.Applicative (Applicative ((<*>)))
import Pandora.Pattern.Functor.Traversable (Traversable ((->>)))
import Pandora.Pattern.Functor.Bindable (Bindable ((>>=)))
import Pandora.Pattern.Functor.Monad (Monad)
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.Semilattice (Infimum ((/\)), Supremum ((\/)))
import Pandora.Pattern.Object.Lattice (Lattice)
import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True, False))
import Pandora.Paradigm.Primary.Object.Ordering (Ordering (Less, Equal, Greater))
import Pandora.Paradigm.Controlflow.Effect.Interpreted (Schematic, Interpreted (Primary, run, unite))
import Pandora.Paradigm.Controlflow.Effect.Transformer.Monadic (Monadic (wrap), (:>) (TM))
import Pandora.Paradigm.Controlflow.Effect.Adaptable (Adaptable (adapt))
import Pandora.Paradigm.Schemes.UT (UT (UT), type (<.:>))
import Pandora.Paradigm.Structure.Ability.Monotonic (Monotonic (reduce))

data Maybe a = Nothing | Just a

instance Covariant Maybe where
	a -> b
f <$> :: (a -> b) -> Maybe a -> Maybe b
<$> Just a
x = b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> b -> Maybe b
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ a -> b
f a
x
	a -> b
_ <$> Maybe a
Nothing = Maybe b
forall a. Maybe a
Nothing

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

instance Avoidable Maybe where
	empty :: Maybe a
empty = Maybe a
forall a. Maybe a
Nothing

instance Applicative Maybe where
	Just a -> b
f <*> :: Maybe (a -> b) -> Maybe a -> Maybe b
<*> Maybe a
x = a -> b
f (a -> b) -> Maybe a -> Maybe b
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> Maybe a
x
	Maybe (a -> b)
Nothing <*> Maybe a
_ = Maybe b
forall a. Maybe a
Nothing

instance Alternative Maybe where
	Maybe a
Nothing <+> :: Maybe a -> Maybe a -> Maybe a
<+> Maybe a
y = Maybe a
y
	Just a
x <+> Maybe a
_ = a -> Maybe a
forall a. a -> Maybe a
Just a
x

instance Traversable Maybe where
	Maybe a
Nothing ->> :: Maybe a -> (a -> u b) -> (u :. Maybe) := b
->> a -> u b
_ = Maybe b |-> u
forall (t :: * -> *) a. Pointable t => a |-> t
point Maybe b
forall a. Maybe a
Nothing
	Just a
x ->> a -> u b
f = b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> u b -> (u :. Maybe) := b
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> a -> u b
f a
x

instance Bindable Maybe where
	Just a
x >>= :: Maybe a -> (a -> Maybe b) -> Maybe b
>>= a -> Maybe b
f = a -> Maybe b
f a
x
	Maybe a
Nothing >>= a -> Maybe b
_ = Maybe b
forall a. Maybe a
Nothing

instance Monad Maybe where

instance Setoid a => Setoid (Maybe a) where
	Just a
x == :: Maybe a -> Maybe a -> Boolean
== Just a
y = a
x a -> a -> Boolean
forall a. Setoid a => a -> a -> Boolean
== a
y
	Maybe a
Nothing == Maybe a
Nothing = Boolean
True
	Maybe a
_ == Maybe a
_ = Boolean
False

instance Chain a => Chain (Maybe a) where
	Just a
x <=> :: Maybe a -> Maybe a -> Ordering
<=> Just a
y = a
x a -> a -> Ordering
forall a. Chain a => a -> a -> Ordering
<=> a
y
	Maybe a
Nothing <=> Maybe a
Nothing = Ordering
Equal
	Maybe a
Nothing <=> Just a
_ = Ordering
Less
	Just a
_ <=> Maybe a
Nothing = Ordering
Greater

instance Semigroup a => Semigroup (Maybe a) where
	Just a
x + :: Maybe a -> Maybe a -> Maybe a
+ Just a
y = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe 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
	Maybe a
Nothing + Maybe a
x = Maybe a
x
	Maybe a
x + Maybe a
Nothing = Maybe a
x

instance Semigroup a => Monoid (Maybe a) where
	zero :: Maybe a
zero = Maybe a
forall a. Maybe a
Nothing

instance Infimum a => Infimum (Maybe a) where
	Just a
x /\ :: Maybe a -> Maybe a -> Maybe a
/\ Just a
y = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe 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
	Maybe a
_ /\ Maybe a
Nothing = Maybe a
forall a. Maybe a
Nothing
	Maybe a
Nothing /\ Maybe a
_ = Maybe a
forall a. Maybe a
Nothing

instance Supremum a => Supremum (Maybe a) where
	Just a
x \/ :: Maybe a -> Maybe a -> Maybe a
\/ Just a
y = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe 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
	Maybe a
x \/ Maybe a
Nothing = Maybe a
x
	Maybe a
Nothing \/ Maybe a
x = Maybe a
x

instance Lattice a => Lattice (Maybe a) where

type instance Schematic Monad Maybe = (<.:>) Maybe

instance Interpreted Maybe where
	type Primary Maybe a = Maybe a
	run :: Maybe a -> Primary Maybe a
run = Maybe a -> Primary Maybe a
forall (m :: * -> * -> *) a. Category m => m a a
identity
	unite :: Primary Maybe a -> Maybe a
unite = Primary Maybe a -> Maybe a
forall (m :: * -> * -> *) a. Category m => m a a
identity

instance Monadic Maybe where
	wrap :: Maybe ~> (Maybe :> u)
wrap = (<.:>) Maybe u a -> (:>) Maybe u a
forall (t :: * -> *) (u :: * -> *) a.
Schematic Monad t u a -> (:>) t u a
TM ((<.:>) Maybe u a -> (:>) Maybe u a)
-> (Maybe a -> (<.:>) Maybe u a) -> Maybe a -> (:>) Maybe u a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. ((u :. Maybe) := a) -> (<.:>) Maybe u a
forall k k k k (ct :: k) (cu :: k) (t :: k -> k) (u :: k -> *)
       (a :: k).
((u :. t) := a) -> UT ct cu t u a
UT (((u :. Maybe) := a) -> (<.:>) Maybe u a)
-> (Maybe a -> (u :. Maybe) := a) -> Maybe a -> (<.:>) Maybe u a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. Maybe a -> (u :. Maybe) := a
forall (t :: * -> *) a. Pointable t => a |-> t
point

instance Monotonic a (Maybe a) where
	reduce :: (a -> r -> r) -> r -> Maybe a -> r
reduce a -> r -> r
f r
r (Just a
x) = a -> r -> r
f a
x r
r
	reduce a -> r -> r
_ r
r Maybe a
Nothing = r
r

instance Monotonic a (t a) => Monotonic a (Maybe :. t := a) where
	reduce :: (a -> r -> r) -> r -> ((Maybe :. t) := a) -> r
reduce a -> r -> r
f r
r (Just t a
x) = (a -> r -> r) -> r -> t a -> r
forall a e r. Monotonic a e => (a -> r -> r) -> r -> e -> r
reduce a -> r -> r
f r
r t a
x
	reduce a -> r -> r
_ r
r (Maybe :. t) := a
Nothing = r
r

type Optional = Adaptable Maybe

nothing :: Optional t => t a
nothing :: t a
nothing = Maybe a -> t a
forall k (t :: k -> *) (u :: k -> *). Adaptable t u => t ~> u
adapt Maybe a
forall a. Maybe a
Nothing