module Control.Joint.Effects.Maybe where

import Control.Joint.Operators ((<$$>), (<**>))
import Control.Joint.Abilities.Completable (Completable (complete))
import Control.Joint.Abilities.Interpreted (Interpreted (Primary, run))
import Control.Joint.Abilities.Transformer (Transformer (build, unite), Schema, (:>) (T))
import Control.Joint.Abilities.Adaptable (Adaptable (adapt))
import Control.Joint.Schemes (UT (UT), type (<.:>))

instance Interpreted Maybe where
	type Primary Maybe a = Maybe a
	run :: Maybe a -> Primary Maybe a
run Maybe a
x = Maybe a
Primary Maybe a
x

type instance Schema Maybe = UT Maybe

instance Transformer Maybe where
	build :: Maybe ~> (Maybe :> u)
build Maybe a
x = UT Maybe u a -> (:>) Maybe u a
forall (t :: * -> *) (u :: * -> *) a.
(Transformer t => Schema t u a) -> (:>) t u a
T (UT Maybe u a -> (:>) Maybe u a)
-> (Maybe a -> UT Maybe u a) -> Maybe a -> (:>) Maybe u a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((u :. Maybe) := a) -> UT Maybe u a
forall k k (t :: k -> k) (u :: k -> *) (a :: k).
((u :. t) := a) -> UT t u a
UT (((u :. Maybe) := a) -> UT Maybe u a)
-> (Maybe a -> (u :. Maybe) := a) -> Maybe a -> UT Maybe u a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> (u :. Maybe) := a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> (:>) Maybe u a) -> Maybe a -> (:>) Maybe u a
forall a b. (a -> b) -> a -> b
$ Maybe a
x
	unite :: Primary (Schema Maybe u) a -> (:>) Maybe u a
unite = UT Maybe u a -> (:>) Maybe u a
forall (t :: * -> *) (u :: * -> *) a.
(Transformer t => Schema t u a) -> (:>) t u a
T (UT Maybe u a -> (:>) Maybe u a)
-> (((u :. Maybe) := a) -> UT Maybe u a)
-> ((u :. Maybe) := a)
-> (:>) Maybe u a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((u :. Maybe) := a) -> UT Maybe u a
forall k k (t :: k -> k) (u :: k -> *) (a :: k).
((u :. t) := a) -> UT t u a
UT

instance Functor u => Functor (Maybe <.:> u) where
	fmap :: (a -> b) -> (<.:>) Maybe u a -> (<.:>) Maybe u b
fmap a -> b
f (UT (u :. Maybe) := a
x) = ((u :. Maybe) := b) -> (<.:>) Maybe u b
forall k k (t :: k -> k) (u :: k -> *) (a :: k).
((u :. t) := a) -> UT t u a
UT (((u :. Maybe) := b) -> (<.:>) Maybe u b)
-> ((u :. Maybe) := b) -> (<.:>) Maybe u b
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> ((u :. Maybe) := a) -> (u :. Maybe) := b
forall (t :: * -> *) (u :: * -> *) a b.
(Functor t, Functor u) =>
(a -> b) -> ((t :. u) := a) -> (t :. u) := b
<$$> (u :. Maybe) := a
x

instance Applicative u => Applicative (Maybe <.:> u) where
	pure :: a -> (<.:>) Maybe u a
pure = ((u :. Maybe) := a) -> (<.:>) Maybe u a
forall k k (t :: k -> k) (u :: k -> *) (a :: k).
((u :. t) := a) -> UT t u a
UT (((u :. Maybe) := a) -> (<.:>) Maybe u a)
-> (a -> (u :. Maybe) := a) -> a -> (<.:>) Maybe u a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> (u :. Maybe) := a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> (u :. Maybe) := a)
-> (a -> Maybe a) -> a -> (u :. Maybe) := a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
	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 (t :: k -> k) (u :: k -> *) (a :: k).
((u :. t) := a) -> UT t u a
UT (((u :. Maybe) := b) -> (<.:>) Maybe u b)
-> ((u :. Maybe) := b) -> (<.:>) Maybe u b
forall a b. (a -> b) -> a -> b
$ (u :. Maybe) := (a -> b)
f ((u :. Maybe) := (a -> b))
-> ((u :. Maybe) := a) -> (u :. Maybe) := b
forall (t :: * -> *) (u :: * -> *) a b.
(Applicative t, Applicative u) =>
((t :. u) := (a -> b)) -> ((t :. u) := a) -> (t :. u) := b
<**> (u :. Maybe) := a
x

instance (Applicative u, Monad u) => Monad (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 (t :: k -> k) (u :: k -> *) (a :: k).
((u :. t) := a) -> UT t u a
UT (((u :. Maybe) := b) -> (<.:>) Maybe u b)
-> ((u :. Maybe) := b) -> (<.:>) Maybe u b
forall a b. (a -> b) -> a -> b
$ (u :. Maybe) := a
x ((u :. Maybe) := a)
-> (Maybe a -> (u :. Maybe) := b) -> (u :. Maybe) := b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m 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 :. Maybe) := b
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (<.:>) Maybe u b
f)

instance Completable (Either e) Maybe where
	complete :: Either e a -> Maybe a
complete = (e -> Maybe a) -> (a -> Maybe a) -> Either e a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> e -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just

type Optional = Adaptable Maybe

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