Purescript Reverse Polish Notation

RNP.purs

module RPN where

import Prelude

import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Data.Array ((:))
import Data.Either (Either(..))
import Data.Foldable (foldM)


data Element =
  V Int |
  Fn1 (Int -> Int) |
  Fn2 (Int -> Int -> Int)


type Acc = Array Int


solve :: Array Element -> Either String Int
solve = getResult <<< foldM solver []
  where
    solver :: Acc -> Element -> Either String Acc
    solver stack (V next) = Right $ next : stack
    solver [a] (Fn1 fn) = Right [fn a]
    solver stack (Fn1 fn) = invalidArguments stack 1
    solver [a, b] (Fn2 fn) = Right [fn a b]
    solver stack (Fn2 fn) = invalidArguments stack 2

    invalidArguments stack n =
      Left $ "Expected " <> show n <> " arguments, got " <> show stack

    getResult :: Either String Acc -> Either String Int
    getResult (Right [value]) = Right value
    getResult (Right stack) = Left $ "Unfinished output " <> (show stack)
    getResult (Left err) = Left err


main :: Eff (console :: CONSOLE) Unit
main = do
  logSolution [V 2, V 3, Fn2 (+)]
  logSolution [V 5, V 3, Fn2 (+), V 1, Fn2 (-), V 2, Fn2 (*)]
  logSolution []
  logSolution [V 2]
  logSolution [V 2, V 3]
  logSolution [V 2, Fn2 (+)]
  logSolution [V 2, V 3, V 4, Fn2 (+)]
  logSolution [V 2, V 3, V 4, Fn2 (+)]
  logSolution [V 3, V 2, Fn2 (+), Fn1 negate]

  where
    logSolution computation = log $ "Result: " <> (show $ solve computation)

-- Result: (Right 5)
-- Result: (Right -14)
-- Result: (Left "Unfinished output []")
-- Result: (Right 2)
-- Result: (Left "Unfinished output [3,2]")
-- Result: (Left "Expected 2 arguments, got [2]")
-- Result: (Left "Expected 2 arguments, got [4,3,2]")
-- Result: (Left "Expected 2 arguments, got [4,3,2]")
-- Result: (Right -5)