git.iko.soy/elk
on 075be13 help sign in
elk/compiler/src/Reporting/Error.hs
204 lines 4.7 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Reporting.Error
4 ( Module(..)
5 , Error(..)
6 , toDoc
7 , toJson
8 )
9 where
12import qualified Data.ByteString as B
13import qualified Data.Name as Name
14import qualified Data.NonEmptyList as NE
15import qualified Data.OneOrMore as OneOrMore
16import qualified Data.Utf8 as Utf8
18import qualified Elm.ModuleName as ModuleName
19import qualified File
20import qualified Json.Encode as E
21import Json.Encode ((==>))
22import qualified Reporting.Annotation as A
23import qualified Reporting.Doc as D
24import qualified Reporting.Error.Canonicalize as Canonicalize
25import qualified Reporting.Error.Import as Import
26import qualified Reporting.Error.Main as Main
27import qualified Reporting.Error.Pattern as Pattern
28import qualified Reporting.Error.Syntax as Syntax
29import qualified Reporting.Error.Type as Type
30import qualified Reporting.Render.Code as Code
31import qualified Reporting.Render.Type.Localizer as L
32import qualified Reporting.Report as Report
36-- MODULE
39data Module =
40 Module
41 { _name :: ModuleName.Raw
42 , _path :: FilePath
43 , _time :: File.Time
44 , _source :: B.ByteString
45 , _error :: Error
46 }
50-- ERRORS
53data Error
54 = BadSyntax Syntax.Error
55 | BadImports (NE.List Import.Error)
56 | BadNames (OneOrMore.OneOrMore Canonicalize.Error)
57 | BadTypes L.Localizer (NE.List Type.Error)
58 | BadMains L.Localizer (OneOrMore.OneOrMore Main.Error)
59 | BadPatterns (NE.List Pattern.Error)
63-- TO REPORT
66toReports :: Code.Source -> Error -> NE.List Report.Report
67toReports source err =
68 case err of
69 BadSyntax syntaxError ->
70 NE.List (Syntax.toReport source syntaxError) []
72 BadImports errs ->
73 fmap (Import.toReport source) errs
75 BadNames errs ->
76 fmap (Canonicalize.toReport source) (OneOrMore.destruct NE.List errs)
78 BadTypes localizer errs ->
79 fmap (Type.toReport source localizer) errs
81 BadMains localizer errs ->
82 fmap (Main.toReport localizer source) (OneOrMore.destruct NE.List errs)
84 BadPatterns errs ->
85 fmap (Pattern.toReport source) errs
89-- TO DOC
92toDoc :: Module -> [Module] -> D.Doc
93toDoc err errs =
94 let
95 timeCompare m1 m2 = compare (_time m1) (_time m2)
96 (NE.List m ms) = NE.sortBy timeCompare (NE.List err errs)
97 in
98 D.vcat (toDocHelp m ms)
101toDocHelp :: Module -> [Module] -> [D.Doc]
102toDocHelp module1 modules =
103 case modules of
104 [] ->
105 [moduleToDoc module1
106 ,""
107 ]
109 module2 : otherModules ->
110 moduleToDoc module1
111 : toSeparator module1 module2
112 : toDocHelp module2 otherModules
115toSeparator :: Module -> Module -> D.Doc
116toSeparator beforeModule afterModule =
117 let
118 before = ModuleName.toChars (_name beforeModule) ++ " ↑ "
119 after = " ↓ " ++ ModuleName.toChars (_name afterModule)
120 in
121 D.dullred $ D.vcat $
122 [ D.indent (80 - length before) (D.fromChars before)
123 , "====o======================================================================o===="
124 , D.fromChars after
125 , ""
126 , ""
127 ]
131-- MODULE TO DOC
134moduleToDoc :: Module -> D.Doc
135moduleToDoc (Module _ path _ source err) =
136 let
137 reports =
138 toReports (Code.toSource source) err
139 in
140 D.vcat $ map (reportToDoc path) (NE.toList reports)
143reportToDoc :: FilePath -> Report.Report -> D.Doc
144reportToDoc path (Report.Report title _ _ message) =
145 D.vcat
146 [ toMessageBar title path
147 , ""
148 , message
149 , ""
150 ]
153toMessageBar :: String -> FilePath -> D.Doc
154toMessageBar title filePath =
155 let
156 usedSpace =
157 4 + length title + 1 + length filePath
158 in
159 D.dullcyan $ D.fromChars $
160 "-- " ++ title
161 ++ " " ++ replicate (max 1 (80 - usedSpace)) '-'
162 ++ " " ++ filePath
166-- TO JSON
169toJson :: Module -> E.Value
170toJson (Module name path _ source err) =
171 let
172 reports =
173 toReports (Code.toSource source) err
174 in
175 E.object
176 [ "path" ==> E.string (Utf8.fromChars path)
177 , "name" ==> E.string (Name.toUtf8 name)
178 , "problems" ==> E.array (map reportToJson (NE.toList reports))
179 ]
182reportToJson :: Report.Report -> E.Value
183reportToJson (Report.Report title region _sgstns message) =
184 E.object
185 [ "title" ==> E.string (Utf8.fromChars title)
186 , "region" ==> encodeRegion region
187 , "message" ==> D.encode message
188 ]
191encodeRegion :: A.Region -> E.Value
192encodeRegion (A.Region (A.Position sr sc) (A.Position er ec)) =
193 E.object
194 [ "start" ==>
195 E.object
196 [ ("line", E.int (fromIntegral sr))
197 , ("column", E.int (fromIntegral sc))
198 ]
199 , "end" ==>
200 E.object
201 [ ("line", E.int (fromIntegral er))
202 , ("column", E.int (fromIntegral ec))
203 ]
204 ]