module Pandora.Pattern.Functor.Monad where

import Pandora.Pattern.Functor.Bindable (Bindable ((>>=)))
import Pandora.Pattern.Functor.Pointable (Pointable (point))

{- |
> Let f :: (Pointable t, Bindable t) => a -> t a
> Let g :: (Pointable t, Bindable t) => a -> t a
> Let h :: (Pointable t, Bindable t) => t a

> When providing a new instance, you should ensure it satisfies:
> * Left identity: point a >>= f ≡ f a
> * Right identity: h >>= point ≡ h
> * Associativity: h >>= (f >=> g) ≡ (h >>= f) >>= g
-}

infixl 1 >>=-, ->>=
infixr 1 -=<<, =<<-

class (Pointable t, Bindable t) => Monad t where
	(>>=-) :: t a -> t b -> t a
	(>>=-) t a
x t b
y = t a
x t a -> (a -> t a) -> t a
forall (t :: * -> *) a b. Bindable t => t a -> (a -> t b) -> t b
>>= \a
r -> t b
y t b -> (b -> t a) -> t a
forall (t :: * -> *) a b. Bindable t => t a -> (a -> t b) -> t b
>>= \b
_ -> a -> t a
forall (t :: * -> *) a. Pointable t => a :=> t
point a
r
	(->>=) :: t a -> t b -> t b
	(->>=) t a
x t b
y = t a
x t a -> (a -> t b) -> t b
forall (t :: * -> *) a b. Bindable t => t a -> (a -> t b) -> t b
>>= \a
_ -> t b
y t b -> (b -> t b) -> t b
forall (t :: * -> *) a b. Bindable t => t a -> (a -> t b) -> t b
>>= \b
r -> b -> t b
forall (t :: * -> *) a. Pointable t => a :=> t
point b
r
	(-=<<) :: t a -> t b -> t b
	(-=<<) t a
x t b
y = t a
x t a -> (a -> t b) -> t b
forall (t :: * -> *) a b. Bindable t => t a -> (a -> t b) -> t b
>>= \a
_ -> t b
y t b -> (b -> t b) -> t b
forall (t :: * -> *) a b. Bindable t => t a -> (a -> t b) -> t b
>>= \b
r -> b -> t b
forall (t :: * -> *) a. Pointable t => a :=> t
point b
r
	(=<<-) :: t a -> t b -> t a
	(=<<-) t a
x t b
y = t a
x t a -> (a -> t a) -> t a
forall (t :: * -> *) a b. Bindable t => t a -> (a -> t b) -> t b
>>= \a
r -> t b
y t b -> (b -> t a) -> t a
forall (t :: * -> *) a b. Bindable t => t a -> (a -> t b) -> t b
>>= \b
_ -> a -> t a
forall (t :: * -> *) a. Pointable t => a :=> t
point a
r