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, 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({
|
||||||
|
@ -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;
|
||||||
|
}
|
||||||
|
94
src/Main.elm
94
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 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 ]
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user