Expr.hs

{-# LANGUAGE FlexibleContexts #-}
module Main  where 

import Prelude hiding (abs, const)
import Data.Char (digitToInt)
import Text.Parsec
import Text.Parsec.Expr
import Text.Parsec.Token (reservedOp)
import Text.Parsec.Combinator (between, sepBy1, chainr1)
import Data.List (elemIndex)

data T 
  = Const Char
  | Add T T
  | Mul T T
  deriving Show

const = do
  d <- digit
  return $ Const d

root :: Parsec String () T
root  =  buildExpressionParser table (spaces *> const <* spaces)
            <?> "expression"
  where
    table  =
      [ [binary '*' Mul AssocLeft ]
      , [binary '+' Add AssocLeft ]
      ]

    binary name fun assoc = Infix (do{ spaces *> (char name); return fun }) assoc

root2 :: Parsec String () T
root2 = helper2 
  where 
    helper (op,f) item = item >>= \c -> many (char op *> item ) >>= \cs -> return $ foldl f c cs
    helper2 = helper ('+',Add) (helper ('*',Mul) const)
    
  

main :: IO ()
main = do 
  print $ parse root  "" "1+2*3"
  print $ parse root2 "" "1+2*3+4"