{-# LANGUAGE Rank2Types #-}

module ExprParser (
    ExprParser, pExpr, parseExpr
  ) where

import ExprLexer
import Expr
import Annotations.Bounds
import Annotations.BoundsParser
import Annotations.F.Annotated
import Annotations.F.ParserCombinators

import qualified Text.Parsec as P

import Data.Function
import Control.Applicative
import Control.Monad.Identity


-- | A bounds parser that works on 'ExprToken's.
type ExprParser a = forall m. Monad m => P ExprToken m a

-- | Recognises expressions. The expressions are annotated with position information.
pExpr :: ExprParser (AnnFix (Bounds ExprToken) ExprF)
pExpr = chainl pTerm (Add <$ pToken TPlus <|> Sub <$ pToken TMinus)

pTerm :: ExprParser (AnnFix (Bounds ExprToken) ExprF)
pTerm = chainl pFactor (Mul <$ pToken TStar <|> Div <$ pToken TSlash)

pFactor :: ExprParser (AnnFix (Bounds ExprToken) ExprF)
pFactor = pNum <|> pToken TOpen *> pExpr <* pToken TClose

pNum :: ExprParser (AnnFix (Bounds ExprToken) ExprF)
pNum = unit $ (\(TNum n) -> Num n) <$> satisfy isNum

-- | Runs 'pTokens' on the input and and 'pExpr' on the resulting tokens.
parseExpr :: String -> Either P.ParseError (AnnFix (Bounds ExprToken) ExprF)
parseExpr input = do
  toks <- P.runParser (collapse isSpace <$> pTokens) () "" input
  let startMargin = (leftMargin . snd . head) toks
  P.runParser (pExpr <* P.eof) (startMargin, map fst toks, []) "" toks