Skip to content

Instantly share code, notes, and snippets.

@TerrorJack

TerrorJack/Freer.hs

Created Jul 15, 2020
Embed
What would you like to do?
{-# 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.