Add error reporting.

This commit is contained in:
Danila Fedorin 2019-02-02 15:23:23 -08:00
parent acab437f6e
commit 05ce812ff1
3 changed files with 82 additions and 30 deletions

View File

@ -21,7 +21,7 @@ define nix(x, y, width, height) {
call line (x, y, x + width, y + height); call line (x, y, x + width, y + height);
call line (x + width, y, x, 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 container = document.getElementById("elm-container");
var app = Elm.Main.init({ var app = Elm.Main.init({

View File

@ -31,8 +31,22 @@ textarea {
font-family: "Source Code Pro", monospace; font-family: "Source Code Pro", monospace;
} }
textarea, canvas { .centered {
max-width: 500px;
display: block; display: block;
margin: auto; margin: auto;
}
.shadow {
box-shadow: $default-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;
}

View File

@ -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 Html.Events exposing (onInput)
import Browser exposing (element) import Browser exposing (element)
import Canvas exposing (Shape) import Canvas exposing (Shape)
import Dict exposing (Dict) 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 Color
import Canvas exposing (Point, path, lineTo, circle, shapes, stroke, lineWidth, fill, rect) import Canvas exposing (Point, path, lineTo, circle, shapes, stroke, lineWidth, fill, rect)
import Set import Set
@ -36,6 +36,7 @@ type alias State =
{ penMode : LogoPenMode { penMode : LogoPenMode
, pos : Coord , pos : Coord
, scope : Scope , scope : Scope
, board : Board
} }
type alias Step a = State -> Result String (a, State) type alias Step a = State -> Result String (a, State)
@ -195,6 +196,7 @@ initialState =
{ penMode = Up { penMode = Up
, pos = (0, 0) , pos = (0, 0)
, scope = initialScope , scope = initialScope
, board = []
} }
unit : a -> Step a 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 : (a -> Step b) -> Step a -> Step b
rbind f sa = bind sa f rbind f sa = bind sa f
updatePosition : Coord -> Board -> Step Board updatePosition : Coord -> Step ()
updatePosition c b state = updatePosition c state =
let let
newBoard = case state.penMode of newBoard = case state.penMode of
Up -> b Up -> state.board
Down -> (state.pos, c)::b Down -> (state.pos, c)::state.board
in in
Ok (newBoard, { state | pos = c }) Ok ((), { state | pos = c, board = newBoard })
registerFunction : String -> Function -> Step () registerFunction : String -> Function -> Step ()
registerFunction s f state = Ok ((), { state | scope = setScopeFunction s f state.scope }) 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 (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 Call n args -> lookupFunction n
|> rbind (\(ns, prg) -> evaluateAllExps args |> rbind (\(ns, prg) -> evaluateAllExps args
|> rbind (\vs -> upScope |> rbind (\vs -> upScope
|> rbind (\_ -> registerAllVariables (zip ns vs) |> 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 ===== ======= Drawing Stuff =====
@ -293,15 +294,45 @@ lineShape (c1, c2) = path (transformCoord c1) [ lineTo (transformCoord c2) ]
pointerShape : Coord -> Shape pointerShape : Coord -> Shape
pointerShape c = circle (transformCoord c) 5 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 [ 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 ======= ======= Elm Architecture =======
-} -}
@ -319,15 +350,22 @@ init fs =
view : Model -> Html Msg view : Model -> Html Msg
view m = view m =
let 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 in
div [] div []
[ h1 [] [ text "MiniLogo Functional Evaluator" ] [ h1 [] [ text "MiniLogo Functional Evaluator" ]
, div [ class "logo-container" ] , 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 ]
] ]
] ]