{-# LANGUAGE UnicodeSyntax #-} module Term where import Prelude.Unicode import Text.ParserCombinators.Parsec as Parsec import Text.ParserCombinators.Parsec.Token as Parsec import Text.ParserCombinators.Parsec.Language as Parsec import Control.Monad (liftM) data Expr = Application Expr Expr | Variable String deriving (Ord, Eq) instance Show Expr where show = showComp False where showComp :: Bool → Expr → String showComp isComponent expr = case expr of Application (Application e1 e2) e3 → maybeWrap $ show e1 ⧺ " " ⧺ diverge e2 ⧺ " " ⧺ diverge e3 Application e1 e2 → maybeWrap $ diverge e1 ⧺ " " ⧺ diverge e2 Variable v → v where maybeWrap str = if isComponent then "(" ⧺ str ⧺ ")" else str diverge = showComp True parse ∷ String → Expr parse str = either (error ∘ show) id (Parsec.parse parser "(null)" str) parseFile ∷ FilePath → IO Expr parseFile = liftM (either (error ∘ show) id) ∘ Parsec.parseFromFile parser parser ∷ Parser Expr parser = let expr = parser in liftM (foldl1 Application) $ many1 $ choice [parens haskell expr, liftM Variable $ identifier haskell]