module Pandora.Paradigm.Primary.Functor.Maybe where

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 ((<*>), apply))
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))
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 (<.:>))

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

maybe :: b -> (a -> b) -> Maybe a -> b
maybe :: b -> (a -> b) -> Maybe a -> b
maybe b
x a -> b
_ Maybe a
Nothing = b
x
maybe b
_ a -> b
f (Just a
y) = a -> b
f a
y

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

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

type Optional = Adaptable Maybe

instance Covariant u => Covariant (Maybe <.:> u) where
	a -> b
f <$> :: (a -> b) -> (<.:>) Maybe u a -> (<.:>) Maybe u b
<$> UT (u :. Maybe) := a
x = ((u :. Maybe) := b) -> (<.:>) Maybe u b
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) := b) -> (<.:>) Maybe u b)
-> ((u :. Maybe) := b) -> (<.:>) Maybe u b
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ a -> b
f (a -> b) -> ((u :. Maybe) := a) -> (u :. Maybe) := b
forall (t :: * -> *) (u :: * -> *) a b.
(Covariant t, Covariant u) =>
(a -> b) -> ((t :. u) := a) -> (t :. u) := b
<$$> (u :. Maybe) := a
x

instance Applicative u => Applicative (Maybe <.:> u) where
	UT (u :. Maybe) := (a -> b)
f <*> :: (<.:>) Maybe u (a -> b) -> (<.:>) Maybe u a -> (<.:>) Maybe u b
<*> UT (u :. Maybe) := a
x = ((u :. Maybe) := b) -> (<.:>) Maybe u b
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) := b) -> (<.:>) Maybe u b)
-> ((u :. Maybe) := b) -> (<.:>) Maybe u b
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ Maybe (a -> b) -> Maybe a -> Maybe b
forall (t :: * -> *) a b. Applicative t => t (a -> b) -> t a -> t b
apply (Maybe (a -> b) -> Maybe a -> Maybe b)
-> ((u :. Maybe) := (a -> b)) -> u (Maybe a -> Maybe b)
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> (u :. Maybe) := (a -> b)
f u (Maybe a -> Maybe b) -> ((u :. Maybe) := a) -> (u :. Maybe) := b
forall (t :: * -> *) a b. Applicative t => t (a -> b) -> t a -> t b
<*> (u :. Maybe) := a
x

instance Pointable u => Pointable (Maybe <.:> u) where
	point :: a |-> (Maybe <.:> u)
point = ((u :. Maybe) := a) -> UT Covariant Covariant 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) -> UT Covariant Covariant Maybe u a)
-> (a -> (u :. Maybe) := a) -> a |-> (Maybe <.:> u)
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. Maybe a |-> u
forall (t :: * -> *) a. Pointable t => a |-> t
point (Maybe a |-> u) -> (a -> Maybe a) -> a -> (u :. Maybe) := a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. a -> Maybe a
forall (t :: * -> *) a. Pointable t => a |-> t
point

instance (Pointable u, Bindable u) => Bindable (Maybe <.:> u) where
	UT (u :. Maybe) := a
x >>= :: (<.:>) Maybe u a -> (a -> (<.:>) Maybe u b) -> (<.:>) Maybe u b
>>= a -> (<.:>) Maybe u b
f = ((u :. Maybe) := b) -> (<.:>) Maybe u b
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) := b) -> (<.:>) Maybe u b)
-> ((u :. Maybe) := b) -> (<.:>) Maybe u b
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ (u :. Maybe) := a
x ((u :. Maybe) := a)
-> (Maybe a -> (u :. Maybe) := b) -> (u :. Maybe) := b
forall (t :: * -> *) a b. Bindable t => t a -> (a -> t b) -> t b
>>= ((u :. Maybe) := b)
-> (a -> (u :. Maybe) := b) -> Maybe a -> (u :. Maybe) := b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe b |-> u
forall (t :: * -> *) a. Pointable t => a |-> t
point Maybe b
forall a. Maybe a
Nothing) ((<.:>) Maybe u b -> (u :. Maybe) := b
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run ((<.:>) Maybe u b -> (u :. Maybe) := b)
-> (a -> (<.:>) Maybe u b) -> a -> (u :. Maybe) := b
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. a -> (<.:>) Maybe u b
f)

instance Monad u => Monad (Maybe <.:> u) where

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