Completely redo everything and add partials

elm-package.json

@@ -8,10 +8,12 @@
     ],
     "exposed-modules": [],
     "dependencies": {
+        "Bogdanp/elm-combine": "3.1.1 <= v < 4.0.0",
+        "elm-community/ratio": "1.1.0 <= v < 2.0.0",
         "elm-lang/core": "5.1.1 <= v < 6.0.0",
         "elm-lang/html": "2.0.0 <= v < 3.0.0",
-        "Bogdanp/elm-combine": "3.1.1 <= v < 4.0.0",
-        "mhoare/elm-stack": "3.1.1 <= v < 4.0.0"
+        "gilbertkennen/bigint": "1.0.1 <= v < 2.0.0",
+        "mgold/elm-nonempty-list": "3.1.0 <= v < 4.0.0"
     },
     "elm-version": "0.18.0 <= v < 0.19.0"
 }

src/Eval.elm

@@ -0,0 +1,92 @@
+module Eval exposing (..)
+
+import Expr exposing (..)
+import Ratio exposing (Rational(..))
+import Dict exposing (Dict(..))
+import List.Nonempty as Nonempty exposing (Nonempty(..))
+import Stack exposing (..)
+
+type Error = MathematicalImpossibility | StackUnderflow Int | OpNotFound OpName
+
+type alias Partial = (OpName, List Value, Int)
+
+type Value =
+    Rational Rational | Partial Partial
+
+evalGroup : List Expr -> Result Error (List Value)
+evalGroup g =
+    List.foldl (\expr result -> Result.andThen (\stack -> evalRec expr stack) result) (Ok []) g
+
+-- If anything but a StackUnderflow results, just let it go through.
+-- If StackUnderflow occurs, convert it to Partial and push the Partial to stack.
+handleOpResult : OpName -> List Value -> Result Error (List Value) -> Result Error (List Value)
+handleOpResult opname stack r =
+    case r of
+        Ok x -> r
+        Err e ->
+            case e of
+                StackUnderflow missing ->
+                    [Partial (opname, stack, missing)]
+                    |> Ok
+                _ -> r
+
+evalRec : Expr -> List Value -> Result Error (List Value)
+evalRec e s =
+    case e of
+        Num x ->
+            Ratio.fromInt x
+            |> Rational
+            |> \v -> v::s
+            |> Ok
+        Group g ->
+            evalGroup g
+            |> Result.map (\groupStack -> groupStack ++ s)
+        Op o ->
+            case Dict.get o ops of
+                Just opF ->
+                    opF s
+                    |> handleOpResult o s
+                Nothing -> OpNotFound o |> Err
+
+eval : Expr -> Result Error (List Value)
+eval e =
+    evalRec e []
+
+type alias Op = List Value -> Result Error (List Value)
+
+ops : Dict OpName Op
+ops = Dict.fromList [
+    ("/", binaryOp Ratio.divide),
+    ("+", binaryOp Ratio.add),
+    ("*", binaryOp Ratio.multiply),
+    ("-", binaryOp Ratio.subtract)
+    ]
+
+getNums : List Value -> Int -> Result Int (List Value, Nonempty Ratio.Rational)
+getNums stack qty = 
+    let selectRationals = Nonempty.map (\v -> case v of
+        Rational r -> r
+        _ -> Ratio.fromInt 0)
+    in 
+        Stack.pick (\v -> case v of
+            Rational r -> True
+            _ -> False) stack qty
+        |> Result.map (\(stack, nums) -> (stack, selectRationals nums))
+
+binaryOp : (Rational -> Rational -> Rational) -> Op
+binaryOp f stack =
+    getNums stack 2 
+    |> Result.mapError StackUnderflow
+    |> Debug.log "BINOP"
+    |> Result.map (\(stack, numbers) -> (f (Nonempty.get 0 numbers) (Nonempty.get 1 numbers) |> Rational)::stack)
+
+prettyPrintValue : Value -> String
+prettyPrintValue v = case v of
+    Rational r -> Ratio.toFloat r |> toString
+    Partial (op, stack, missing) -> String.join " " <| ["Partial:", op, "["] ++ List.map prettyPrintValue stack ++ ["]", toString missing]
+
+prettyPrintError : Error -> String
+prettyPrintError e = case e of
+    MathematicalImpossibility -> "Does not compute"
+    OpNotFound n -> String.concat ["Operator \"", n, "\" not found"]
+    StackUnderflow n -> String.join " " ["Stack underflowed by", toString n, "items"]

