http://mpickering.github.io/posts/2014-11-27-pain-free.html (take 2) that almost compiles

Hutton2.hs

{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
{-# LANGUAGE DeriveFunctor #-}

newtype Fix f = Fix { unFix :: f (Fix f) }

data HuttonF a = IntF Int | AddF a a deriving Functor
type Hutton = Fix HuttonF

data Holey f = Holey Hole | Expr (f (Holey f))
type HuttonHole = Holey HuttonF

data Hole = Hole

class Project a where
  proj :: a -> HuttonF a

class Inject a where
  inj :: HuttonF a -> a

instance Inject HuttonHole where
  inj = Expr

pattern I :: () => (Project a, Inject a) => Int -> a
pattern I n <- (proj -> IntF n) where
  I n = inj (IntF n)

pattern Add :: () => (Project a, Inject a) => a -> a -> a
pattern Add a b <- (proj -> AddF a b) where
  Add a b = inj (AddF a b)

hole :: HuttonHole
hole = Holey Hole

p4 :: HuttonHole
p4 = Add (I 5) hole

fillHole :: (Hole -> Hutton) -> HuttonHole -> Hutton
fillHole f (Holey hole) = f hole
fillHole f (Expr (IntF n)) = Fix $ IntF n
fillHole f (Expr (AddF e1 e2)) = Fix $ AddF (fillHole f e1) (fillHole f e2)