From 05ce812ff141de46f2556dd9c22d93c03d55514b Mon Sep 17 00:00:00 2001 From: Danila Fedorin Date: Sat, 2 Feb 2019 15:23:23 -0800 Subject: [PATCH] Add error reporting. --- index.html | 2 +- minilogo.scss | 16 ++++++++- src/Main.elm | 94 ++++++++++++++++++++++++++++++++++++--------------- 3 files changed, 82 insertions(+), 30 deletions(-) diff --git a/index.html b/index.html index cbbd272..dbf6964 100644 --- a/index.html +++ b/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({ diff --git a/minilogo.scss b/minilogo.scss index c958757..eeee771 100644 --- a/minilogo.scss +++ b/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; +} diff --git a/src/Main.elm b/src/Main.elm index 0fcda08..f1d45df 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -1,10 +1,10 @@ -import Html exposing (Html, div, text, textarea, h1, h2) -import Html.Attributes exposing (class) +import Html exposing (Html, div, text, textarea, h1, h2, p) +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 c b state = +updatePosition : Coord -> Step () +updatePosition c state = let newBoard = case state.penMode of - Up -> b - Down -> (state.pos, c)::b + Up -> state.board + 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 c b = case c of - Move l r -> evaluateExp l |> rbind (\x -> evaluateExp r |> rbind (\y -> updatePosition (x, y) b)) - Define n xs prg -> registerFunction n (xs, prg) |> rbind (\_ -> unit b) - Pen mode -> setPenMode mode |> rbind (\_ -> unit b) +evaluateCmd : LogoCmd -> Step () +evaluateCmd c = case c of + Move l r -> evaluateExp l |> rbind (\x -> evaluateExp r |> rbind (\y -> updatePosition (x, y))) + Define n xs prg -> registerFunction n (xs, prg) + 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 (\nb -> downScope - |> rbind (\_ -> unit nb)))))) + |> rbind (\_ -> evaluateAll prg + |> rbind (\_ -> downScope))))) -evaluateAll : LogoProg -> Board -> Step Board -evaluateAll prg board = List.foldl rbind (unit board) <| List.map evaluateCmd prg +evaluateAll : LogoProg -> Step () +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 (b, s) = pointerShape s.pos :: List.map lineShape b +allShapes : State -> List Shape +allShapes s = pointerShape s.pos :: List.map lineShape s.board -canvas : (Board, State) -> Html Msg -canvas dat = Canvas.toHtml (500, 500) [] +canvas : State -> Html Msg +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) - <| Result.withDefault (Err "Couldn't parse program") - <| Result.map (\prg -> evaluateAll prg [] initialState) (run parseProg m.programText) + evalResult = Result.map (\(_, s) -> s) + <| Result.andThen (\prg -> evaluateAll prg initialState) + <| 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" ] [ h2 [] [ text "Output" ], canvas dat ] + [ div [ class "logo-pane" ] <| + [ h2 [] [ text "MiniLogo" ] + , textarea [ onInput UpdateText, classList [ ("centered", True), ("shadow", True) ] ] [ text m.programText ] + ] ++ error + , div [ class "logo-pane" ] [ h2 [] [ text "Output" ], canvas toRender ] ] ]