-- | This module defines the freer monad `Freer`, which allows manipulating
-- effectful computations algebraically.
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) = 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) = forall (f :: * -> *) b a. f b -> (b -> Freer f a) -> Freer f a
Do f b
eff (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f 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 = 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 = 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 = forall (f :: * -> *) b a. f b -> (b -> Freer f a) -> Freer f a
Do f b
eff forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Freer f a
a) 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 = forall (f :: * -> *) b a. f b -> (b -> Freer f a) -> Freer f a
Do f b
eff (b -> Freer f a
k 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 = forall (f :: * -> *) b a. f b -> (b -> Freer f a) -> Freer f a
Do f a
eff forall a (f :: * -> *). a -> Freer f a
Return

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