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

Merge pull request #1131 from github/technicolour

Browse Source 
Technicolour
This commit is contained in:
Rick Winfrey 2017-05-19 14:34:05 -07:00 committed by GitHub
commit 6216cfcec4
2 changed files with 9 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
semantic-diff.cabal
View File

@ -82,6 +82,7 @@ library
build-depends: base >= 4.8 && < 5
, aeson
, aeson-pretty
, ansi-terminal
, array
, async-pool
, async

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

@ -92,6 +92,7 @@ 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)
@ -166,10 +167,10 @@ data ErrorCause symbol
-- | Pretty-print an Error with reference to the source where it occurred.
showError :: Show symbol => Source.Source -> Error symbol -> ShowS
showError source Error{..}
= showSourcePos errorPos . showString ": error: " . showExpectation . showChar '\n'
. showString (prettyCallStack callStack) . showChar '\n'
= withSGRCode [SetConsoleIntensity BoldIntensity] (showSourcePos Nothing errorPos) . showString ": " . withSGRCode [SetColor Foreground Vivid Red] (showString "error") . showString ": " . showExpectation . showChar '\n'
. showString context -- actualLines results include line endings, so no newline here
. showString (replicate (succ (Info.column errorPos + lineNumberDigits)) ' ') . showChar '^' . showChar '\n'
. showString (replicate (succ (Info.column errorPos + lineNumberDigits)) ' ') . withSGRCode [SetColor Foreground Vivid Green] (showChar '^') . showChar '\n'
. showString (prettyCallStack callStack) . showChar '\n'
where showExpectation = case errorCause of
UnexpectedEndOfInput [] -> showString "no rule to match at end of input nodes"
UnexpectedEndOfInput symbols -> showString "expected " . showSymbols symbols . showString " at end of input nodes"
@ -178,6 +179,8 @@ showError source Error{..}
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)))
showSGRCode = showString . setSGRCode
withSGRCode code s = showSGRCode code . s . showSGRCode []
showSymbols :: Show symbol => [symbol] -> ShowS
showSymbols [] = showString "end of input nodes"
@ -186,8 +189,8 @@ showSymbols [a, b] = shows a . showString " or " . shows b
showSymbols [a, b, c] = shows a . showString ", " . shows b . showString ", or " . shows c
showSymbols (h:t) = shows h . showString ", " . showSymbols t
showSourcePos :: Info.SourcePos -> ShowS
showSourcePos Info.SourcePos{..} = shows line . showChar ':' . shows column
showSourcePos :: Maybe FilePath -> Info.SourcePos -> ShowS
showSourcePos path Info.SourcePos{..} = maybe (showParen True (showString "interactive")) showString path . showChar ':' . shows line . showChar ':' . shows column
-- | Run an assignment over an AST exhaustively.
assign :: (Symbol grammar, Enum grammar, Eq grammar, Show grammar, HasCallStack) => Assignment (Node grammar) a -> Source.Source -> AST grammar -> Result grammar a