module Prednote.Expressions
( ExprDesc(..)
, Error
, Token
, operand
, opAnd
, opOr
, opNot
, openParen
, closeParen
, parseExpression
) where
import Data.Either (partitionEithers)
import Data.Functor.Contravariant
import qualified Data.Text as X
import qualified Prednote.Expressions.Infix as I
import qualified Prednote.Expressions.RPN as R
import Prednote.Core (Pred)
newtype Token a = Token { unToken :: I.InfixToken a }
instance Contravariant Token where
contramap f = Token . contramap f . unToken
type Error = X.Text
operand :: Pred a -> Token a
operand p = Token (I.TokRPN (R.TokOperand p))
opAnd :: Token a
opAnd = Token (I.TokRPN (R.TokOperator R.OpAnd))
opOr :: Token a
opOr = Token (I.TokRPN (R.TokOperator R.OpOr))
opNot :: Token a
opNot = Token (I.TokRPN (R.TokOperator R.OpNot))
openParen :: Token a
openParen = Token (I.TokParen I.Open)
closeParen :: Token a
closeParen = Token (I.TokParen I.Close)
data ExprDesc
= Infix
| RPN
deriving (Eq, Show)
toksToRPN :: [Token a] -> Maybe [R.RPNToken a]
toksToRPN toks
= let toEither t = case unToken t of
I.TokRPN tok -> Right tok
_ -> Left ()
in case partitionEithers . map toEither $ toks of
([], xs) -> return xs
_ -> Nothing
parseExpression
:: ExprDesc
-> [Token a]
-> Either Error (Pred a)
parseExpression e toks = do
rpnToks <- case e of
Infix -> maybe (Left "unbalanced parentheses\n") Right
. I.createRPN
. map unToken
$ toks
RPN -> maybe (Left "parentheses in an RPN expression\n") Right
$ toksToRPN toks
R.parseRPN rpnToks