git.iko.soy/elk
on master help sign in
Centralize compiler error reporting code in Reporting.Error
ab2b2b8Evan Czaplicki
builder/src/Reporting/Exit/Compile.hsdeleted−104
compare with master
unifiedsplit
@@ -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 @@
1module Data.NonEmptyList
1module Data.NonEmptyList
2 ( List(..)
2 ( List(..)
3 , toList
3 , toList
4+ , sortBy
4 )
5 )
5 where
6 where
6
7
7
8
9+import qualified Data.List as List
10+
11+
8
12
9-- LIST
13-- LIST
10
14
@@ -34,3 +38,20 @@ instance Foldable List where
34 foldr step state (List x xs) = step x (foldr step state xs)
38 foldr step state (List x xs) = step x (foldr step state xs)
35 foldl step state (List x xs) = foldl step (step state x) xs
39 foldl step state (List x xs) = foldl step (step state x) xs
36 foldl1 step (List x xs) = foldl step x xs
40 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 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Reporting.Error
3module Reporting.Error
4+ ( Module(..)
4− ( Error(..)
5+ , Error(..)
5− , toReports
6+ , toDoc
7+ , toJson
6 )
8 )
7 where
9 where
8
10
9
11
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
10import qualified Reporting.Error.Canonicalize as Canonicalize
24import qualified Reporting.Error.Canonicalize as Canonicalize
11−import qualified Reporting.Error.Docs as Docs
25+import qualified Reporting.Error.Import as Import
12import qualified Reporting.Error.Main as Main
26import qualified Reporting.Error.Main as Main
13import qualified Reporting.Error.Pattern as Pattern
27import qualified Reporting.Error.Pattern as Pattern
14import qualified Reporting.Error.Syntax as Syntax
28import qualified Reporting.Error.Syntax as Syntax
@@ -19,39 +33,176 @@ import qualified Reporting.Report as Report
19
33
20
34
21
35
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+
22−-- ALL POSSIBLE ERRORS
51+-- ERRORS
23
52
24
53
25data Error
54data Error
26− = Syntax Syntax.Error
55+ = BadSyntax Syntax.Error
27− | Canonicalize Canonicalize.Error
56+ | BadImports (NE.List Import.Error)
28− | Type L.Localizer [Type.Error]
57+ | BadNames (OneOrMore.OneOrMore Canonicalize.Error)
29− | Main L.Localizer Main.Error
58+ | BadTypes (NE.List Type.Error)
30− | Pattern [Pattern.Error]
59+ | BadPatterns (NE.List Pattern.Error)
31− | Docs Docs.Error
60+ | BadMains (OneOrMore.OneOrMore Main.Error)
32
61
33
62
34
63
35-- TO REPORT
64-- TO REPORT
36
65
37
66
38−toReports :: Code.Source -> Error -> [Report.Report]
67+toReports :: L.Localizer -> Code.Source -> Error -> NE.List Report.Report
39−toReports source err =
68+toReports localizer source err =
40 case err of
69 case err of
41− Syntax syntaxError ->
70+ BadSyntax syntaxError ->
42− [Syntax.toReport source 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
43
166
44− Canonicalize canonicalizeError ->
45− [Canonicalize.toReport source canonicalizeError]
46
167
47− Type localizer typeErrors ->
168+toJson :: NE.List Module -> E.Value
48− map (Type.toReport source localizer) typeErrors
169+toJson modules =
170+ E.array (map moduleToJson (NE.toList modules))
49
171
50− Main localizer mainError ->
51− [Main.toReport localizer source mainError]
52
172
53− Pattern patternErrors ->
173+moduleToJson :: Module -> E.Value
54− map (Pattern.toReport source) patternErrors
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+ ]
55
184
56− Docs docsError ->
185+
57− [Docs.toReport source docsError]
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 @@
1{-# LANGUAGE OverloadedStrings #-}
1{-# LANGUAGE OverloadedStrings #-}
2module Reporting.Report
2module Reporting.Report
3 ( Report(..)
3 ( Report(..)
4− , toDoc
5 , toCodeSnippet
4 , toCodeSnippet
6 , toCodePair
5 , toCodePair
7 )
6 )
@@ -26,28 +25,6 @@ data Report =
26 }
25 }
27
26
28
27
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−
51
28
52-- CODE FORMATTING
29-- CODE FORMATTING
53
30