-- | This module defines the freer monad `Freer`, which allows manipulating
--   effectful computations algebraically.
--
--   It is unlikely you need this, except maybe to define your own backends or something.
--   We may hide/remove it in future versions.
module Control.Monad.Freer where

import Control.Monad ((>=>))

-- | Freer monads.
--
-- A freer monad @Freer f a@ represents an effectful computation that returns a
-- value of type @a@. The parameter @f :: * -> *@ is a effect signature that
-- defines the effectful operations allowed in the computation. @Freer f a@ is
-- called a freer monad in that it's a `Monad` given any @f@.
data Freer f a where
  -- | A pure computation.
  Return :: a -> Freer f a
  -- | An effectful computation where the first argument @f b@ is the effect
  -- to perform and returns a result of type @b@; the second argument
  -- @b -> Freer f a@ is a continuation that specifies the rest of the
  -- computation given the result of the performed effect.
  Do :: f b -> (b -> Freer f a) -> Freer f a

instance Functor (Freer f) where
  fmap :: forall a b. (a -> b) -> Freer f a -> Freer f b
fmap a -> b
f (Return a
a) = b -> Freer f b
forall a (f :: * -> *). a -> Freer f a
Return (a -> b
f a
a)
  fmap a -> b
f (Do f b
eff b -> Freer f a
k) = f b -> (b -> Freer f b) -> Freer f b
forall (f :: * -> *) b a. f b -> (b -> Freer f a) -> Freer f a
Do f b
eff ((a -> b) -> Freer f a -> Freer f b
forall a b. (a -> b) -> Freer f a -> Freer f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Freer f a -> Freer f b) -> (b -> Freer f a) -> b -> Freer f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Freer f a
k)

instance Applicative (Freer f) where
  pure :: forall a. a -> Freer f a
pure = a -> Freer f a
forall a (f :: * -> *). a -> Freer f a
Return

  (Return a -> b
f) <*> :: forall a b. Freer f (a -> b) -> Freer f a -> Freer f b
<*> Freer f a
a = (a -> b) -> Freer f a -> Freer f b
forall a b. (a -> b) -> Freer f a -> Freer f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Freer f a
a
  (Do f b
eff b -> Freer f (a -> b)
k) <*> Freer f a
a = f b -> (b -> Freer f b) -> Freer f b
forall (f :: * -> *) b a. f b -> (b -> Freer f a) -> Freer f a
Do f b
eff ((b -> Freer f b) -> Freer f b) -> (b -> Freer f b) -> Freer f b
forall a b. (a -> b) -> a -> b
$ (Freer f (a -> b) -> Freer f a -> Freer f b
forall a b. Freer f (a -> b) -> Freer f a -> Freer f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Freer f a
a) (Freer f (a -> b) -> Freer f b)
-> (b -> Freer f (a -> b)) -> b -> Freer f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Freer f (a -> b)
k

instance Monad (Freer f) where
  (Return a
a) >>= :: forall a b. Freer f a -> (a -> Freer f b) -> Freer f b
>>= a -> Freer f b
f = a -> Freer f b
f a
a
  (Do f b
eff b -> Freer f a
k) >>= a -> Freer f b
f = f b -> (b -> Freer f b) -> Freer f b
forall (f :: * -> *) b a. f b -> (b -> Freer f a) -> Freer f a
Do f b
eff (b -> Freer f a
k (b -> Freer f a) -> (a -> Freer f b) -> b -> Freer f b
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> a -> Freer f b
f)

-- | Lift an effect into the freer monad.
toFreer :: f a -> Freer f a
toFreer :: forall (f :: * -> *) a. f a -> Freer f a
toFreer f a
eff = f a -> (a -> Freer f a) -> Freer f a
forall (f :: * -> *) b a. f b -> (b -> Freer f a) -> Freer f a
Do f a
eff a -> Freer f a
forall a (f :: * -> *). a -> Freer f a
Return

-- | Interpret the effects in a freer monad in terms of another monad.
interpFreer :: (Monad m) => (forall b. f b -> m b) -> Freer f a -> m a
interpFreer :: forall (m :: * -> *) (f :: * -> *) a.
Monad m =>
(forall b. f b -> m b) -> Freer f a -> m a
interpFreer forall b. f b -> m b
_ (Return a
a) = a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
interpFreer forall b. f b -> m b
handler (Do f b
eff b -> Freer f a
k) = f b -> m b
forall b. f b -> m b
handler f b
eff m b -> (b -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall b. f b -> m b) -> Freer f a -> m a
forall (m :: * -> *) (f :: * -> *) a.
Monad m =>
(forall b. f b -> m b) -> Freer f a -> m a
interpFreer f b -> m b
forall b. f b -> m b
handler (Freer f a -> m a) -> (b -> Freer f a) -> b -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Freer f a
k