Add error reporting.
This commit is contained in:
parent
acab437f6e
commit
05ce812ff1
|
@ -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({
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
|
94
src/Main.elm
94
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 ]
|
||||
]
|
||||
]
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user