graph-rewriting-cl-0.2.2: Term.hs

{-# 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]