Color compiler warnings and errors

CHANGELOG.d/fix_4152.md

@@ -0,0 +1 @@
+* Add color to compiler warnings and errors

CONTRIBUTORS.md

@@ -73,6 +73,7 @@ If you would prefer to use different terms, please use the section below instead
 | [@lukerandall](https://github.com/lukerandall) | Luke Randall | [MIT license](http://opensource.org/licenses/MIT) |
 | [@lunaris](https://github.com/lunaris) | Will Jones | [MIT license](http://opensource.org/licenses/MIT) |
 | [@matthewleon](https://github.com/matthewleon) | Matthew Leon | [MIT license](http://opensource.org/licenses/MIT) |
+| [@maurobalbi](https://github.com/maurobalbi) | Mauro Balbi | [MIT license](http://opensource.org/licenses/MIT) |
 | [@mcoffin](https://github.com/mcoffin) | Matt Coffin | [MIT license](http://opensource.org/licenses/MIT) |
 | [@mhcurylo](https://github.com/mhcurylo) | Mateusz Curylo | [MIT license](http://opensource.org/licenses/MIT) |
 | [@MiracleBlue](https://github.com/MiracleBlue) | Nicholas Kircher | [MIT license](http://opensource.org/licenses/MIT) |

app/Command/Compile.hs

@@ -36,7 +36,7 @@ data PSCMakeOptions = PSCMakeOptions
 printWarningsAndErrors :: Bool -> Bool -> P.MultipleErrors -> Either P.MultipleErrors a -> IO ()
 printWarningsAndErrors verbose False warnings errors = do
   pwd <- getCurrentDirectory
-  cc <- bool Nothing (Just P.defaultCodeColor) <$> ANSI.hSupportsANSI stdout
+  cc <- bool Nothing (Just P.defaultCodeColors) <$> ANSI.hSupportsANSI stdout
   let ppeOpts = P.defaultPPEOptions { P.ppeCodeColor = cc, P.ppeFull = verbose, P.ppeRelativeDirectory = pwd }
   when (P.nonEmpty warnings) $
     putStrLn (P.prettyPrintMultipleWarnings ppeOpts warnings)

app/Command/Graph.hs

@@ -67,7 +67,7 @@ command = graph <$> (Opts.helper <*> graphOptions)
 printWarningsAndErrors :: Bool -> P.MultipleErrors -> Either P.MultipleErrors a -> IO a
 printWarningsAndErrors False warnings errors = do
   pwd <- getCurrentDirectory
-  cc <- bool Nothing (Just P.defaultCodeColor) <$> ANSI.hSupportsANSI stderr
+  cc <- bool Nothing (Just P.defaultCodeColors) <$> ANSI.hSupportsANSI stderr
   let ppeOpts = P.defaultPPEOptions { P.ppeCodeColor = cc, P.ppeFull = True, P.ppeRelativeDirectory = pwd }
   when (P.nonEmpty warnings) $
     hPutStrLn stderr (P.prettyPrintMultipleWarnings ppeOpts warnings)

src/Language/PureScript/Errors.hs

@@ -575,24 +575,49 @@ colorCodeBox codeColor b = case codeColor of
         , Box.vcat Box.top $ replicate (Box.rows b) $ Box.text ansiColorReset
         ]
 
-
--- | Default color intensity and color for code
-defaultCodeColor :: (ANSI.ColorIntensity, ANSI.Color)
-defaultCodeColor = (ANSI.Dull, ANSI.Yellow)
+-- | Default color intensity and color for codes
+defaultErrorCodeColor :: (ANSI.ColorIntensity , ANSI.Color)
+defaultErrorCodeColor = (ANSI.Dull, ANSI.Red )
+
+defaultWarningCodeColor :: (ANSI.ColorIntensity , ANSI.Color)
+defaultWarningCodeColor = (ANSI.Dull, ANSI.Yellow )
+
+defaultMarkCodeColor :: (ANSI.ColorIntensity, ANSI.Color)
+defaultMarkCodeColor = (ANSI.Dull, ANSI.Yellow)
+
+codeWarningOrErrorColor :: PPEOptions -> Maybe (ANSI.ColorIntensity, ANSI.Color)
+codeWarningOrErrorColor ppeOpts = case ppeLevel ppeOpts of
+  Error -> errorCodeColor <$> ppeCodeColor ppeOpts
+  Warning -> warningCodeColor <$> ppeCodeColor ppeOpts
+
+-- | Code colors 
+data CodeColors = CodeColors 
+  { errorCodeColor       :: (ANSI.ColorIntensity, ANSI.Color)
+  , warningCodeColor     :: (ANSI.ColorIntensity, ANSI.Color)
+  , markCodeColor        :: (ANSI.ColorIntensity, ANSI.Color)
+  }
 
 -- | `prettyPrintSingleError` Options
 data PPEOptions = PPEOptions
-  { ppeCodeColor         :: Maybe (ANSI.ColorIntensity, ANSI.Color) -- ^ Color code with this color... or not
+  { ppeCodeColor         :: Maybe CodeColors -- ^ Color code with this color... or not
   , ppeFull              :: Bool -- ^ Should write a full error message?
   , ppeLevel             :: Level -- ^ Should this report an error or a warning?
   , ppeShowDocs          :: Bool -- ^ Should show a link to error message's doc page?
   , ppeRelativeDirectory :: FilePath -- ^ FilePath to which the errors are relative
   }
 
+-- | Default code colors
+defaultCodeColors :: CodeColors
+defaultCodeColors = CodeColors 
+  { errorCodeColor       = defaultErrorCodeColor
+  , warningCodeColor     = defaultWarningCodeColor
+  , markCodeColor        = defaultMarkCodeColor
+  }
+
 -- | Default options for PPEOptions
 defaultPPEOptions :: PPEOptions
 defaultPPEOptions = PPEOptions
-  { ppeCodeColor         = Just defaultCodeColor
+  { ppeCodeColor         = Just defaultCodeColors
   , ppeFull              = False
   , ppeLevel             = Error
   , ppeShowDocs          = True
@@ -606,7 +631,7 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath) e = fl
   um <- get
   return (prettyPrintErrorMessage um em)
   where
-  (markCode, markCodeBox) = (colorCode &&& colorCodeBox) codeColor
+  (markCode, markCodeBox) = (colorCode &&& colorCodeBox) $ markCodeColor <$> codeColor
 
   -- Pretty print an ErrorMessage
   prettyPrintErrorMessage :: TypeMap -> ErrorMessage -> Box.Box
@@ -1766,15 +1791,16 @@ prettyPrintMultipleErrorsBox ppeOptions = prettyPrintMultipleErrorsWith (ppeOpti
 prettyPrintMultipleErrorsWith :: PPEOptions -> String -> String -> MultipleErrors -> [Box.Box]
 prettyPrintMultipleErrorsWith ppeOptions intro _ (MultipleErrors [e]) =
   let result = prettyPrintSingleError ppeOptions e
-  in [ Box.vcat Box.left [ Box.text intro
-                         , result
-                         ]
+      codeColor = codeWarningOrErrorColor ppeOptions
+  in [ colorCodeBox codeColor $ Box.text intro
+     , Box.moveRight 2 result
      ]
 prettyPrintMultipleErrorsWith ppeOptions _ intro (MultipleErrors es) =
   let result = map (prettyPrintSingleError ppeOptions) es
   in concat $ zipWith withIntro [1 :: Int ..] result
   where
-  withIntro i err = [ Box.text (intro ++ " " ++ show i ++ " of " ++ show (length es) ++ ":")
+  codeColor = codeWarningOrErrorColor ppeOptions
+  withIntro i err = [ colorCodeBox codeColor $ Box.text (intro ++ " " ++ show i ++ " of " ++ show (length es) ++ ":")
                     , Box.moveRight 2 err
                     ]
 

tests/purs/failing/1071.out

@@ -1,22 +1,23 @@
-Error found:
-in module Main
-at tests/purs/failing/1071.purs:7:18 - 7:23 (line 7, column 18 - line 7, column 23)
+Error found:
 
-  Could not match kind
-                      
-    Type -> Constraint
-                      
-  with kind
-              
-    Constraint
-              
+  in module Main
+  at tests/purs/failing/1071.purs:7:18 - 7:23 (line 7, column 18 - line 7, column 23)
 
-while checking that type Foo a
-  has kind Constraint
-while inferring the kind of Foo a => a -> a
-while inferring the kind of forall a. Foo a => a -> a
-in value declaration bar
+    Could not match kind
+                        
+      Type -> Constraint
+                        
+    with kind
+                
+      Constraint
+                
 
-See https://github.com/purescript/documentation/blob/master/errors/KindsDoNotUnify.md for more information,
-or to contribute content related to this error.
+  while checking that type Foo a
+    has kind Constraint
+  while inferring the kind of Foo a => a -> a
+  while inferring the kind of forall a. Foo a => a -> a
+  in value declaration bar
+
+  See https://github.com/purescript/documentation/blob/master/errors/KindsDoNotUnify.md for more information,
+  or to contribute content related to this error.
 

tests/purs/failing/1169.out

@@ -1,15 +1,16 @@
-Error found:
-in module Test
-at tests/purs/failing/1169.purs:12:8 - 12:15 (line 12, column 8 - line 12, column 15)
+Error found:
 
-  Data constructor Test.Inner was given 1 arguments in a case expression, but expected 2 arguments.
-  This problem can be fixed by giving Test.Inner 2 arguments.
+  in module Test
+  at tests/purs/failing/1169.purs:12:8 - 12:15 (line 12, column 8 - line 12, column 15)
 
-while checking that expression case $1 of         
-                                 (Inner _) -> true
-  has type Boolean
-in value declaration test2
+    Data constructor Test.Inner was given 1 arguments in a case expression, but expected 2 arguments.
+    This problem can be fixed by giving Test.Inner 2 arguments.
 
-See https://github.com/purescript/documentation/blob/master/errors/IncorrectConstructorArity.md for more information,
-or to contribute content related to this error.
+  while checking that expression case $1 of         
+                                   (Inner _) -> true
+    has type Boolean
+  in value declaration test2
+
+  See https://github.com/purescript/documentation/blob/master/errors/IncorrectConstructorArity.md for more information,
+  or to contribute content related to this error.
 

tests/purs/failing/1175.out

@@ -1,22 +1,23 @@
-Error found:
-in module X
-at tests/purs/failing/1175.purs:11:11 - 11:12 (line 11, column 11 - line 11, column 12)
+Error found:
 
-  Could not match type
-       
-    Int
-       
-  with type
-          
-    String
-          
+  in module X
+  at tests/purs/failing/1175.purs:11:11 - 11:12 (line 11, column 11 - line 11, column 12)
 
-while checking that type Int
-  is at least as general as type String
-while checking that expression 1
-  has type String
-in value declaration f
+    Could not match type
+         
+      Int
+         
+    with type
+            
+      String
+            
 
-See https://github.com/purescript/documentation/blob/master/errors/TypesDoNotUnify.md for more information,
-or to contribute content related to this error.
+  while checking that type Int
+    is at least as general as type String
+  while checking that expression 1
+    has type String
+  in value declaration f
+
+  See https://github.com/purescript/documentation/blob/master/errors/TypesDoNotUnify.md for more information,
+  or to contribute content related to this error.
 

tests/purs/failing/1310.out

@@ -1,25 +1,26 @@
-Error found:
-in module Issue1310
-at tests/purs/failing/1310.purs:18:8 - 18:31 (line 18, column 8 - line 18, column 31)
+Error found:
 
-  No type class instance was found for
-                           
-    Issue1310.Inject Oops  
-                     Effect
-                           
+  in module Issue1310
+  at tests/purs/failing/1310.purs:18:8 - 18:31 (line 18, column 8 - line 18, column 31)
 
-while applying a function inj
-  of type Inject @t0 t1 t2 => t1 t3 -> t2 t3
-  to argument Oops (log "Oops")
-while checking that expression inj (Oops (log "Oops"))
-  has type Effect Unit
-in value declaration main
+    No type class instance was found for
+                             
+      Issue1310.Inject Oops  
+                       Effect
+                             
 
-where t0 is an unknown type
-      t1 is an unknown type
-      t2 is an unknown type
-      t3 is an unknown type
+  while applying a function inj
+    of type Inject @t0 t1 t2 => t1 t3 -> t2 t3
+    to argument Oops (log "Oops")
+  while checking that expression inj (Oops (log "Oops"))
+    has type Effect Unit
+  in value declaration main
 
-See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,
-or to contribute content related to this error.
+  where t0 is an unknown type
+        t1 is an unknown type
+        t2 is an unknown type
+        t3 is an unknown type
+
+  See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,
+  or to contribute content related to this error.
 

tests/purs/failing/1570.out

@@ -1,23 +1,24 @@
-Error found:
-in module M
-at tests/purs/failing/1570.purs:6:10 - 6:16 (line 6, column 10 - line 6, column 16)
+Error found:
 
-  In a type-annotated expression x :: t, the type t must have kind Type.
-  The error arises from the type
-     
-    F
-     
-  having the kind
-                
-    Type -> Type
-                
-  instead.
+  in module M
+  at tests/purs/failing/1570.purs:6:10 - 6:16 (line 6, column 10 - line 6, column 16)
 
-while inferring the type of \$0 ->      
-                              case $0 of
-                                x -> x  
-in value declaration test
+    In a type-annotated expression x :: t, the type t must have kind Type.
+    The error arises from the type
+       
+      F
+       
+    having the kind
+                  
+      Type -> Type
+                  
+    instead.
 
-See https://github.com/purescript/documentation/blob/master/errors/ExpectedType.md for more information,
-or to contribute content related to this error.
+  while inferring the type of \$0 ->      
+                                case $0 of
+                                  x -> x  
+  in value declaration test
+
+  See https://github.com/purescript/documentation/blob/master/errors/ExpectedType.md for more information,
+  or to contribute content related to this error.
 

tests/purs/failing/1733.out

@@ -1,10 +1,11 @@
-Error found:
-in module Main
-at tests/purs/failing/1733.purs:6:8 - 6:25 (line 6, column 8 - line 6, column 25)
+Error found:
 
-  Unknown value Thing.doesntExist
+  in module Main
+  at tests/purs/failing/1733.purs:6:8 - 6:25 (line 6, column 8 - line 6, column 25)
 
+    Unknown value Thing.doesntExist
 
-See https://github.com/purescript/documentation/blob/master/errors/UnknownName.md for more information,
-or to contribute content related to this error.
+
+  See https://github.com/purescript/documentation/blob/master/errors/UnknownName.md for more information,
+  or to contribute content related to this error.
 

tests/purs/failing/1825.out

@@ -1,10 +1,11 @@
-Error found:
-in module Main
-at tests/purs/failing/1825.purs:8:11 - 8:12 (line 8, column 11 - line 8, column 12)
+Error found:
 
-  Unknown value a
+  in module Main
+  at tests/purs/failing/1825.purs:8:11 - 8:12 (line 8, column 11 - line 8, column 12)
 
+    Unknown value a
 
-See https://github.com/purescript/documentation/blob/master/errors/UnknownName.md for more information,
-or to contribute content related to this error.
+
+  See https://github.com/purescript/documentation/blob/master/errors/UnknownName.md for more information,
+  or to contribute content related to this error.
 

tests/purs/failing/1881.out

@@ -1,10 +1,11 @@
-Error found:
-at tests/purs/failing/1881.purs:5:1 - 5:1 (line 5, column 1 - line 5, column 1)
+Error found:
 
-  Unable to parse module:
-  Unexpected or mismatched indentation
+  at tests/purs/failing/1881.purs:5:1 - 5:1 (line 5, column 1 - line 5, column 1)
 
+    Unable to parse module:
+    Unexpected or mismatched indentation
 
-See https://github.com/purescript/documentation/blob/master/errors/ErrorParsingModule.md for more information,
-or to contribute content related to this error.
+
+  See https://github.com/purescript/documentation/blob/master/errors/ErrorParsingModule.md for more information,
+  or to contribute content related to this error.
 

tests/purs/failing/2109-bind.out

@@ -1,10 +1,11 @@
-Error found:
-in module Main
-at tests/purs/failing/2109-bind.purs:8:3 - 8:14 (line 8, column 3 - line 8, column 14)
+Error found:
 
-  Unknown value bind. You're probably using do-notation, which the compiler replaces with calls to the bind function. Please import bind from module Prelude
+  in module Main
+  at tests/purs/failing/2109-bind.purs:8:3 - 8:14 (line 8, column 3 - line 8, column 14)
 
+    Unknown value bind. You're probably using do-notation, which the compiler replaces with calls to the bind function. Please import bind from module Prelude
 
-See https://github.com/purescript/documentation/blob/master/errors/UnknownName.md for more information,
-or to contribute content related to this error.
+
+  See https://github.com/purescript/documentation/blob/master/errors/UnknownName.md for more information,
+  or to contribute content related to this error.