git.iko.soy/elk
on master help sign in
Add colors to errors and warnings
db277d9Evan Czaplicki
elm-compiler.cabal+3
compare with master
unifiedsplit
@@ -113,6 +113,7 @@ Library
113 Build-depends:
113 Build-depends:
114 aeson >= 0.7 && < 0.9,
114 aeson >= 0.7 && < 0.9,
115 aeson-pretty >= 0.7 && < 0.8,
115 aeson-pretty >= 0.7 && < 0.8,
116+ ansi-terminal >= 0.6.2.1 && < 0.7,
116 base >=4.2 && <5,
117 base >=4.2 && <5,
117 binary >= 0.7.0.0 && < 0.8,
118 binary >= 0.7.0.0 && < 0.8,
118 blaze-html >= 0.5 && < 0.8,
119 blaze-html >= 0.5 && < 0.8,
@@ -152,6 +153,7 @@ Executable elm
152 Build-depends:
153 Build-depends:
153 aeson >= 0.7 && < 0.9,
154 aeson >= 0.7 && < 0.9,
154 aeson-pretty >= 0.7 && < 0.8,
155 aeson-pretty >= 0.7 && < 0.8,
156+ ansi-terminal >= 0.6.2.1 && < 0.7,
155 base >=4.2 && <5,
157 base >=4.2 && <5,
156 binary >= 0.7.0.0 && < 0.8,
158 binary >= 0.7.0.0 && < 0.8,
157 bytestring >= 0.9 && < 0.11,
159 bytestring >= 0.9 && < 0.11,
@@ -196,6 +198,7 @@ Test-Suite compiler-tests
196 QuickCheck >= 2 && < 3,
198 QuickCheck >= 2 && < 3,
197 aeson >= 0.7 && < 0.9,
199 aeson >= 0.7 && < 0.9,
198 aeson-pretty >= 0.7 && < 0.8,
200 aeson-pretty >= 0.7 && < 0.8,
201+ ansi-terminal >= 0.6.2.1 && < 0.7,
199 base >=4.2 && <5,
202 base >=4.2 && <5,
200 binary >= 0.7.0.0 && < 0.8,
203 binary >= 0.7.0.0 && < 0.8,
201 blaze-html >= 0.5 && < 0.8,
204 blaze-html >= 0.5 && < 0.8,
src/Elm/Compiler.hs+12−2
@@ -2,8 +2,8 @@
2module Elm.Compiler
2module Elm.Compiler
3 ( version, rawVersion
3 ( version, rawVersion
4 , parseDependencies, compile
4 , parseDependencies, compile
5− , Error, errorToString, errorToJson
5+ , Error, errorToString, errorToJson, printError
6− , Warning, warningToString, warningToJson
6+ , Warning, warningToString, warningToJson, printWarning
7 ) where
7 ) where
8
8
9import qualified Data.Aeson as Json
9import qualified Data.Aeson as Json
@@ -91,6 +91,11 @@ errorToString location source (Error err) =
91 Error.toString location source err
91 Error.toString location source err
92
92
93
93
94+printError :: String -> String -> Error -> IO ()
95+printError location source (Error err) =
96+ Error.print location source err
97+
98+
94errorToJson :: String -> Error -> Json.Value
99errorToJson :: String -> Error -> Json.Value
95errorToJson location (Error err) =
100errorToJson location (Error err) =
96 Error.toJson location err
101 Error.toJson location err
@@ -106,6 +111,11 @@ warningToString location source (Warning err) =
106 Warning.toString location source err
111 Warning.toString location source err
107
112
108
113
114+printWarning :: String -> String -> Warning -> IO ()
115+printWarning location source (Warning err) =
116+ Warning.print location source err
117+
118+
109warningToJson :: String -> Warning -> Json.Value
119warningToJson :: String -> Warning -> Json.Value
110warningToJson location (Warning err) =
120warningToJson location (Warning err) =
111 Warning.toJson location err
121 Warning.toJson location err
src/Reporting/Error.hs+20−11
@@ -4,6 +4,7 @@ module Reporting.Error where
4
4
5import Data.Aeson ((.=))
5import Data.Aeson ((.=))
6import qualified Data.Aeson as Json
6import qualified Data.Aeson as Json
7+import Prelude hiding (print)
7
8
8import qualified Reporting.Annotation as A
9import qualified Reporting.Annotation as A
9import qualified Reporting.Error.Canonicalize as Canonicalize
10import qualified Reporting.Error.Canonicalize as Canonicalize
@@ -20,23 +21,31 @@ data Error
20 | Type Type.Error
21 | Type Type.Error
21
22
22
23
24+-- TO REPORT
25+
26+toReport :: Error -> Report.Report
27+toReport err =
28+ case err of
29+ Syntax syntaxError ->
30+ Syntax.toReport syntaxError
31+
32+ Canonicalize canonicalizeError ->
33+ Canonicalize.toReport canonicalizeError
34+
35+ Type typeError ->
36+ Type.toReport typeError
37+
38+
23-- TO STRING
39-- TO STRING
24
40
25toString :: String -> String -> A.Located Error -> String
41toString :: String -> String -> A.Located Error -> String
26toString location source (A.A region err) =
42toString location source (A.A region err) =
27− let
43+ Report.toString location region (toReport err) source
28− report =
29− case err of
30− Syntax syntaxError ->
31− Syntax.toReport syntaxError
32
44
33− Canonicalize canonicalizeError ->
34− Canonicalize.toReport canonicalizeError
35
45
36− Type typeError ->
46+print :: String -> String -> A.Located Error -> IO ()
37− Type.toReport typeError
47+print location source (A.A region err) =
38− in
39− Report.toString location region report source
48+ Report.printError location region (toReport err) source
40
49
41
50
42-- TO JSON
51-- TO JSON
src/Reporting/Error/Type.hs+1−2
@@ -57,8 +57,7 @@ toReport err =
57 (subRegion, preHint) = hintToString hint
57 (subRegion, preHint) = hintToString hint
58
58
59 postHint =
59 postHint =
60− "To be more specific, as I infer all the types, I am seeing a conflict between\n"
60+ "To be more specific, type inference is leading to a conflict between this type:\n\n"
61− ++ "this type:\n\n"
62 ++ P.render (P.nest 4 (P.pretty False leftType))
61 ++ P.render (P.nest 4 (P.pretty False leftType))
63 ++ "\n\nand this type:\n\n"
62 ++ "\n\nand this type:\n\n"
64 ++ P.render (P.nest 4 (P.pretty False rightType))
63 ++ P.render (P.nest 4 (P.pretty False rightType))
src/Reporting/Report.hs+133−45
@@ -5,10 +5,15 @@ module Reporting.Report
5 , simple
5 , simple
6 , toString
6 , toString
7 , toJson
7 , toJson
8+ , printError, printWarning
8 ) where
9 ) where
9
10
11+import Control.Applicative ((<|>))
12+import Control.Monad.Writer (Writer, execWriter, tell)
10import Data.Aeson ((.=))
13import Data.Aeson ((.=))
11import qualified Data.Aeson.Types as Json
14import qualified Data.Aeson.Types as Json
15+import System.Console.ANSI
16+import System.IO (hPutStr, stderr)
12
17
13import qualified Reporting.Region as R
18import qualified Reporting.Region as R
14
19
@@ -27,13 +32,33 @@ simple title pre post =
27
32
28
33
29toString :: String -> R.Region -> Report -> String -> String
34toString :: String -> R.Region -> Report -> String -> String
35+toString location region report source =
36+ execWriter (render plain location region report source)
37+
38+
39+printError :: String -> R.Region -> Report -> String -> IO ()
40+printError location region report source =
41+ render (ansi Error) location region report source
42+
43+
44+printWarning :: String -> R.Region -> Report -> String -> IO ()
45+printWarning location region report source =
46+ render (ansi Warning) location region report source
47+
48+
49+render
50+ :: (Monad m)
51+ => Renderer m
52+ -> String
53+ -> R.Region
54+ -> Report
55+ -> String
56+ -> m ()
30−toString location region (Report title highlight pre post) source =
57+render renderer location region (Report title highlight pre post) source =
31− concat
32− [ messageBar title location
58+ do messageBar renderer title location
33− , pre ++ "\n\n"
59+ normal renderer (pre ++ "\n\n")
34− , grabRegion highlight region source ++ "\n"
60+ grabRegion renderer highlight region source
35− , if null post then "\n" else post ++ "\n\n\n"
61+ normal renderer ("\n" ++ if null post then "\n" else post ++ "\n\n\n")
36− ]
37
62
38
63
39toJson :: [Json.Pair] -> Report -> (Maybe R.Region, [Json.Pair])
64toJson :: [Json.Pair] -> Report -> (Maybe R.Region, [Json.Pair])
@@ -48,12 +73,55 @@ toJson extraFields (Report title subregion pre post) =
48 (subregion, fields ++ extraFields)
73 (subregion, fields ++ extraFields)
49
74
50
75
76+-- RENDERING
77+
78+data Renderer m = Renderer
79+ { normal :: String -> m ()
80+ , header :: String -> m ()
81+ , accent :: String -> m ()
82+ }
83+
84+
85+plain :: Renderer (Writer String)
86+plain =
87+ Renderer tell tell tell
88+
89+
90+data Type = Error | Warning
91+
92+
93+ansi :: Type -> Renderer IO
94+ansi tipe =
95+ let
96+ put =
97+ hPutStr stderr
98+
99+ put' intensity color string =
100+ do hSetSGR stderr [SetColor Foreground intensity color]
101+ put string
102+ hSetSGR stderr [Reset]
103+
104+ accentColor =
105+ case tipe of
106+ Error -> Red
107+ Warning -> Yellow
108+ in
109+ Renderer
110+ put
111+ (put' Dull Cyan)
112+ (put' Dull accentColor)
113+
114+
115+
116+
51-- REPORT HEADER
117-- REPORT HEADER
52
118
53−messageBar :: String -> String -> String
119+messageBar :: Renderer m -> String -> String -> m ()
54−messageBar tag location =
120+messageBar renderer tag location =
121+ let
55− let usedSpace = 4 + length tag + 1 + length location
122+ usedSpace = 4 + length tag + 1 + length location
56 in
123 in
124+ header renderer $
57 "-- " ++ tag ++ " "
125 "-- " ++ tag ++ " "
58 ++ replicate (max 1 (80 - usedSpace)) '-'
126 ++ replicate (max 1 (80 - usedSpace)) '-'
59 ++ " " ++ location ++ "\n\n"
127 ++ " " ++ location ++ "\n\n"
@@ -61,8 +129,14 @@ messageBar tag location =
61
129
62-- REGIONS
130-- REGIONS
63
131
132+grabRegion
133+ :: (Monad m)
134+ => Renderer m
64−grabRegion :: Maybe R.Region -> R.Region -> String -> String
135+ -> Maybe R.Region
136+ -> R.Region
137+ -> String
138+ -> m ()
65−grabRegion maybeSubRegion (R.Region start end) source =
139+grabRegion renderer maybeSubRegion region@(R.Region start end) source =
66 let
140 let
67 (R.Position startLine startColumn) = start
141 (R.Position startLine startColumn) = start
68 (R.Position endLine endColumn) = end
142 (R.Position endLine endColumn) = end
@@ -76,10 +150,10 @@ grabRegion maybeSubRegion (R.Region start end) source =
76 in
150 in
77 case relevantLines of
151 case relevantLines of
78 [] ->
152 [] ->
79− ""
153+ normal renderer ""
80
154
81 [sourceLine] ->
155 [sourceLine] ->
82− singleLineRegion startLine sourceLine $
156+ singleLineRegion renderer startLine sourceLine $
83 case maybeSubRegion of
157 case maybeSubRegion of
84 Nothing ->
158 Nothing ->
85 (0, startColumn, endColumn, length sourceLine)
159 (0, startColumn, endColumn, length sourceLine)
@@ -100,44 +174,61 @@ grabRegion maybeSubRegion (R.Region start end) source =
100 filteredFirstLine : init rest ++ [filteredLastLine]
174 filteredFirstLine : init rest ++ [filteredLastLine]
101
175
102 lineNumbersWidth =
176 lineNumbersWidth =
103− length (show (endLine + 1))
177+ length (show endLine)
178+
179+ subregion =
180+ maybeSubRegion <|> Just region
104
181
105 numberedLines =
182 numberedLines =
106 zipWith
183 zipWith
107− (addLineNumber maybeSubRegion lineNumbersWidth)
184+ (addLineNumber renderer subregion lineNumbersWidth)
108− [startLine - 1 .. endLine + 1]
185+ [startLine .. endLine]
109− ("" : focusedRelevantLines ++ [""])
186+ focusedRelevantLines
110 in
187 in
111− unlines numberedLines
188+ mapM_ (\line -> line >> normal renderer "\n") numberedLines
112−
189+
113−
190+
114−addLineNumber :: Maybe R.Region -> Int -> Int -> String -> String
191+addLineNumber
192+ :: (Monad m)
193+ => Renderer m
194+ -> Maybe R.Region
195+ -> Int
196+ -> Int
197+ -> String
198+ -> m ()
115−addLineNumber maybeSubRegion width n line =
199+addLineNumber renderer maybeSubRegion width n line =
116 let
200 let
117 number =
201 number =
118− if n < 0 then " " else show n
202+ if n < 0 then " " else show n
203+
204+ lineNumber =
205+ replicate (width - length number) ' ' ++ number ++ "|"
119
206
120 spacer (R.Region start end) =
207 spacer (R.Region start end) =
121− if R.line start <= n && n <= R.line end
208+ if R.line start <= n && n <= R.line end
122− then ">"
209+ then accent renderer ">"
123− else " "
210+ else normal renderer " "
124 in
211 in
125− replicate (width - length number) ' ' ++ number
212+ do normal renderer lineNumber
126− ++ "|" ++ maybe " " spacer maybeSubRegion
213+ maybe (normal renderer " ") spacer maybeSubRegion
127− ++ line
214+ normal renderer line
128−
215+
129−
216+
130−singleLineRegion :: Int -> String -> (Int, Int, Int, Int) -> String
217+singleLineRegion
218+ :: (Monad m)
219+ => Renderer m
220+ -> Int
221+ -> String
222+ -> (Int, Int, Int, Int)
223+ -> m ()
131−singleLineRegion lineNum sourceLine (start, innerStart, innerEnd, end) =
224+singleLineRegion renderer lineNum sourceLine (start, innerStart, innerEnd, end) =
132 let
225 let
226+ width =
133− w = length (show (lineNum + 1))
227+ length (show lineNum)
134−
135− number =
136− addLineNumber Nothing w
137
228
138 underline =
229 underline =
139− replicate (innerStart - 1) ' '
230+ replicate (innerStart + width + 1) ' '
140− ++ replicate (max 1 (innerEnd - innerStart)) '^'
231+ ++ replicate (max 1 (innerEnd - innerStart)) '^'
141
232
142 (|>) = flip ($)
233 (|>) = flip ($)
143
234
@@ -147,8 +238,5 @@ singleLineRegion lineNum sourceLine (start, innerStart, innerEnd, end) =
147 |> take (end - start + 1)
238 |> take (end - start + 1)
148 |> (++) (replicate (start - 1) ' ')
239 |> (++) (replicate (start - 1) ' ')
149 in
240 in
150− unlines
151− [ number (lineNum-1) ""
152− , number lineNum trimmedSourceLine
241+ do addLineNumber renderer Nothing width lineNum trimmedSourceLine
153− , number (lineNum+1) underline
242+ accent renderer $ "\n" ++ underline
154− ]
src/Reporting/Warning.hs+5
@@ -28,6 +28,11 @@ toString location source (A.A region warning) =
28 Report.toString location region (toReport warning) source
28 Report.toString location region (toReport warning) source
29
29
30
30
31+print :: String -> String -> A.Located Warning -> IO ()
32+print location source (A.A region warning) =
33+ Report.printWarning location region (toReport warning) source
34+
35+
31toReport :: Warning -> Report.Report
36toReport :: Warning -> Report.Report
32toReport warning =
37toReport warning =
33 case warning of
38 case warning of