Add error reporting.

index.html

@@ -21,7 +21,7 @@ define nix(x, y, width, height) {
     call line (x, y, x + width, y + height);
     call line (x + width, y, x, y + height);
 };
-call nix(0, 0, 5, 10);
+call nix(0, 0, 20, 20);
 `
             var container = document.getElementById("elm-container");
             var app = Elm.Main.init({

minilogo.scss

@@ -31,8 +31,22 @@ textarea {
     font-family: "Source Code Pro", monospace;
 }
 
-textarea, canvas {
+.centered {
+    max-width: 500px;
     display: block;
     margin: auto;
+}
+
+.shadow {
     box-shadow: $default-shadow;
 }
+
+.error {
+    padding: 10px;
+    color: white;
+    background-color: tomato;
+    border-radius: 2px;
+    box-sizing: border-box;
+    margin-top: 10px;
+    margin-bottom: 10px;
+}

src/Main.elm

@@ -1,10 +1,10 @@
-import Html exposing (Html, div, text, textarea, h1, h2)
+import Html exposing (Html, div, text, textarea, h1, h2, p)
-import Html.Attributes exposing (class)
+import Html.Attributes exposing (class, classList)
 import Html.Events exposing (onInput)
 import Browser exposing (element)
 import Canvas exposing (Shape)
 import Dict exposing (Dict)
-import Parser exposing (Parser, (|.), (|=), variable, succeed, symbol, int, spaces, map, oneOf, lazy, sequence, Trailing(..), keyword, run, backtrackable)
+import Parser exposing (Parser, Problem(..), DeadEnd, (|.), (|=), variable, succeed, symbol, int, spaces, map, oneOf, lazy, sequence, Trailing(..), keyword, run, backtrackable)
 import Color
 import Canvas exposing (Point, path, lineTo, circle, shapes, stroke, lineWidth, fill, rect)
 import Set
@@ -36,6 +36,7 @@ type alias State =
     { penMode : LogoPenMode
     , pos : Coord
     , scope : Scope
+    , board : Board
     }
 
 type alias Step a = State -> Result String (a, State)
@@ -195,6 +196,7 @@ initialState =
     { penMode = Up
     , pos = (0, 0)
     , scope = initialScope
+    , board = []
     }
 
 unit : a -> Step a
@@ -208,14 +210,14 @@ bind sa f state = case sa state of
 rbind : (a -> Step b) -> Step a -> Step b
 rbind f sa = bind sa f
 
-updatePosition : Coord -> Board -> Step Board
+updatePosition : Coord -> Step ()
-updatePosition c b state =
+updatePosition c state =
     let
         newBoard = case state.penMode of
-            Up -> b
+            Up -> state.board
-            Down -> (state.pos, c)::b
+            Down -> (state.pos, c)::state.board
     in
-        Ok (newBoard, { state | pos = c })
+        Ok ((), { state | pos = c, board = newBoard })
 
 registerFunction : String -> Function -> Step ()
 registerFunction s f state = Ok ((), { state | scope = setScopeFunction s f state.scope })
@@ -265,21 +267,20 @@ zip la lb = case (la, lb) of
     (a::lat, b::lbt) -> (a, b)::zip lat lbt
     _ -> []
 
-evaluateCmd : LogoCmd -> Board -> Step Board
+evaluateCmd : LogoCmd -> Step ()
-evaluateCmd c b = case c of
+evaluateCmd c = case c of
-    Move l r -> evaluateExp l |> rbind (\x -> evaluateExp r |> rbind (\y -> updatePosition (x, y) b))
+    Move l r -> evaluateExp l |> rbind (\x -> evaluateExp r |> rbind (\y -> updatePosition (x, y)))
-    Define n xs prg -> registerFunction n (xs, prg) |> rbind (\_ -> unit b)
+    Define n xs prg -> registerFunction n (xs, prg)
-    Pen mode -> setPenMode mode |> rbind (\_ -> unit b)
+    Pen mode -> setPenMode mode
     Call n args -> lookupFunction n
         |> rbind (\(ns, prg) -> evaluateAllExps args
         |> rbind (\vs -> upScope
         |> rbind (\_ -> registerAllVariables (zip ns vs)
-        |> rbind (\_ -> evaluateAll prg b
+        |> rbind (\_ -> evaluateAll prg
-        |> rbind (\nb -> downScope
+        |> rbind (\_ -> downScope)))))
-        |> rbind (\_ -> unit nb))))))
 
-evaluateAll : LogoProg -> Board -> Step Board
+evaluateAll : LogoProg -> Step ()
-evaluateAll prg board = List.foldl rbind (unit board) <| List.map evaluateCmd prg
+evaluateAll prg = List.foldl rbind (unit ()) <| List.map (\c _ -> evaluateCmd c) prg
 
 {-
 ======= Drawing Stuff =====
@@ -293,15 +294,45 @@ lineShape (c1, c2) = path (transformCoord c1) [ lineTo (transformCoord c2) ]
 pointerShape : Coord -> Shape
 pointerShape c = circle (transformCoord c) 5
 
-allShapes : (Board, State) -> List Shape
+allShapes : State -> List Shape
-allShapes (b, s) = pointerShape s.pos :: List.map lineShape b
+allShapes s = pointerShape s.pos :: List.map lineShape s.board
 
-canvas : (Board, State) -> Html Msg
+canvas : State -> Html Msg
-canvas dat = Canvas.toHtml (500, 500) []
+canvas state = Canvas.toHtml (500, 500) [ classList [ ("centered", True), ("shadow", True) ] ]
     [ shapes [ fill Color.white ] [ rect (0, 0) 500 500 ]
-    , shapes [ stroke Color.blue, lineWidth 5] (allShapes dat)
+    , shapes [ stroke Color.blue, lineWidth 5] (allShapes state)
     ]
 
+{-
+===== Rendering Stuff
+-}
+
+humanProblemString : Problem -> String
+humanProblemString p = case p of
+    Expecting s -> "Expecting " ++ s
+    ExpectingInt -> "Expecting decimal integer"
+    ExpectingHex -> "Expecting hexadecimal integer"
+    ExpectingOctal -> "Expecting octal integer"
+    ExpectingBinary -> "Expecting binary integer"
+    ExpectingFloat -> "Expecting a floating pointer number"
+    ExpectingNumber -> "Expecting a number"
+    ExpectingVariable -> "Expected variable name"
+    ExpectingSymbol s -> "Expected symbol \"" ++ s ++ "\""
+    ExpectingKeyword s -> "Expecting keyword " ++ s
+    ExpectingEnd -> "Expecting end of string"
+    UnexpectedChar -> "Unexpected character"
+    Problem s -> s
+    BadRepeat -> "Bad repetition"
+
+humanDeadEndString : DeadEnd -> String
+humanDeadEndString { row, col, problem } =
+    "An parse error occured on line "
+        ++ String.fromInt row
+        ++ ": " ++ humanProblemString problem
+
+humanParseError : List DeadEnd -> String
+humanParseError = Maybe.withDefault "" << Maybe.map humanDeadEndString << List.head
+
 {-
 ======= Elm Architecture =======
 -}
@@ -319,15 +350,22 @@ init fs =
 view : Model -> Html Msg
 view m = 
     let 
-        dat = Result.withDefault ([], initialState)
+        evalResult = Result.map (\(_, s) -> s)
-            <| Result.withDefault (Err "Couldn't parse program")
+            <| Result.andThen (\prg -> evaluateAll prg initialState)
-            <| Result.map (\prg -> evaluateAll prg [] initialState) (run parseProg m.programText)
+            <| Result.mapError humanParseError (run parseProg m.programText)
+        toRender = Result.withDefault initialState evalResult
+        error = case evalResult of
+            Err e -> [ p [ classList [ ("centered", True), ("error", True), ("shadow", True) ] ] [ text e ] ]
+            Ok _ -> []
     in
         div []
             [ h1 [] [ text "MiniLogo Functional Evaluator" ]
             , div [ class "logo-container" ]
-                [ div [ class "logo-pane" ] [ h2 [] [ text "MiniLogo" ], textarea [ onInput UpdateText ] [ text m.programText ] ]
+                [ div [ class "logo-pane" ] <|
-                , div [ class "logo-pane" ] [ h2 [] [ text "Output" ], canvas dat ]
+                    [ h2 [] [ text "MiniLogo" ]
+                    , textarea [ onInput UpdateText, classList [ ("centered", True), ("shadow", True) ] ] [ text m.programText ]
+                    ] ++ error
+                , div [ class "logo-pane" ] [ h2 [] [ text "Output" ], canvas toRender ]
                 ]
             ]