1
1
mirror of https://github.com/github/semantic.git synced 2024-12-29 18:06:14 +03:00

showError returns a String.

This commit is contained in:
Rob Rix 2017-06-06 09:45:23 -04:00
parent f5e8aaf92a
commit 9a650fbb51
2 changed files with 4 additions and 2 deletions

View File

@ -88,6 +88,7 @@ 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)
@ -168,12 +169,13 @@ data ErrorCause symbol
deriving (Eq, Show)
-- | Pretty-print an Error with reference to the source where it occurred.
showError :: Show symbol => Source.Source -> Error symbol -> ShowS
showError :: Show symbol => Source.Source -> Error symbol -> 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 context -- actualLines results include line endings, so no newline here
. showString (replicate (succ (Info.column errorPos + lineNumberDigits)) ' ') . withSGRCode [SetColor Foreground Vivid Green] (showChar '^') . showChar '\n'
. showString (prettyCallStack callStack) . showChar '\n'
$ ""
where context = maybe "\n" (toS . 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)))

View File

@ -66,7 +66,7 @@ runParser parser = case parser of
let Result err term = assign assignment source ast
case term of
Just term -> do
traverse_ (putStr . ($ "") . showError source) (toList err <> termErrors term)
traverse_ (putStr . showError source) (toList err <> termErrors term)
pure term
Nothing -> pure (errorTerm source err)
TreeSitterParser language tslanguage -> treeSitterParser language tslanguage