git.iko.soy/elk
on 7324fca help sign in
elk/compiler/src/Reporting/Error.hs
207 lines 4.8 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 :: NE.List Module -> D.Doc
93toDoc modules =
94 let
95 timeCompare m1 m2 = compare (_time m1) (_time m2)
96 (NE.List m ms) = NE.sortBy timeCompare modules
97 in
98 D.vcat (toDocHelp m ms)
101toDocHelp :: Module -> [Module] -> [D.Doc]
102toDocHelp module1 modules =
103 case modules of
104 [] ->
105 [moduleToDoc module1]
107 module2 : otherModules ->
108 moduleToDoc module1
109 : toSeparator module1 module2
110 : toDocHelp module2 otherModules
113toSeparator :: Module -> Module -> D.Doc
114toSeparator beforeModule afterModule =
115 let
116 before = ModuleName.toChars (_name beforeModule) ++ " ↑ "
117 after = " ↓ " ++ ModuleName.toChars (_name afterModule)
118 in
119 D.dullred $ D.vcat $
120 [ D.indent (80 - length before) (D.fromChars before)
121 , "====o======================================================================o===="
122 , D.fromChars after
123 , ""
124 , ""
125 ]
129-- MODULE TO DOC
132moduleToDoc :: Module -> D.Doc
133moduleToDoc (Module _ path _ source err) =
134 let
135 reports =
136 toReports (Code.toSource source) err
137 in
138 D.vcat $ map (reportToDoc path) (NE.toList reports)
141reportToDoc :: FilePath -> Report.Report -> D.Doc
142reportToDoc path (Report.Report title _ _ message) =
143 D.vcat
144 [ toMessageBar title path
145 , ""
146 , message
147 , ""
148 ]
151toMessageBar :: String -> FilePath -> D.Doc
152toMessageBar title filePath =
153 let
154 usedSpace =
155 4 + length title + 1 + length filePath
156 in
157 D.dullcyan $ D.fromChars $
158 "-- " ++ title
159 ++ " " ++ replicate (max 1 (80 - usedSpace)) '-'
160 ++ " " ++ filePath
164-- TO JSON
167toJson :: NE.List Module -> E.Value
168toJson modules =
169 E.array (map moduleToJson (NE.toList modules))
172moduleToJson :: Module -> E.Value
173moduleToJson (Module name path _ source err) =
174 let
175 reports =
176 toReports (Code.toSource source) err
177 in
178 E.object
179 [ "path" ==> E.string (Utf8.fromChars path)
180 , "name" ==> E.string (Name.toUtf8 name)
181 , "problems" ==> E.array (map reportToJson (NE.toList reports))
182 ]
185reportToJson :: Report.Report -> E.Value
186reportToJson (Report.Report title region _sgstns message) =
187 E.object
188 [ "title" ==> E.string (Utf8.fromChars title)
189 , "region" ==> encodeRegion region
190 , "message" ==> D.encode message
191 ]
194encodeRegion :: A.Region -> E.Value
195encodeRegion (A.Region (A.Position sr sc) (A.Position er ec)) =
196 E.object
197 [ "start" ==>
198 E.object
199 [ ("line", E.int (fromIntegral sr))
200 , ("column", E.int (fromIntegral sc))
201 ]
202 , "end" ==>
203 E.object
204 [ ("line", E.int (fromIntegral er))
205 , ("column", E.int (fromIntegral ec))
206 ]
207 ]