Expr.hs

{-# LANGUAGE TupleSections #-}

import Control.Lens

data Expr
  = Var String
  | App Expr Expr
  | Lam String Expr
  deriving Show

var :: Prism' Expr String
var = prism' f g
  where f = Var
        g (Var a) = Just a
        g _ = Nothing

app :: Prism' Expr (Expr, Expr)
app = prism' f g
  where f (a, b) = App a b
        g (App a b) = Just (a, b)
        g _ = Nothing

lam :: Prism' Expr (String, Expr)
lam = prism' f g
  where f (a, b) = Lam a b
        g (Lam a b) = Just (a, b)
        g _ = Nothing

id' :: Expr
id' = lam # ("a", var # "a")

const' :: Expr
const' = id' & lam . _2 %~ (#) lam . ("b",)

constN :: Int -> Expr
constN n = foldr (\c e -> e & lam . _2 %~ (#) lam . (c:"",)) id' vars
  where vars = enumFromTo 'b' (toEnum (n + fromEnum 'a'))