on fa9aba2 help sign in
208 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 , _localizer :: L.Localizer
47 }
51-- ERRORS
54data 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)
64-- TO REPORT
67toReports :: L.Localizer -> Code.Source -> Error -> NE.List Report.Report
68toReports localizer source err =
69 case err of
70 BadSyntax syntaxError ->
71 NE.List (Syntax.toReport source syntaxError) []
73 BadImports errs ->
74 fmap Import.toReport errs
76 BadNames errs ->
77 fmap (Canonicalize.toReport source) (OneOrMore.destruct NE.List errs)
79 BadTypes errs ->
80 fmap (Type.toReport source localizer) errs
82 BadPatterns errs ->
83 fmap (Pattern.toReport source) errs
85 BadMains errs ->
86 fmap (Main.toReport localizer source) (OneOrMore.destruct NE.List errs)
90-- TO DOC
93toDoc :: NE.List Module -> D.Doc
94toDoc 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)
102toDocHelp :: Module -> [Module] -> [D.Doc]
103toDocHelp module1 modules =
104 case modules of
105 [] ->
106 [moduleToDoc module1]
108 module2 : otherModules ->
109 moduleToDoc module1
110 : toSeparator module1 module2
111 : toDocHelp module2 otherModules
114toSeparator :: Module -> Module -> D.Doc
115toSeparator 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 ]
130-- MODULE TO DOC
133moduleToDoc :: Module -> D.Doc
134moduleToDoc (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)
142reportToDoc :: FilePath -> Report.Report -> D.Doc
143reportToDoc path (Report.Report title _ _ message) =
144 D.vcat
145 [ toMessageBar title path
146 , ""
147 , message
148 , ""
149 ]
152toMessageBar :: String -> FilePath -> D.Doc
153toMessageBar 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
165-- TO JSON
168toJson :: NE.List Module -> E.Value
169toJson modules =
170 E.array (map moduleToJson (NE.toList modules))
173moduleToJson :: Module -> E.Value
174moduleToJson (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 ]
186reportToJson :: Report.Report -> E.Value
187reportToJson (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 ]
195encodeRegion :: A.Region -> E.Value
196encodeRegion (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 ]