Freer.hs

{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -Wall #-}

module Freer where

import Control.Applicative
import Control.Monad
import Data.Sequence (Seq (..))
import GHC.Exts
import Unsafe.Coerce

data Freer f a where
  Pure :: a -> Freer f a
  Bind :: f Any -> Seq (Any -> Freer f Any) -> Freer f b

instance Functor (Freer f) where
  fmap = liftA

instance Applicative (Freer f) where
  pure = Pure
  (<*>) = ap

instance Monad (Freer f) where
  Pure a >>= f = f a
  Bind m s >>= f = Bind m (s :|> unsafeCoerce f)

liftFreer :: f a -> Freer f a
liftFreer m = Bind (unsafeCoerce m) Empty

runFreer :: Monad m => Freer m a -> m a
runFreer (Pure a) = pure a
runFreer (Bind m s) = unsafeCoerce $ foldl (\acc f -> runFreer . f =<< acc) m s