git.iko.soy/elk
on master help sign in
start generating JSON version of error formatting again
889c405Evan Czaplicki
compiler/src/Reporting/Doc.hs+13−19
compare with master
unifiedsplit
@@ -56,6 +56,7 @@ import qualified Text.PrettyPrint.ANSI.Leijen as P
56import qualified Data.Index as Index
56import qualified Data.Index as Index
57import qualified Elm.Package as Pkg
57import qualified Elm.Package as Pkg
58import qualified Elm.Version as V
58import qualified Elm.Version as V
59+import Json.Encode ((==>))
59import qualified Json.Encode as E
60import qualified Json.Encode as E
60import qualified Json.String as Json
61import qualified Json.String as Json
61
62
@@ -305,10 +306,8 @@ data Color
305 | WHITE
306 | WHITE
306
307
307
308
308−toJsonHelp :: Style -> [a] -> P.SimpleDoc -> [E.Value]
309+toJsonHelp :: Style -> [String] -> P.SimpleDoc -> [E.Value]
309toJsonHelp style revChunks simpleDoc =
310toJsonHelp style revChunks simpleDoc =
310− error "TODO generate json on errors" style revChunks simpleDoc sgrToStyle encodeColor
311−{-
312 case simpleDoc of
311 case simpleDoc of
313 P.SFail ->
312 P.SFail ->
314 error $
313 error $
@@ -319,23 +318,18 @@ toJsonHelp style revChunks simpleDoc =
319 [ encodeChunks style revChunks ]
318 [ encodeChunks style revChunks ]
320
319
321 P.SChar char rest ->
320 P.SChar char rest ->
322− toJsonHelp style (TB.singleton char : revChunks) rest
321+ toJsonHelp style ([char] : revChunks) rest
323
322
324 P.SText _ string rest ->
323 P.SText _ string rest ->
325− toJsonHelp style (TB.fromString string : revChunks) rest
324+ toJsonHelp style (string : revChunks) rest
326
325
327 P.SLine indent rest ->
326 P.SLine indent rest ->
328− toJsonHelp style (spaces indent : "\n" : revChunks) rest
327+ toJsonHelp style (replicate indent ' ' : "\n" : revChunks) rest
329
328
330 P.SSGR sgrs rest ->
329 P.SSGR sgrs rest ->
331 encodeChunks style revChunks : toJsonHelp (sgrToStyle sgrs style) [] rest
330 encodeChunks style revChunks : toJsonHelp (sgrToStyle sgrs style) [] rest
332
331
333
332
334−spaces :: Int -> TB.Builder
335−spaces n =
336− TB.fromText (Text.replicate n " ")
337−-}
338−
339sgrToStyle :: [Ansi.SGR] -> Style -> Style
333sgrToStyle :: [Ansi.SGR] -> Style -> Style
340sgrToStyle sgrs style@(Style bold underline color) =
334sgrToStyle sgrs style@(Style bold underline color) =
341 case sgrs of
335 case sgrs of
@@ -396,11 +390,11 @@ toColor layer intensity color =
396 Ansi.White -> pick White WHITE
390 Ansi.White -> pick White WHITE
397 Ansi.Black -> pick Black BLACK
391 Ansi.Black -> pick Black BLACK
398
392
399−{-
393+
400−encodeChunks :: Style -> [TB.Builder] -> E.Value
394+encodeChunks :: Style -> [String] -> E.Value
401encodeChunks (Style bold underline color) revChunks =
395encodeChunks (Style bold underline color) revChunks =
402 let
396 let
403− !str = Utf8.concat (reverse revChunks)
397+ str = Json.fromChars (concat (reverse revChunks))
404 in
398 in
405 case color of
399 case color of
406 Nothing | not bold && not underline ->
400 Nothing | not bold && not underline ->
@@ -408,12 +402,12 @@ encodeChunks (Style bold underline color) revChunks =
408
402
409 _ ->
403 _ ->
410 E.object
404 E.object
411− [ ("bold", E.bool bold)
405+ [ "bold" ==> E.bool bold
412− , ("underline", E.bool underline)
406+ , "underline" ==> E.bool underline
413− , ("color", maybe E.null encodeColor color)
407+ , "color" ==> maybe E.null encodeColor color
414− , ("string", E.string str)
408+ , "string" ==> E.string str
415 ]
409 ]
416−-}
410+
417
411
418encodeColor :: Color -> E.Value
412encodeColor :: Color -> E.Value
419encodeColor color =
413encodeColor color =