```-- | Parses reverse polish notation expressions. This module needs
-- much better error messages (right now it has none).
--
-- An RPN expression consists of operands and operators; a token is
-- either an operand or an operator. For example, in the expression @5
-- 4 +@, the @5@ and the @4@ are operands; the @+@ is an operator;
-- each of these three is a token.
module Penny.Liberty.Expressions.RPN (
Operand(Operand),
Operator(Unary, Binary),
Token(TokOperand, TokOperator),
process) where

import qualified Data.Foldable as Fdbl

-- | An operand; for example, in the expression @5 4 +@, @5@ and @4@
-- are operands.
newtype Operand a = Operand a deriving Show

-- | Operators; for example, in the expression @5 4 +@, @+@ is an
-- operator. Because this is RPN, there is no operator precedence.
data Operator a =
Unary (a -> a)
-- ^ Unary operators take only one operand (for example, a factorial
-- operator).

| Binary (a -> a -> a)
-- ^ Binary operators take two operands (for example, an addition
-- operator).

instance Show (Operator a) where
show (Unary _) = "<unary operator>"
show (Binary _) = "<binary operator>"

-- | A token is either an operator or an operand.
data Token a =
TokOperand (Operand a)
| TokOperator (Operator a)
deriving Show

-- | Given an operator, and the stack of operands, process the
-- operator. When parsing an RPN expression, encountering an operator
-- at the front of the queue of tokens to be processed means that the
-- correct number of tokens (one, for a unary operator, or two, for a
-- binary operator) must be popped off the stack of operands. The
-- operator is then applied to the operands. For a binary operator,
-- the binary function is applied first to the operand that was lowest
-- on the stack, and then to the operand that was higher up on the
-- stack. The result of the operator is then pushed onto the top of
-- the stack.
--
-- This function fails if there were insufficient operands on the
-- stack to process the operator. If successful, returns the new
-- stack, with the processed operands removed and the result of the
-- operator pushed onto the top of the stack.
processOperator ::
Operator a
-> [Operand a]
-> Maybe ([Operand a])
processOperator t ds = case t of
(Unary f) -> case ds of
[] -> Nothing
(Operand x):xs -> return \$ (Operand (f x)) : xs
(Binary f) -> case ds of
[] -> Nothing
(Operand x):dss -> case dss of
(Operand y):dsss ->
return \$ (Operand (f y x)) : dsss
[] -> Nothing

-- | Adds an operand to the top of the stack.
processOperand ::
Operand a
-> [Operand a]
-> [Operand a]
processOperand = (:)

-- | Processes the next token. Fails if the next token is an operator
-- and fails; otherwise, returns the new stack of operands.
processToken ::
[Operand a]
-> Token a
-> Maybe ([Operand a])
processToken s tok = case tok of
TokOperand d -> return (processOperand d s)
TokOperator t -> processOperator t s

-- | Processes an entire input sequence of RPN tokens.
process ::
Fdbl.Foldable l
=> l (Token a)
-- ^ The tokens must be in the sequence from left to right in
-- postfix order; for example, @5 4 -@ will yield @1@. Typically
-- many appends will be required in order to build this sequence. If
-- performance is a concern, you can use a Data.Sequence; if the
-- list is small (as these lists will typically be) a regular list
-- will do just fine.

-> Maybe a
-- ^ Fails if there is not exactly one operand remaining on the
-- stack at the end of the parse, or if at any time there are
-- insufficient operands on the stack to parse an
-- operator. Otherwise, succeeds and returns the result.
process ls = do
os <- Fdbl.foldlM processToken [] ls
(top, rest) <- case os of
(Operand x) : oss -> return (x, oss)
_ -> Nothing
case rest of