git.iko.soy/elk
on f9de430 help sign in
elk/compiler/src/Reporting/Error.hs
210 lines 4.9 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
15import qualified System.FilePath as FP
17import qualified Elm.ModuleName as ModuleName
18import qualified File
19import qualified Json.Encode as E
20import Json.Encode ((==>))
21import qualified Reporting.Annotation as A
22import qualified Reporting.Doc as D
23import qualified Reporting.Error.Canonicalize as Canonicalize
24import qualified Reporting.Error.Docs as Docs
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 , _absolutePath :: FilePath
43 , _modificationTime :: 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)
60 | BadDocs Docs.Error
64-- TO REPORT
67toReports :: Code.Source -> Error -> NE.List Report.Report
68toReports source err =
69 case err of
70 BadSyntax syntaxError ->
71 NE.List (Syntax.toReport source syntaxError) []
73 BadImports errs ->
74 fmap (Import.toReport source) errs
76 BadNames errs ->
77 fmap (Canonicalize.toReport source) (OneOrMore.destruct NE.List errs)
79 BadTypes localizer errs ->
80 fmap (Type.toReport source localizer) errs
82 BadMains localizer errs ->
83 fmap (Main.toReport localizer source) (OneOrMore.destruct NE.List errs)
85 BadPatterns errs ->
86 fmap (Pattern.toReport source) errs
88 BadDocs docsErr ->
89 Docs.toReports source docsErr
93-- TO DOC
96toDoc :: FilePath -> Module -> [Module] -> D.Doc
97toDoc root err errs =
98 let
99 (NE.List m ms) = NE.sortBy _modificationTime (NE.List err errs)
100 in
101 D.vcat (toDocHelp root m ms)
104toDocHelp :: FilePath -> Module -> [Module] -> [D.Doc]
105toDocHelp root module1 modules =
106 case modules of
107 [] ->
108 [moduleToDoc root module1
109 ,""
110 ]
112 module2 : otherModules ->
113 moduleToDoc root module1
114 : toSeparator module1 module2
115 : toDocHelp root module2 otherModules
118toSeparator :: Module -> Module -> D.Doc
119toSeparator beforeModule afterModule =
120 let
121 before = ModuleName.toChars (_name beforeModule) ++ " ↑ "
122 after = " ↓ " ++ ModuleName.toChars (_name afterModule)
123 in
124 D.dullred $ D.vcat $
125 [ D.indent (80 - length before) (D.fromChars before)
126 , "====o======================================================================o===="
127 , D.fromChars after
128 , ""
129 , ""
130 ]
134-- MODULE TO DOC
137moduleToDoc :: FilePath -> Module -> D.Doc
138moduleToDoc root (Module _ absolutePath _ source err) =
139 let
140 reports =
141 toReports (Code.toSource source) err
143 relativePath =
144 FP.makeRelative root absolutePath
145 in
146 D.vcat $ map (reportToDoc relativePath) (NE.toList reports)
149reportToDoc :: FilePath -> Report.Report -> D.Doc
150reportToDoc relativePath (Report.Report title _ _ message) =
151 D.vcat
152 [ toMessageBar title relativePath
153 , ""
154 , message
155 , ""
156 ]
159toMessageBar :: String -> FilePath -> D.Doc
160toMessageBar title filePath =
161 let
162 usedSpace =
163 4 + length title + 1 + length filePath
164 in
165 D.dullcyan $ D.fromChars $
166 "-- " ++ title
167 ++ " " ++ replicate (max 1 (80 - usedSpace)) '-'
168 ++ " " ++ filePath
172-- TO JSON
175toJson :: Module -> E.Value
176toJson (Module name path _ source err) =
177 let
178 reports =
179 toReports (Code.toSource source) err
180 in
181 E.object
182 [ "path" ==> E.chars path
183 , "name" ==> E.name name
184 , "problems" ==> E.array (map reportToJson (NE.toList reports))
185 ]
188reportToJson :: Report.Report -> E.Value
189reportToJson (Report.Report title region _sgstns message) =
190 E.object
191 [ "title" ==> E.chars title
192 , "region" ==> encodeRegion region
193 , "message" ==> D.encode message
194 ]
197encodeRegion :: A.Region -> E.Value
198encodeRegion (A.Region (A.Position sr sc) (A.Position er ec)) =
199 E.object
200 [ "start" ==>
201 E.object
202 [ "line" ==> E.int (fromIntegral sr)
203 , "column" ==> E.int (fromIntegral sc)
204 ]
205 , "end" ==>
206 E.object
207 [ "line" ==> E.int (fromIntegral er)
208 , "column" ==> E.int (fromIntegral ec)
209 ]
210 ]