src/Expr.elm

@@ -1,52 +1,46 @@
-module Expr exposing (Expr(..), Op(..), parse)
+module Expr exposing (Expr(..), OpName, parse)
 
 import Combine exposing (..)
 import Combine.Num as Num
+import Combine.Char as Char
 
-type Op
-    = Add
-    | Subtract
-    | Multiply
-    | Divide
-    | Exponent
-    | Range
+type alias OpName = String
 
 type Expr 
-    = Num Float
-    | Op Op
+    = Num Int
+    | Op OpName
     | Group (List Expr)
 
 num : Parser () Expr
 num =
-    (Num <$> Num.float <|> Num << toFloat <$> Num.int)
-    <?> "expected a number (int or float)"
+    (Num <$> Num.int)
+    <?> "expected a number (int)"
 
-stringIs : String -> a -> Parser s a
-stringIs str val =
-    string str *> succeed val
+acceptableOperatorName : Parser () String
+acceptableOperatorName =
+    regex "[A-Za-z\\^%*$£!@#~.,=+-_;:/\\\\]*"
 
 op : Parser () Expr
 op =
-    stringIs "+" Add
-    <|> stringIs "-" Subtract
-    <|> stringIs "*" Multiply
-    <|> stringIs "/" Divide
-    <|> stringIs "^" Exponent
-    <|> stringIs "range" Range
+    acceptableOperatorName
     |> map Op
 
 group : Parser () Expr
 group =
-    between (string "(") (string ")") (sepBy1 whitespace (lazy <| \_ -> parser)) -- Avoid bad recursion issues using lazy parser evaluation
+    parens (sepBy1 whitespace (lazy <| \_ -> parser)) -- Avoid "bad recursion" issues using lazy parser evaluation
     <?> "expected a group (whitespace-separated expressions between brackets)"
     |> map Group
 
 parser : Parser () Expr
 parser =
-    (lazy <| \_ -> group) <|> op <|> num
+    (lazy <| \_ -> group) <|> num <|> op
 
-parse : String -> Result (List String) Expr
+convertErrorList : List String -> String
+convertErrorList =
+    List.intersperse " or " >> String.concat
+
+parse : String -> Result String Expr
 parse =
     Combine.parse parser
-    >> Result.mapError (\(_, _, errorList) -> errorList)
-    >> Result.map (\(_, _, expr) -> expr) -- Convert errors/results to nicer format
+    >> Result.mapError (\(_, _, errorList) -> convertErrorList errorList) -- Convert error data into only the error message
+    >> Result.map (\(_, _, data) -> data) -- Drop irrelevant parse data

src/Main.elm

@@ -4,14 +4,15 @@ import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
 
-import Expr exposing (Expr(..), Op(..))
+import Expr exposing (Expr(..), OpName)
+import Eval exposing (eval)
 
-import Stack exposing (Stack(..))
+import Ratio
 
 main = Html.beginnerProgram { model = model, update = update, view = view }
 
 type alias Model =
