git.iko.soy/elk
on master help sign in
Centralize compiler error reporting code in Reporting.Error

This means getting rid of Reporting.Exit.Compile by moving its contents to Reporting.Error (and partly to NonEmptyList.sortBy) This also means moving some of the logic for turning Reports into Docs into Reporting.Error. Now all that logic is in one place, making it easier to make sure the newlines work out correctly.

commitab2b2b8c83a4f5ae9315406e4a8089a953ec6945 authorEvan Czaplicki <evancz@users.noreply.github.com> dateTue 30 Apr 2019, 18:27 (8 years ago) parent0d5d9f4
4 files changed+196−151
compare with master
unifiedsplit
builder/src/Reporting/Exit/Compile.hs−104 compiler/src/Data/NonEmptyList.hs+21 compiler/src/Reporting/Error.hs+175−24 compiler/src/Reporting/Report.hs−23
builder/src/Reporting/Exit/Compile.hsdeleted−104
@@ -1,104 +0,0 @@
1−{-# OPTIONS_GHC -Wall #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−module Reporting.Exit.Compile
4− ( Exit(..)
5− , toJson
6− , toDoc
7− )
8− where
9−
10−
11−import qualified Data.List as List
12−import qualified Data.Time.Clock as Time
13−
14−import qualified Elm.Compiler as Compiler
15−import qualified Elm.ModuleName as ModuleName
16−import qualified Json.Encode as Encode
17−import qualified Reporting.Doc as D
18−
19−
20−
21−-- EXITS
22−
23−
24−data Exit =
25− Exit
26− { _name :: ModuleName.Raw
27− , _path :: FilePath
28− , _time :: Time.UTCTime
29− , _source :: String
30− , _errors :: [Compiler.Error]
31− }
32−
33−
34−
35−-- TO JSON
36−
37−
38−toJson :: Exit -> Encode.Value
39−toJson (Exit name path _ source errors) =
40− Compiler.errorsToJson name path source errors
41−
42−
43−
44−-- TO DOC
45−
46−
47−toDoc :: Exit -> [Exit] -> D.Doc
48−toDoc e es =
49− let
50− (exit, exits) = sortByTime e es
51− in
52− D.vcat (toDocHelp exit exits)
53−
54−
55−toDocHelp :: Exit -> [Exit] -> [D.Doc]
56−toDocHelp e1 exits =
57− case exits of
58− [] ->
59− [exitToDoc e1]
60−
61− e2 : otherErrors ->
62− exitToDoc e1 : separator (_name e1) (_name e2) : toDocHelp e2 otherErrors
63−
64−
65−exitToDoc :: Exit -> D.Doc
66−exitToDoc (Exit _name path _time source errors) =
67− Compiler.errorsToDoc path source errors
68−
69−
70−separator :: ModuleName.Raw -> ModuleName.Raw -> D.Doc
71−separator beforeName afterName =
72− let
73− before = ModuleName.nameToChars beforeName ++ " ↑ "
74− after = " ↓ " ++ ModuleName.nameToChars afterName
75− in
76− D.dullred $ D.vcat $
77− [ D.indent (80 - length before) (D.fromChars before)
78− , "====o======================================================================o===="
79− , D.fromChars after
80− , D.empty
81− , D.empty
82− ]
83−
84−
85−
86−-- SORT BY TIME
87−
88−
89−sortByTime :: Exit -> [Exit] -> (Exit, [Exit])
90−sortByTime exit exits =
91− case List.sortBy timeCompare exits of
92− [] ->
93− (exit, [])
94−
95− e:es ->
96− if _time exit < _time e then
97− (exit, e:es)
98− else
99− (e, List.insertBy timeCompare exit es)
100−
101−
102−timeCompare :: Exit -> Exit -> Ordering
103−timeCompare e1 e2 =
104− compare (_time e1) (_time e2)
compiler/src/Data/NonEmptyList.hs+21
@@ -1,10 +1,14 @@
11module Data.NonEmptyList
22 ( List(..)
33 , toList
4+ , sortBy
45 )
56 where
67
78
9+import qualified Data.List as List
10+
11+
812
913-- LIST
1014
@@ -34,3 +38,20 @@ instance Foldable List where
3438 foldr step state (List x xs) = step x (foldr step state xs)
3539 foldl step state (List x xs) = foldl step (step state x) xs
3640 foldl1 step (List x xs) = foldl step x xs
41+
42+
43+
44+-- SORT BY
45+
46+
47+sortBy :: (a -> a -> Ordering) -> List a -> List a
48+sortBy comparison (List x xs) =
49+ case List.sortBy comparison xs of
50+ [] ->
51+ List x []
52+
53+ y:ys ->
54+ case comparison x y of
55+ LT -> List x (y:ys)
56+ EQ -> List x (y:ys)
57+ GT -> List y (List.insertBy comparison x ys)
compiler/src/Reporting/Error.hs+175−24
@@ -1,14 +1,28 @@
11{-# OPTIONS_GHC -Wall #-}
22{-# LANGUAGE OverloadedStrings #-}
33module Reporting.Error
4− ( Error(..)
5− , toReports
4+ ( Module(..)
5+ , Error(..)
6+ , toDoc
7+ , toJson
68 )
79 where
810
911
12+import qualified Data.ByteString as B
13+import qualified Data.Name as Name
14+import qualified Data.NonEmptyList as NE
15+import qualified Data.OneOrMore as OneOrMore
16+import qualified Data.Utf8 as Utf8
17+
18+import qualified Elm.ModuleName as ModuleName
19+import qualified File
20+import qualified Json.Encode as E
21+import Json.Encode ((==>))
22+import qualified Reporting.Annotation as A
23+import qualified Reporting.Doc as D
1024import qualified Reporting.Error.Canonicalize as Canonicalize
11−import qualified Reporting.Error.Docs as Docs
25+import qualified Reporting.Error.Import as Import
1226import qualified Reporting.Error.Main as Main
1327import qualified Reporting.Error.Pattern as Pattern
1428import qualified Reporting.Error.Syntax as Syntax
@@ -19,39 +33,176 @@ import qualified Reporting.Report as Report
1933
2034
2135
22−-- ALL POSSIBLE ERRORS
36+-- MODULE
37+
38+
39+data Module =
40+ Module
41+ { _name :: ModuleName.Raw
42+ , _path :: FilePath
43+ , _time :: File.Time
44+ , _source :: B.ByteString
45+ , _error :: Error
46+ , _localizer :: L.Localizer
47+ }
48+
49+
50+
51+-- ERRORS
2352
2453
2554data Error
26− = Syntax Syntax.Error
27− | Canonicalize Canonicalize.Error
28− | Type L.Localizer [Type.Error]
29− | Main L.Localizer Main.Error
30− | Pattern [Pattern.Error]
31− | Docs Docs.Error
55+ = BadSyntax Syntax.Error
56+ | BadImports (NE.List Import.Error)
57+ | BadNames (OneOrMore.OneOrMore Canonicalize.Error)
58+ | BadTypes (NE.List Type.Error)
59+ | BadPatterns (NE.List Pattern.Error)
60+ | BadMains (OneOrMore.OneOrMore Main.Error)
3261
3362
3463
3564-- TO REPORT
3665
3766
38−toReports :: Code.Source -> Error -> [Report.Report]
39−toReports source err =
67+toReports :: L.Localizer -> Code.Source -> Error -> NE.List Report.Report
68+toReports localizer source err =
4069 case err of
41− Syntax syntaxError ->
42− [Syntax.toReport source syntaxError]
70+ BadSyntax syntaxError ->
71+ NE.List (Syntax.toReport source syntaxError) []
72+
73+ BadImports errs ->
74+ fmap Import.toReport errs
75+
76+ BadNames errs ->
77+ fmap (Canonicalize.toReport source) (OneOrMore.destruct NE.List errs)
78+
79+ BadTypes errs ->
80+ fmap (Type.toReport source localizer) errs
81+
82+ BadPatterns errs ->
83+ fmap (Pattern.toReport source) errs
84+
85+ BadMains errs ->
86+ fmap (Main.toReport localizer source) (OneOrMore.destruct NE.List errs)
87+
88+
89+
90+-- TO DOC
91+
92+
93+toDoc :: NE.List Module -> D.Doc
94+toDoc modules =
95+ let
96+ timeCompare m1 m2 = compare (_time m1) (_time m2)
97+ (NE.List m ms) = NE.sortBy timeCompare modules
98+ in
99+ D.vcat (toDocHelp m ms)
100+
101+
102+toDocHelp :: Module -> [Module] -> [D.Doc]
103+toDocHelp module1 modules =
104+ case modules of
105+ [] ->
106+ [moduleToDoc module1]
107+
108+ module2 : otherModules ->
109+ moduleToDoc module1
110+ : toSeparator module1 module2
111+ : toDocHelp module2 otherModules
112+
113+
114+toSeparator :: Module -> Module -> D.Doc
115+toSeparator beforeModule afterModule =
116+ let
117+ before = ModuleName.toChars (_name beforeModule) ++ " ↑ "
118+ after = " ↓ " ++ ModuleName.toChars (_name afterModule)
119+ in
120+ D.dullred $ D.vcat $
121+ [ D.indent (80 - length before) (D.fromChars before)
122+ , "====o======================================================================o===="
123+ , D.fromChars after
124+ , ""
125+ , ""
126+ ]
127+
128+
129+
130+-- MODULE TO DOC
131+
132+
133+moduleToDoc :: Module -> D.Doc
134+moduleToDoc (Module _ path _ source err localizer) =
135+ let
136+ reports =
137+ toReports localizer (Code.toSource source) err
138+ in
139+ D.vcat $ map (reportToDoc path) (NE.toList reports)
140+
141+
142+reportToDoc :: FilePath -> Report.Report -> D.Doc
143+reportToDoc path (Report.Report title _ _ message) =
144+ D.vcat
145+ [ toMessageBar title path
146+ , ""
147+ , message
148+ , ""
149+ ]
150+
151+
152+toMessageBar :: String -> FilePath -> D.Doc
153+toMessageBar title filePath =
154+ let
155+ usedSpace =
156+ 4 + length title + 1 + length filePath
157+ in
158+ D.dullcyan $ D.fromChars $
159+ "-- " ++ title
160+ ++ " " ++ replicate (max 1 (80 - usedSpace)) '-'
161+ ++ " " ++ filePath
162+
163+
164+
165+-- TO JSON
43166
44− Canonicalize canonicalizeError ->
45− [Canonicalize.toReport source canonicalizeError]
46167
47− Type localizer typeErrors ->
48− map (Type.toReport source localizer) typeErrors
168+toJson :: NE.List Module -> E.Value
169+toJson modules =
170+ E.array (map moduleToJson (NE.toList modules))
49171
50− Main localizer mainError ->
51− [Main.toReport localizer source mainError]
52172
53− Pattern patternErrors ->
54− map (Pattern.toReport source) patternErrors
173+moduleToJson :: Module -> E.Value
174+moduleToJson (Module name path _ source err localizer) =
175+ let
176+ reports =
177+ toReports localizer (Code.toSource source) err
178+ in
179+ E.object
180+ [ "path" ==> E.string (Utf8.fromChars path)
181+ , "name" ==> E.string (Name.toUtf8 name)
182+ , "problems" ==> E.array (map reportToJson (NE.toList reports))
183+ ]
55184
56− Docs docsError ->
57− [Docs.toReport source docsError]
185+
186+reportToJson :: Report.Report -> E.Value
187+reportToJson (Report.Report title region _sgstns message) =
188+ E.object
189+ [ "title" ==> E.string (Utf8.fromChars title)
190+ , "region" ==> encodeRegion region
191+ , "message" ==> D.encode message
192+ ]
193+
194+
195+encodeRegion :: A.Region -> E.Value
196+encodeRegion (A.Region (A.Position sr sc) (A.Position er ec)) =
197+ E.object
198+ [ "start" ==>
199+ E.object
200+ [ ("line", E.int (fromIntegral sr))
201+ , ("column", E.int (fromIntegral sc))
202+ ]
203+ , "end" ==>
204+ E.object
205+ [ ("line", E.int (fromIntegral er))
206+ , ("column", E.int (fromIntegral ec))
207+ ]
208+ ]
compiler/src/Reporting/Report.hs−23
@@ -1,7 +1,6 @@
11{-# LANGUAGE OverloadedStrings #-}
22module Reporting.Report
33 ( Report(..)
4− , toDoc
54 , toCodeSnippet
65 , toCodePair
76 )
@@ -26,28 +25,6 @@ data Report =
2625 }
2726
2827
29−toDoc :: FilePath -> Report -> D.Doc
30−toDoc filePath (Report title _ _ message) =
31− D.vcat
32− [ messageBar title filePath
33− , ""
34− , message
35− , ""
36− ]
37−
38−
39−messageBar :: String -> FilePath -> D.Doc
40−messageBar title filePath =
41− let
42− usedSpace =
43− 4 + length title + 1 + length filePath
44− in
45− D.dullcyan $ D.fromChars $
46− "-- " ++ title
47− ++ " " ++ replicate (max 1 (80 - usedSpace)) '-'
48− ++ " " ++ filePath
49−
50−
5128
5229-- CODE FORMATTING
5330