git.iko.soy/elk
on adfbebf help sign in
elk/compiler/src/Reporting/Error.hs
206 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.NonEmptyList as NE
14import qualified Data.OneOrMore as OneOrMore
16import qualified Elm.ModuleName as ModuleName
17import qualified File
18import qualified Json.Encode as E
19import Json.Encode ((==>))
20import qualified Reporting.Annotation as A
21import qualified Reporting.Doc as D
22import qualified Reporting.Error.Canonicalize as Canonicalize
23import qualified Reporting.Error.Docs as Docs
24import qualified Reporting.Error.Import as Import
25import qualified Reporting.Error.Main as Main
26import qualified Reporting.Error.Pattern as Pattern
27import qualified Reporting.Error.Syntax as Syntax
28import qualified Reporting.Error.Type as Type
29import qualified Reporting.Render.Code as Code
30import qualified Reporting.Render.Type.Localizer as L
31import qualified Reporting.Report as Report
35-- MODULE
38data Module =
39 Module
40 { _name :: ModuleName.Raw
41 , _path :: FilePath
42 , _time :: File.Time
43 , _source :: B.ByteString
44 , _error :: Error
45 }
49-- ERRORS
52data Error
53 = BadSyntax Syntax.Error
54 | BadImports (NE.List Import.Error)
55 | BadNames (OneOrMore.OneOrMore Canonicalize.Error)
56 | BadTypes L.Localizer (NE.List Type.Error)
57 | BadMains L.Localizer (OneOrMore.OneOrMore Main.Error)
58 | BadPatterns (NE.List Pattern.Error)
59 | BadDocs Docs.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
87 BadDocs docsErr ->
88 Docs.toReports source docsErr
92-- TO DOC
95toDoc :: Module -> [Module] -> D.Doc
96toDoc err errs =
97 let
98 (NE.List m ms) = NE.sortBy _time (NE.List err errs)
99 in
100 D.vcat (toDocHelp m ms)
103toDocHelp :: Module -> [Module] -> [D.Doc]
104toDocHelp module1 modules =
105 case modules of
106 [] ->
107 [moduleToDoc module1
108 ,""
109 ]
111 module2 : otherModules ->
112 moduleToDoc module1
113 : toSeparator module1 module2
114 : toDocHelp module2 otherModules
117toSeparator :: Module -> Module -> D.Doc
118toSeparator beforeModule afterModule =
119 let
120 before = ModuleName.toChars (_name beforeModule) ++ " ↑ "
121 after = " ↓ " ++ ModuleName.toChars (_name afterModule)
122 in
123 D.dullred $ D.vcat $
124 [ D.indent (80 - length before) (D.fromChars before)
125 , "====o======================================================================o===="
126 , D.fromChars after
127 , ""
128 , ""
129 ]
133-- MODULE TO DOC
136moduleToDoc :: Module -> D.Doc
137moduleToDoc (Module _ path _ source err) =
138 let
139 reports =
140 toReports (Code.toSource source) err
141 in
142 D.vcat $ map (reportToDoc path) (NE.toList reports)
145reportToDoc :: FilePath -> Report.Report -> D.Doc
146reportToDoc path (Report.Report title _ _ message) =
147 D.vcat
148 [ toMessageBar title path
149 , ""
150 , message
151 , ""
152 ]
155toMessageBar :: String -> FilePath -> D.Doc
156toMessageBar title filePath =
157 let
158 usedSpace =
159 4 + length title + 1 + length filePath
160 in
161 D.dullcyan $ D.fromChars $
162 "-- " ++ title
163 ++ " " ++ replicate (max 1 (80 - usedSpace)) '-'
164 ++ " " ++ filePath
168-- TO JSON
171toJson :: Module -> E.Value
172toJson (Module name path _ source err) =
173 let
174 reports =
175 toReports (Code.toSource source) err
176 in
177 E.object
178 [ "path" ==> E.chars path
179 , "name" ==> E.name name
180 , "problems" ==> E.array (map reportToJson (NE.toList reports))
181 ]
184reportToJson :: Report.Report -> E.Value
185reportToJson (Report.Report title region _sgstns message) =
186 E.object
187 [ "title" ==> E.chars title
188 , "region" ==> encodeRegion region
189 , "message" ==> D.encode message
190 ]
193encodeRegion :: A.Region -> E.Value
194encodeRegion (A.Region (A.Position sr sc) (A.Position er ec)) =
195 E.object
196 [ "start" ==>
197 E.object
198 [ "line" ==> E.int (fromIntegral sr)
199 , "column" ==> E.int (fromIntegral sc)
200 ]
201 , "end" ==>
202 E.object
203 [ "line" ==> E.int (fromIntegral er)
204 , "column" ==> E.int (fromIntegral ec)
205 ]
206 ]