{-# LANGUAGE Rank2Types #-}

module OldExprParser where

import ExprLexer
import BoundsParser hiding (chainl)

import qualified Text.Parsec as P
import qualified Text.Parsec.Pos as P
import Control.Monad.Either ()

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


-- chainr :: Alternative f => f a -> f (a -> a -> a) -> f a
-- chainr px pf = loop
--   where
--     loop = (\x r -> r x)     <$> px <*> rest
--     rest = (\f y x -> f x y) <$> pf <*> loop <|> pure id

-- chainl :: Alternative f => f a -> f (a -> a -> a) -> f a
-- chainl px pf = loop
--   where
--     loop = (\x r -> r x) <$> px <*> rest
--     rest = (\f r x -> r (f x)) <$> pf <*> loop <|> pure id

-- type P s = P.ParsecT [(s, Bounds)] ()

data BareExpr
  = Num  Int
  | Add  BareExpr BareExpr
  | Sub  BareExpr BareExpr
  | Mul  BareExpr BareExpr
  | Div  BareExpr BareExpr
  deriving (Eq, Show)

type ExprParser a = forall m. Monad m => P ExprToken m a

pExpr :: ExprParser BareExpr
pExpr    = P.chainl1  pTerm    (Add  <$   pToken TPlus  <|> Sub  <$ pToken TMinus)

pTerm :: ExprParser BareExpr
pTerm    = P.chainl1  pFactor  (Mul  <$   pToken TStar  <|> Div  <$ pToken TSlash)

pFactor :: ExprParser BareExpr
pFactor  = pNum <|> pToken TOpen *> pExpr <* pToken TClose

pNum :: ExprParser BareExpr
pNum     = (\(TNum n) -> Num n) <$>  satisfy isNum

parseExpr :: String -> Either P.ParseError BareExpr
parseExpr input = do
  toks <- P.runParser (collapse isSpace <$> pTokens) () "" input
  let startMargin = (leftMargin . snd . head) toks
  P.runParser (pExpr <* P.eof) startMargin "" toks