Match on the Church-encoded Free Monad

MatchFree.hs

{-# LANGUAGE Rank2Types #-}

module MatchFree where

newtype F f a = F { runF :: forall r. (a -> r) -> (f r -> r) -> r }

pureF :: a -> F f a
pureF a = F $ const . ($ a)

freeF :: Functor f => f (F f a) -> F f a
freeF f = F $ \ pr fr -> fr $ fmap (\ inner -> runF inner pr fr) f

type Open  f a = Either a (f (F f a))
type Close f a = F f a

close :: Functor f => Open f a -> Close f a
close = either pureF freeF

open
  :: Functor f
  => Close f a
  -> Open f a
open f = runF f Left (Right . fmap close)

matchF
  :: Functor f
  => (a -> r)
  -> (f (F f a) -> r)
  -> F f a
  -> r
matchF kp kf = either kp kf . open