module AEParser where

import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Expr
import Text.ParserCombinators.Parsec.Token 
import Text.ParserCombinators.Parsec.Language  
import Char

run :: Show a => Parser a -> String -> IO ()
run p input
        = let pp = do {r <- p; eof; return r}
          in case (parse pp "" input) of
            Left err -> do{ putStr "parse error at "
                          ; print err
                          }
            Right x  -> print x


-- -----------------------------------------------------------
--  Arithmetic Expression Parser in Parsec
-- -----------------------------------------------------------

-- E -> TH 
expr :: Parser [Int]
expr = do lt <- term
          le <- hexpr
          return (1:(lt++le))

-- H -> +TH | eps           
hexpr = do char '+'        
           lt <- term   
           le <- hexpr 
           return (2:lt++le)
        <|> return [3]

-- T -> FG
term = do lf <- factor   
          lt <- hterm               
          return (4:lf++lt)
       

-- G -> *FG | eps
hterm =  do char '*'    
            lf <- factor              
            lt <- hterm                
            return (5:lf++lt) 
         <|> return [6]

-- F -> (E) | a 
factor =  do char '('    
             le <- expr               
             char ')'      
             return (7:le) 
          <|> 
          do char 'a'     
             return [8]

-- ----------------------------------------------------
-- production of syntax tree
-- ----------------------------------------------------

data Expr = Plus Expr Expr | Mult Expr Expr | Factor
            | Empty 
            deriving Show
           
empty :: Expr -> Bool           
empty Empty = True
empty _     = False 

-- auxiliary function 
buildExpr :: (Expr -> Expr -> Expr) -> [Expr] -> Expr
buildExpr op []  = Empty
buildExpr op [e] = e
buildExpr op (e1:e2:es) = buildExpr op ((op e1 e2):es)


-- E -> TH 
expr3 :: Parser Expr
expr3 = do lt <- term3                  
           le <- hexpr3                
           return (buildExpr Plus (lt:le))

-- H -> +TH | eps
hexpr3 :: Parser [Expr] 
hexpr3 = (do c  <- char '+'  
             lt <- term3 
             le <- hexpr3  
             return (lt:le))
        <|>    
        return []

-- T -> FG
term3 :: Parser Expr
term3 = do lf <- factor3  
           lt <- hterm3 
           return (buildExpr Mult (lf:lt))


-- G -> *FG | eps
hterm3 :: Parser [Expr] 
hterm3 =  (do c  <- char '*'
              lf <- factor3                
              lt <- hterm3               
              return (lf:lt)) 
              <|> return []
            
-- F -> (E) | a 
factor3 :: Parser Expr
factor3 =   (do c  <- char '('  
                le <- expr3            
                c  <- char ')' 
                return le) <|> 
            (do c <- char 'a' 
                return Factor)



-- -----------------------------------------------------------
--  Using Parsec Expression Parser
-- -----------------------------------------------------------

lang    = makeTokenParser haskellStyle

aExpr :: Parser Expr
aExpr = buildExpressionParser operators factors


operators =
    [ [ op "*"  AssocLeft ]
    , [ op "+"  AssocLeft ]
    ]
    where
      op s assoc
             = Infix (do{ symbol lang s; return (\x y -> makeExpr s x y)} 
                         <?> "operator") assoc

makeExpr :: String -> Expr -> Expr -> Expr
makeExpr "+" x y = Plus x y
makeExpr "*" x y = Mult x y 
makeExpr _ _ _   = Empty

factors = choice [ parens lang aExpr
                  , variable
                 ]

variable = do{ char 'a'
             ; return Factor
             }