git.iko.soy/elk
on master help sign in
Take first pass at displaying error messages with colors
0ca6864Evan Czaplicki
ui/browser/src/Errors.elm+114−26
compare with master
unifiedsplit
@@ -7,16 +7,16 @@ import Html exposing (..)
7import Html.Attributes exposing (..)
7import Html.Attributes exposing (..)
8import String
8import String
9import Json.Decode as D
9import Json.Decode as D
10+import Elm.Error as Error
10
11
11
12
12
13
13-- MAIN
14-- MAIN
14
15
15
16
16−main : Program D.Value Model ()
17main =
17main =
18 Browser.fullscreen
18 Browser.fullscreen
19− { init = \env -> (D.decodeValue decodeExit env.flags, Cmd.none)
19+ { init = \env -> (D.decodeValue Error.decoder env.flags, Cmd.none)
20 , update = \_ exit -> (exit, Cmd.none)
20 , update = \_ exit -> (exit, Cmd.none)
21 , view = view
21 , view = view
22 , subscriptions = \_ -> Sub.none
22 , subscriptions = \_ -> Sub.none
@@ -25,26 +25,10 @@ main =
25
25
26
26
27
27
28−-- MODEL
29−
30−
31−type alias Model =
32− Result D.Error Exit
33−
34−
35−type alias Exit = ()
36−
37−
38−decodeExit : D.Decoder Exit
39−decodeExit =
40− D.null ()
41−
42−
43−
44-- VIEW
28-- VIEW
45
29
46
30
47−view : Model -> Browser.View msg
31+view : Result D.Error Error.Error -> Browser.View msg
48view result =
32view result =
49 { title = "Problem!"
33 { title = "Problem!"
50 , body =
34 , body =
@@ -52,13 +36,13 @@ view result =
52 Err err ->
36 Err err ->
53 [ text (D.errorToString err) ]
37 [ text (D.errorToString err) ]
54
38
55− Ok exit ->
39+ Ok error ->
56− [ viewExit exit ]
40+ [ viewError error ]
57 }
41 }
58
42
59
43
60−viewExit : Exit -> Html msg
44+viewError : Error.Error -> Html msg
61−viewExit exit =
45+viewError error =
62 div
46 div
63 [ style "width" "100%"
47 [ style "width" "100%"
64 , style "min-height" "100%"
48 , style "min-height" "100%"
@@ -71,10 +55,114 @@ viewExit exit =
71 ]
55 ]
72 [ div
56 [ div
73 [ style "display" "block"
57 [ style "display" "block"
74− , style "white-space" "pre"
58+ , style "white-space" "pre-wrap"
75 , style "background-color" "rgb(39, 40, 34)"
59 , style "background-color" "rgb(39, 40, 34)"
76 , style "padding" "2em"
60 , style "padding" "2em"
77 ]
61 ]
78− [ text "TODO"
62+ (viewErrorHelp error)
79− ]
80 ]
63 ]
64+
65+
66+viewErrorHelp : Error.Error -> List (Html msg)
67+viewErrorHelp error =
68+ case error of
69+ Error.GeneralProblem { path, title, message } ->
70+ [ text title ]
71+
72+ Error.ModuleProblems badModules ->
73+ List.map viewBadModule badModules
74+
75+
76+viewBadModule : Error.BadModule -> Html msg
77+viewBadModule { path, name, problems } =
78+ span [] (List.map (viewProblem path) problems)
79+
80+
81+viewProblem : String -> Error.Problem -> Html msg
82+viewProblem filePath problem =
83+ let
84+ leftover =
85+ 76 - String.length problem.title
86+
87+ header =
88+ "-- " ++ problem.title ++ " " ++ String.padLeft leftover '-' (" " ++ filePath) ++ "\n\n"
89+ in
90+ span []
91+ ( span [ style "color" "cyan" ] [ text header ]
92+ :: viewMessage problem.message
93+ )
94+
95+
96+
97+-- VIEW MESSAGE
98+
99+
100+viewMessage : List Error.Chunk -> List (Html msg)
101+viewMessage chunks =
102+ case chunks of
103+ [] ->
104+ []
105+
106+ chunk :: others ->
107+ let
108+ htmlChunk =
109+ case chunk of
110+ Error.Unstyled string ->
111+ text string
112+
113+ Error.Styled style string ->
114+ span (styleToAttrs style) [ text string ]
115+ in
116+ htmlChunk :: viewMessage others
117+
118+
119+styleToAttrs : Error.Style -> List (Attribute msg)
120+styleToAttrs { bold, underline, color } =
121+ addBold bold <| addUnderline underline <| addColor color []
122+
123+
124+addBold : Bool -> List (Attribute msg) -> List (Attribute msg)
125+addBold bool attrs =
126+ if bool then
127+ style "font-weight" "bold" :: attrs
128+ else
129+ attrs
130+
131+
132+addUnderline : Bool -> List (Attribute msg) -> List (Attribute msg)
133+addUnderline bool attrs =
134+ if bool then
135+ style "text-decoration" "underline" :: attrs
136+ else
137+ attrs
138+
139+
140+addColor : Maybe Error.Color -> List (Attribute msg) -> List (Attribute msg)
141+addColor maybeColor attrs =
142+ case maybeColor of
143+ Nothing ->
144+ attrs
145+
146+ Just color ->
147+ style "color" (colorToCss color) :: attrs
148+
149+
150+colorToCss : Error.Color -> String
151+colorToCss color =
152+ case color of
153+ Error.Red -> "red"
154+ Error.RED -> "red"
155+ Error.Magenta -> "magenta"
156+ Error.MAGENTA -> "magenta"
157+ Error.Yellow -> "yellow"
158+ Error.YELLOW -> "yellow"
159+ Error.Green -> "green"
160+ Error.GREEN -> "green"
161+ Error.Cyan -> "cyan"
162+ Error.CYAN -> "cyan"
163+ Error.Blue -> "blue"
164+ Error.BLUE -> "blue"
165+ Error.White -> "white"
166+ Error.WHITE -> "white"
167+ Error.Black -> "black"
168+ Error.BLACK -> "black"