Skip to content

Instantly share code, notes, and snippets.

What would you like to do?
Fix, Free, and Cofree
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
import Prelude hiding (succ)
newtype Fix f = Fix (f (Fix f))
deriving instance (Show (f (Fix f))) => Show (Fix f)
data DegenerateF r = DegenerateF
deriving (Functor, Show)
type Degenerate = Fix DegenerateF
constant :: Degenerate
constant = Fix DegenerateF
newtype InfiniteF r = InfiniteF r
deriving (Functor, Show)
type Infinite = Fix InfiniteF
infinite = Fix (InfiniteF infinite)
data NatF r =
| SuccF r
deriving (Functor, Show)
type Nat = Fix NatF
one :: Nat
one = Fix OneF
succ :: Nat -> Nat
succ = Fix . SuccF
data Free f a =
Free (f (Free f a))
| Pure a
deriving Functor
deriving instance (Show a, Show (f (Free f a))) => Show (Free f a)
type NatFree = Free NatF
oneFree :: NatFree a
oneFree = Free OneF
succFree :: NatFree a -> NatFree a
succFree = Free . SuccF
type NotSoInfinite = Free InfiniteF
notSoInfinite :: NotSoInfinite ()
notSoInfinite = Free (InfiniteF (Free (InfiniteF (Pure ()))))
data Program f a =
Running (f (Program f))
| Terminated a
deriving Functor
free :: f (Free f a) -> Free f a
free = Free
unfree :: Free f a -> f (Free f a)
unfree (Free f) = f
unfree (Pure a) = error "kaboom"
data Cofree f a = Cofree a (f (Cofree f a))
deriving Functor
deriving instance (Show a, Show (f (Cofree f a))) => Show (Cofree f a)
type NatCofree = Cofree NatF
oneCofree :: NatCofree ()
oneCofree = Cofree () OneF
succCofree :: NatCofree () -> NatCofree ()
succCofree f = Cofree () (SuccF f)
uncofree :: Cofree f a -> f (Cofree f a)
uncofree (Cofree _ f) = f
cofree :: f (Cofree f a) -> Cofree f a
cofree = Cofree (error "kaboom")
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.