Expressions.hs

{-# LANGUAGE OverloadedStrings #-}

-- | Handles parsing of both infix and RPN Pdct expressions.
module Data.Prednote.Expressions
  ( ExprDesc(..)
  , Error
  , Token
  , operand
  , opAnd
  , opOr
  , opNot
  , openParen
  , closeParen
  , parseExpression
  ) where

import Data.Either (partitionEithers)
import qualified Data.Text as X
import qualified Data.Prednote.Expressions.Infix as I
import qualified Data.Prednote.Expressions.RPN as R
import qualified Data.Prednote.Pdct as P
import qualified Control.Monad.Exception.Synchronous as Ex

-- | A single type for both RPN tokens and infix tokens.
newtype Token a = Token { unToken :: I.InfixToken a }
type Error = X.Text

-- | Creates Operands from Pdct.
operand :: P.Pdct a -> Token a
operand p = Token (I.TokRPN (R.TokOperand p))

-- | The And operator
opAnd :: Token a
opAnd = Token (I.TokRPN (R.TokOperator R.OpAnd))

-- | The Or operator
opOr :: Token a
opOr = Token (I.TokRPN (R.TokOperator R.OpOr))

-- | The Not operator
opNot :: Token a
opNot = Token (I.TokRPN (R.TokOperator R.OpNot))

-- | Open parentheses
openParen :: Token a
openParen = Token (I.TokParen I.Open)

-- | Close parentheses
closeParen :: Token a
closeParen = Token (I.TokParen I.Close)

-- | Is this an infix or RPN expression?
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

-- | Parses expressions. Fails if the expression is nonsensical in
-- some way (for example, unbalanced parentheses, parentheses in an
-- RPN expression, or multiple stack values remaining.) Works by first
-- changing infix expressions to RPN ones.
parseExpression
  :: ExprDesc
  -> [Token a]
  -> Ex.Exceptional Error (P.Pdct a)
parseExpression e toks = do
  rpnToks <- case e of
    Infix -> Ex.fromMaybe "unbalanced parentheses\n"
             . I.createRPN
             . map unToken
             $ toks
    RPN -> Ex.fromMaybe "parentheses in an RPN expression\n"
           $ toksToRPN toks
  R.parseRPN rpnToks