github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-30 02:14:20 +03:00
Code Issues Projects Releases Wiki Activity

Add an option to disable the display of source.

Browse Source
This commit is contained in:
Rob Rix 2017-07-21 14:17:34 -04:00
parent 72385b8a93
commit b8ebbd2a3d
1 changed files with 10 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/Data/Syntax/Assignment.hs
View File

@ -194,40 +194,44 @@ data ErrorCause grammar
-- | Options for printing errors.
data Options = Options
{ optionsColour :: Bool -- ^ Whether to use colour formatting codes suitable for a terminal device.
, optionsIncludeSource :: Bool -- ^ Whether to include the source reference.
}
defaultOptions :: Options
defaultOptions = Options
{ optionsColour = True
, optionsIncludeSource = True
}
optionsForHandle :: Handle -> IO Options
optionsForHandle handle = do
isTerminal <- hIsTerminalDevice handle
pure $ Options
pure $ defaultOptions
{ optionsColour = isTerminal
}
-- | Pretty-print an 'Error' to stdout with reference to the source where it occurred.
-- | Pretty-print an 'Error' to stderr, optionally with reference to the source where it occurred.
printError :: Show grammar => Blob -> Error grammar -> IO ()
printError blob error = do
options <- optionsForHandle stderr
hPutStr stderr $ formatErrorWithOptions options blob error
-- | Format an 'Error' with reference to the source where it occurred.
-- | Format an 'Error', optionally with reference to the source where it occurred.
--
-- > formatError = formatErrorWithOptions defaultOptions
formatError :: Show grammar => Blob -> Error grammar -> ByteString
formatError = formatErrorWithOptions defaultOptions
-- | Format an 'Error' with reference
-- | Format an 'Error', optionally with reference to the source where it occurred.
formatErrorWithOptions :: Show grammar => Options -> Blob -> Error grammar -> ByteString
formatErrorWithOptions options Blob{..} error@Error{..}
= toS . ($ "")
$ withSGRCode options [SetConsoleIntensity BoldIntensity] (showPos (maybe Nothing (const (Just blobPath)) blobKind) errorPos . showString ": ")
. withSGRCode options [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.posColumn errorPos + lineNumberDigits)) ' ')
. withSGRCode options [SetColor Foreground Vivid Green] (showChar '^' . showChar '\n')
. (if optionsIncludeSource options
then showString (toS context) . (if isSuffixOf "\n" context then identity else showChar '\n')
. showString (replicate (succ (Info.posColumn errorPos + lineNumberDigits)) ' ') . withSGRCode options [SetColor Foreground Vivid Green] (showChar '^' . showChar '\n')
else identity)
. showString (prettyCallStack callStack) . showChar '\n'
where context = maybe "\n" (Source.sourceBytes . sconcat) (nonEmpty [ Source.fromBytes (toS (showLineNumber i)) <> Source.fromBytes ": " <> l | (i, l) <- zip [1..] (Source.sourceLines blobSource), inRange (Info.posLine errorPos - 2, Info.posLine errorPos) i ])
showLineNumber n = let s = show n in replicate (lineNumberDigits - length s) ' ' <> s