.hs

import Data.Functor (void)
import qualified Data.Text as T

import Text.Megaparsec
import Text.Megaparsec.Text as T

data Expr = App Expr Expr | Var T.Text | Lambda T.Text Expr | S | K | I deriving Show

translate :: Expr -> Expr
translate (App a b) = App (translate a) (translate b)
translate (Lambda s e) | not (occursFree s e) = App K (translate e)
translate (Lambda s (Var t)) | s == t = I
translate (Lambda s (App a b)) = S `App` translate (Lambda s a) `App` translate (Lambda s b)
translate (Lambda s (Lambda t a)) | occursFree s a = translate (Lambda s (translate $ Lambda t a))
translate other = other

occursFree :: T.Text -> Expr -> Bool
occursFree s (Var t) | s == t = True
occursFree s (Lambda t e) | s /= t = occursFree s e
occursFree s (App e1 e2) = occursFree s e1 || occursFree s e2
occursFree _ _ = False

parser :: T.Parser Expr
parser = pExpr <* eof
  where
    pExpr = try pApp <|> pBase
    pBase = pLambda <|> pBrackets <|> pVar

    pBrackets = lexeme $ between (char '(') (char ')') pExpr
    pVar = Var <$> pIdent
    pApp = App <$> pBase <*> pExpr

    pLambda = do
        lexeme_ (char 'λ' <|> char '\\')
        idents <- many (lexeme pIdent)
        lexeme_ (char '.') <|> lexeme_ (string "->")
        expr <- pExpr
        return $ foldr Lambda expr idents

    pIdent = T.pack <$> lexeme (some letterChar)
    lexeme = (<* space)
    lexeme_ = void . lexeme