From c8665969551647e92093e36cf4d7bc73f276d5f1 Mon Sep 17 00:00:00 2001 From: joshvera Date: Fri, 16 Jun 2017 15:56:14 -0400 Subject: [PATCH] print colorized errors to stderr if attached to a tty --- src/Data/Syntax/Assignment.hs | 30 ++++++++++++++++++++---------- src/Parser.hs | 17 +++++++++++------ 2 files changed, 31 insertions(+), 16 deletions(-) diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs index b1883c91f..ab831d2bf 100644 --- a/src/Data/Syntax/Assignment.hs +++ b/src/Data/Syntax/Assignment.hs @@ -75,7 +75,7 @@ module Data.Syntax.Assignment , Result(..) , Error(..) , ErrorCause(..) -, showError +, printError , showExpectation -- Running , assign @@ -94,14 +94,15 @@ import qualified Data.IntMap.Lazy as IntMap import Data.Ix (inRange) import Data.List.NonEmpty (nonEmpty) import Data.Record -import Data.String import GHC.Stack import qualified Info import Prologue hiding (Alt, get, Location, state) import Range (offsetRange) import qualified Source (Source(..), drop, slice, sourceText, actualLines) +import System.Console.ANSI import Text.Parser.TreeSitter.Language import Text.Show hiding (show) +import System.IO (hIsTerminalDevice, hPutStr) -- | Assignment from an AST with some set of 'symbol's onto some other value. -- @@ -180,18 +181,27 @@ data ErrorCause grammar deriving (Eq, Show) -- | Pretty-print an Error with reference to the source where it occurred. -showError :: Show grammar => Source.Source -> Error grammar -> String -showError source error@Error{..} - = withSGRCode [SetConsoleIntensity BoldIntensity] (showSourcePos Nothing errorPos) . showString ": " . withSGRCode [SetColor Foreground Vivid Red] (showString "error") . showString ": " . showExpectation error . showChar '\n' - . showString (toS context) . (if isSuffixOf "\n" context then identity else showChar '\n') - . showString (replicate (succ (Info.column errorPos + lineNumberDigits)) ' ') . withSGRCode [SetColor Foreground Vivid Green] (showChar '^') . showChar '\n' - . showString (prettyCallStack callStack) - $ "" +printError :: Show grammar => Source.Source -> Error grammar -> IO () +printError source error@Error{..} + = do + + _ <- withSGRCode [SetConsoleIntensity BoldIntensity] (showSourcePos Nothing errorPos) . showString ": " $ "" + _ <- withSGRCode [SetColor Foreground Vivid Red] (showString "error") . showString ": " . showExpectation error . showChar '\n' . showString (toS context) . (if isSuffixOf "\n" context then identity else showChar '\n') $ "" + + _ <- withSGRCode [SetConsoleIntensity BoldIntensity] (showSourcePos Nothing errorPos) . showString ": " $ "" + _ <- withSGRCode [SetColor Foreground Vivid Red] (showString "error") . showString ": " . showExpectation error . showChar '\n' . showString (toS context) . (if isSuffixOf "\n" context then identity else showChar '\n') . showString (replicate (succ (Info.column errorPos + lineNumberDigits)) ' ') $ "" + withSGRCode [SetColor Foreground Vivid Green] (showChar '^') . showChar '\n' . showString (prettyCallStack callStack) $ "" + where context = maybe "\n" (Source.sourceText . sconcat) (nonEmpty [ Source.Source (toS (showLineNumber i)) <> Source.Source ": " <> l | (i, l) <- zip [1..] (Source.actualLines source), inRange (Info.line errorPos - 2, Info.line errorPos) i ]) showLineNumber n = let s = show n in replicate (lineNumberDigits - length s) ' ' <> s lineNumberDigits = succ (floor (logBase 10 (fromIntegral (Info.line errorPos) :: Double))) showSGRCode = showString . setSGRCode - withSGRCode code s = showSGRCode code . s . showSGRCode [] + withSGRCode code showS s = do + isTerm <- hIsTerminalDevice stderr + hPutStr stderr $ if isTerm then + (showSGRCode code . showS . showSGRCode []) s + else + showS s showExpectation :: Show grammar => Error grammar -> ShowS showExpectation Error{..} = case errorCause of diff --git a/src/Parser.hs b/src/Parser.hs index b1b659fe4..8fafe2126 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -26,7 +26,7 @@ import qualified Language.Ruby.Syntax as Ruby import Prologue hiding (Location) import Source import Syntax hiding (Go) -import System.IO (hPutStrLn) +import System.IO (hPutStrLn, hIsTerminalDevice) import System.Console.ANSI import Term import qualified Text.Parser.TreeSitter as TS @@ -82,20 +82,25 @@ runParser parser = case parser of AssignmentParser parser by assignment -> \ source -> do ast <- runParser parser source let Result err term = assignBy by assignment source ast - traverse_ (hPutStrLn stderr . showError source) (toList err) + traverse_ (printError source) (toList err) case term of Just term -> do let errors = termErrors term `asTypeOf` toList err - traverse_ (hPutStrLn stderr . showError source) errors - unless (Prologue.null errors) $ - hPutStrLn stderr (withSGRCode [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Red] (shows (Prologue.length errors) . showChar ' ' . showString (if Prologue.length errors == 1 then "error" else "errors")) $ "") + traverse_ (printError source) errors + unless (Prologue.null errors) $ do + printErrors [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Red] (shows (Prologue.length errors) . showChar ' ' . showString (if Prologue.length errors == 1 then "error" else "errors")) $ "" pure term Nothing -> pure (errorTerm source err) TreeSitterParser language tslanguage -> treeSitterParser language tslanguage MarkdownParser -> pure . cmarkParser LineByLineParser -> lineByLineParser where showSGRCode = showString . setSGRCode - withSGRCode code s = showSGRCode code . s . showSGRCode [] + printErrors code showS s = do + isTerm <- hIsTerminalDevice stderr + hPutStrLn stderr $ if isTerm then + (showSGRCode code . showS . showSGRCode []) s + else + showS s errorTerm :: Syntax.Error (Error grammar) :< fs => Source -> Maybe (Error grammar) -> Term (Union fs) (Record Location) errorTerm source err = cofree ((totalRange source :. totalSpan source :. Nil) :< inj (Syntax.Error (fromMaybe (Error (SourcePos 0 0) (UnexpectedEndOfInput [])) err)))