{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StaticPointers #-}
{-# LANGUAGE UndecidableInstances #-}

module Control.Monad.Static where

import Control.Applicative.Static
import Control.Distributed.Closure
import Data.Functor.Static
import Data.Typeable (Typeable)

-- | Instances of 'StaticBind' should satisfy the following laws (writing
-- 'staticMap', 'staticApply', 'staticBind' as infix @('<$>')@, @('<*>')@, @(>>=)@,
-- respectively):
--
-- @
-- (m >>= f) >>= g = m >>= static (.) ``cap`` (staticFlippedBind g) `cap` f
-- 'staticJoin' . 'staticJoin' = 'staticJoin' . 'staticMap' (static 'staticJoin')
-- @
--
-- where
--
-- @
-- staticFlippedBind :: Closure (b -> m c) -> Closure (m b -> m c)
-- staticFlippedBind = capDup (static (flip staticBind))
-- @
class StaticApply m => StaticBind m where
  staticBind :: (Typeable a, Typeable b) => m a -> Closure (a -> m b) -> m b
  staticBind m a
m Closure (a -> m b)
k = forall (m :: * -> *) a.
(StaticBind m, Typeable a) =>
m (m a) -> m a
staticJoin (forall (f :: * -> *) a b.
(StaticFunctor f, Typeable a, Typeable b) =>
Closure (a -> b) -> f a -> f b
staticMap Closure (a -> m b)
k m a
m)

  staticJoin :: Typeable a => m (m a) -> m a
  staticJoin m (m a)
m = m (m a)
m forall (m :: * -> *) a b.
(StaticBind m, Typeable a, Typeable b) =>
m a -> Closure (a -> m b) -> m b
`staticBind` static forall a. a -> a
id

  {-# MINIMAL staticBind | staticJoin #-}

class (StaticApplicative m, StaticBind m) => StaticMonad m
instance (StaticApplicative m, StaticBind m) => StaticMonad m

staticReturn :: (StaticApplicative m, Typeable a) => Closure a -> m a
staticReturn :: forall (m :: * -> *) a.
(StaticApplicative m, Typeable a) =>
Closure a -> m a
staticReturn = forall (f :: * -> *) a.
(StaticApplicative f, Typeable a) =>
Closure a -> f a
staticPure

instance StaticBind Closure where
  staticBind :: forall a b.
(Typeable a, Typeable b) =>
Closure a -> Closure (a -> Closure b) -> Closure b
staticBind Closure a
m Closure (a -> Closure b)
k = forall a. Closure a -> a
unclosure Closure (a -> Closure b)
k (forall a. Closure a -> a
unclosure Closure a
m)