mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 10:35:57 +03:00
Generalize to pretty text
This commit is contained in:
parent
4d2cec6f4e
commit
19b8131777
@ -16,6 +16,7 @@ where
|
||||
|
||||
import Control.Lens ((%~))
|
||||
import Control.Lens.Tuple (_1, _2, _3)
|
||||
import Data.Foldable qualified as Foldable
|
||||
import Data.Function (on)
|
||||
import Data.List (find, intersperse, sortBy)
|
||||
import Data.List.Extra (nubOrd)
|
||||
@ -1498,19 +1499,42 @@ renderParseErrors s = \case
|
||||
"",
|
||||
style ErrorSite msg
|
||||
]
|
||||
P.TrivialError errOffset unexpected expected ->
|
||||
let (src, ranges) = case unexpected of
|
||||
Just (P.Tokens (toList -> ts)) -> case ts of
|
||||
[] -> (mempty, [])
|
||||
_ ->
|
||||
let rs = rangeForToken <$> ts
|
||||
in (showSource s $ (\r -> (r, ErrorSite)) <$> rs, rs)
|
||||
_ -> mempty
|
||||
-- Same error that we just pattern matched on, but with a different error component (here Void) - we need one
|
||||
-- with a ShowErrorComponent instance, which our error type doesn't have.
|
||||
sameErr :: P.ParseError Parser.Input Void
|
||||
sameErr = P.TrivialError errOffset unexpected expected
|
||||
in [(fromString (P.parseErrorPretty sameErr) <> src, ranges)]
|
||||
P.TrivialError _errOffset unexpected expected ->
|
||||
let unexpectedTokens :: Maybe (Nel.NonEmpty (L.Token L.Lexeme))
|
||||
unexpectedTokenStrs :: Set String
|
||||
(unexpectedTokens, unexpectedTokenStrs) = case unexpected of
|
||||
Just (P.Tokens ts) ->
|
||||
Foldable.toList ts
|
||||
& fmap (L.displayLexeme . L.payload)
|
||||
& Set.fromList
|
||||
& (Just ts,)
|
||||
Just (P.Label ts) -> (mempty, Set.singleton $ Foldable.toList ts)
|
||||
Just (P.EndOfInput) -> (mempty, Set.singleton "end of input")
|
||||
Nothing -> (mempty, mempty)
|
||||
expectedTokenStrs :: Set String
|
||||
expectedTokenStrs =
|
||||
expected & foldMap \case
|
||||
(P.Tokens ts) ->
|
||||
Foldable.toList ts
|
||||
& fmap (L.displayLexeme . L.payload)
|
||||
& Set.fromList
|
||||
(P.Label ts) -> Set.singleton $ Foldable.toList ts
|
||||
(P.EndOfInput) -> Set.singleton "end of input"
|
||||
ranges = case unexpectedTokens of
|
||||
Nothing -> []
|
||||
Just ts -> rangeForToken <$> Foldable.toList ts
|
||||
excerpt = showSource s ((\r -> (r, ErrorSite)) <$> ranges)
|
||||
msg = L.formatTrivialError _ unexpectedTokenStrs expectedTokenStrs
|
||||
in [ ( Pr.lines
|
||||
[ "I got confused here:",
|
||||
"",
|
||||
excerpt,
|
||||
"",
|
||||
style ErrorSite msg
|
||||
],
|
||||
ranges
|
||||
)
|
||||
]
|
||||
P.FancyError _sp fancyErrors ->
|
||||
(go' <$> Set.toList fancyErrors)
|
||||
where
|
||||
|
@ -22,6 +22,10 @@ module Unison.Syntax.Lexer
|
||||
wordyIdChar,
|
||||
wordyIdStartChar,
|
||||
symbolyIdChar,
|
||||
|
||||
-- * Error formatting
|
||||
formatTrivialError,
|
||||
displayLexeme,
|
||||
)
|
||||
where
|
||||
|
||||
@ -50,6 +54,7 @@ import Unison.NameSegment (NameSegment)
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.Prelude
|
||||
import Unison.ShortHash (ShortHash)
|
||||
import Unison.ShortHash qualified as SH
|
||||
import Unison.Syntax.HashQualified' qualified as HQ' (toText)
|
||||
import Unison.Syntax.Lexer.Token (Token (..), posP, tokenP)
|
||||
import Unison.Syntax.Name qualified as Name (isSymboly, nameP, toText, unsafeParseText)
|
||||
@ -267,17 +272,21 @@ lexer0' scope rem =
|
||||
let msg = intercalateMap "\n" showErrorFancy es
|
||||
in [Token (Err (UnexpectedTokens msg)) (toPos top) (toPos top)]
|
||||
P.TrivialError _errOffset mayUnexpectedTokens expectedTokens ->
|
||||
let mayUnexpectedStr :: Maybe String
|
||||
mayUnexpectedStr = errorItemToString <$> mayUnexpectedTokens
|
||||
let unexpectedStr :: Set String
|
||||
unexpectedStr =
|
||||
mayUnexpectedTokens
|
||||
& fmap errorItemToString
|
||||
& maybeToList
|
||||
& Set.fromList
|
||||
expectedStr :: Set String
|
||||
expectedStr =
|
||||
expectedTokens
|
||||
& Set.map errorItemToString
|
||||
err = UnexpectedTokens $ case (mayUnexpectedStr, Set.toList expectedStr) of
|
||||
(Nothing, []) -> "I found something I didn't expect."
|
||||
(Nothing, xs) -> "I found something I didn't expect here. I was hoping for one of these instead:\n\n* " <> List.intercalate "\n* " xs
|
||||
(Just x, []) -> "I was surprised to find the text '" <> x <> "' here."
|
||||
(Just x, xs) -> "I was surprised to find the text '" <> x <> "' here. I was hoping for one of these instead:\n\n* " <> List.intercalate "\n* " xs
|
||||
startsWithVowel :: String -> Bool
|
||||
startsWithVowel = \case
|
||||
[] -> False
|
||||
(ch : _) -> ch `elem` ("aeiou" :: String)
|
||||
err = UnexpectedTokens $ formatTrivialError startsWithVowel unexpectedStr expectedStr
|
||||
in [Token (Err err) (toPos top) (toPos top)]
|
||||
in errsWithSourcePos >>= errorToTokens
|
||||
Right ts -> Token (Open scope) topLeftCorner topLeftCorner : tweak ts
|
||||
@ -313,6 +322,46 @@ lexer0' scope rem =
|
||||
tweak (h : t) = h : tweak t
|
||||
isSigned num = all (\ch -> ch == '-' || ch == '+') $ take 1 num
|
||||
|
||||
formatTrivialError ::
|
||||
(IsString s, Monoid s) =>
|
||||
-- | A function that returns True if the given string starts with a vowel,
|
||||
-- Used for selecting the correct article.
|
||||
(s -> Bool) ->
|
||||
Set s ->
|
||||
Set s ->
|
||||
s
|
||||
formatTrivialError startsWithVowel unexpectedTokens expectedTokens =
|
||||
let unexpectedMsg = case Set.toList unexpectedTokens of
|
||||
[] -> "I found something I didn't expect."
|
||||
[x] ->
|
||||
let article =
|
||||
if startsWithVowel x
|
||||
then "an"
|
||||
else "a"
|
||||
in "I was surprised to find " <> article <> " " <> x <> " here."
|
||||
xs -> "I was surprised to find these:\n\n* " <> intercalateMap "\n* " id xs
|
||||
expectedMsg = case Set.toList expectedTokens of
|
||||
[] -> Nothing
|
||||
xs -> Just $ "\nI was hoping for one of these instead:\n\n* " <> intercalateMap "\n* " id xs
|
||||
in mconcat $ catMaybes [Just unexpectedMsg, expectedMsg]
|
||||
|
||||
displayLexeme :: Lexeme -> String
|
||||
displayLexeme = \case
|
||||
Open o -> o
|
||||
Semi True -> "end of section"
|
||||
Semi False -> "semicolon"
|
||||
Close -> "end of section"
|
||||
Reserved r -> "'" <> r <> "'"
|
||||
Textual t -> "\"" <> t <> "\""
|
||||
Character c -> "?" <> [c]
|
||||
WordyId hq -> Text.unpack (HQ'.toTextWith Name.toText hq)
|
||||
SymbolyId hq -> Text.unpack (HQ'.toTextWith Name.toText hq)
|
||||
Blank b -> b
|
||||
Numeric n -> n
|
||||
Bytes _b -> "bytes literal"
|
||||
Hash h -> Text.unpack (SH.toText h)
|
||||
Err e -> show e
|
||||
|
||||
infixl 2 <+>
|
||||
|
||||
(<+>) :: (Monoid a) => P a -> P a -> P a
|
||||
|
Loading…
Reference in New Issue
Block a user