-    { result : Result (List String) (List Float)
+    { result : Result String (List Eval.Value)
     , expression : String
     }
 
@@ -28,16 +29,16 @@ update msg model =
     case msg of
         ExpressionTyped str ->
             Expr.parse ("(" ++ str ++ ")") -- wrap str in brackets so it's recognized as a group
-            |> Result.andThen eval -- Convert stack underflow errors into a list
+            |> Result.andThen (eval >> Result.mapError Eval.prettyPrintError)
             |> \r -> { model | result = r, expression = str }
 
 error : String -> Html a
 error err =
     div [class "error"] [text err]
 
-stackItem : Float -> Html a
+stackItem : Eval.Value -> Html a
 stackItem n =
-    let asString = toString n
+    let asString = Eval.prettyPrintValue n
         minWidth = toString (String.length asString) ++ "em"
     in div [class "item", style [("min-width", minWidth)]] [text asString]
 
@@ -48,65 +49,10 @@ view model =
             Ok stack ->
                 List.reverse stack -- Puts first items at the top, for nicer looks
                 |> List.map stackItem
-            Err errors ->
-                List.map error errors
+            Err outputError ->
+                [error outputError]
     in div [class "rpncalc"] (
-        [ input [onInput ExpressionTyped, value model.expression, class "exprinput"] []
-        ] ++ calcOutput
+        [ div [] calcOutput
+        , input [onInput ExpressionTyped, value model.expression, class "exprinput"] []
+        ]
     )
-
-listToStack : List a -> Stack a
-listToStack =
-    List.foldr Stack.push Stack.initialise
-
-prependList : List a -> Stack a -> Stack a
-prependList from to =
-    List.foldr Stack.push to from
-
-prepend : Stack a -> Stack a -> Stack a
-prepend from to =
-    prependList (Stack.toList from) to
-
-type alias StackFunction = Stack Float -> Result String (Stack Float)
-
--- Runs a binary operation which returns a list on a stack
-binListOutOp : (Float -> Float -> List Float) -> StackFunction
-binListOutOp f s =
-    let
-        (maybeX, s1) = Stack.pop s
-        (maybeY, s2) = Stack.pop s1
-    in Maybe.map2 (,) maybeX maybeY
-       |> Maybe.map (\(x, y) -> f y x) -- x and y swapped round - this makes "5 1 /" become 5 instead of 0.2.
-       |> Maybe.map (\r -> prependList r s2)
-       |> Result.fromMaybe "Stack underflow"
-
--- Runs a binary operation on a stack
-binOp : (Float -> Float -> Float) -> StackFunction
-binOp f =
-    binListOutOp (\x y -> f x y |> List.singleton)
-
-evalRec : Expr -> Stack Float -> Result String (Stack Float)
-evalRec expr s =
-    case expr of
-        Group es ->
-            List.foldl (\expr s -> Result.andThen (evalRec expr) s) (Ok Stack.initialise) es
-            |> Result.map (\newStack -> prepend newStack s) -- prepend new stack's contents to old stack
-        Num n ->
-            Ok (Stack.push n s)
-        Op o ->
-            case o of
-                Add -> binOp (+) s
-                Subtract -> binOp (-) s
-                Multiply -> binOp (*) s
-                Divide -> binOp (/) s
-                Exponent -> binOp (^) s
-                Range ->
-                    binListOutOp (\x y -> 
-                        List.range (floor x) (floor y)
-                        |> List.map toFloat) s
-
-eval : Expr -> Result (List String) (List Float)
-eval e =
-    evalRec e (Stack.initialise)
-    |> Result.map Stack.toList -- Convert stack to list
-    |> Result.mapError List.singleton -- Wrap possible stackoverflow error in list

src/Stack.elm

@@ -0,0 +1,23 @@
+-- Contains functions for use of a list as a stack, specifically for use in the calculator
+module Stack exposing (..)
+
+import List.Nonempty as Nonempty exposing (Nonempty(..))
+
+-- Gets the specified number of predicate-satisfying values from supplied stack. Returns new stack and values collected
+pick : (a -> Bool) -> List a -> Int -> Result Int (List a, Nonempty a)
+pick pred stack qty =
+    let pick curr (values, newStack, num) =
+            if pred curr then (curr::values, newStack, num + 1)
+            else (values, curr::newStack, num)
+
+        foldF = \c (val, new, num) ->
+            if num < qty then pick c (val, new, num)
+            else (val, c::new, num)
+        (values, newStack, num) = List.foldl foldF ([], [], 0) stack
+    in 
+        if num == qty then
+            Nonempty.fromList values
+            |> Result.fromMaybe qty
+            |> Result.map (\v -> (newStack, v))
+        else
+            Err <| qty - num

style.css

@@ -9,14 +9,14 @@
     width: 10vw;
     height: 10vw;
     border: 1px solid black;
-    margin-bottom: -1px;
+    margin-top: -1px;
     display: flex;
     justify-content: center;
     align-items: center;
 }
 
 .exprinput {
-    margin-bottom: 1vh;
+    margin-top: 1vh;
     width: 100%;
     font-size: 1.2em;
 }