Skip to content

Commit

Permalink
Merge pull request #4641 from unisonweb/runarorama/improve-tdnr-message
Browse files Browse the repository at this point in the history 
Make errors nicer when TDNR fails
  • Loading branch information
@aryairani
aryairani authored Jan 26, 2024
2 parents aec8aec + 9ad4583 commit 0437666
Show file tree
Hide file tree
Showing 13 changed files with 271 additions and 220 deletions.
2 changes: 1 addition & 1 deletion lib/unison-pretty-printer/src/Unison/Util/Pretty.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -229,7 +229,7 @@ wrapImplPreserveSpaces = \case
(Lit s) -> fromMaybe False (fmap (isSpaceNotNewline . fst) $ LL.uncons s)
_ -> False
f p | startsWithSpace p = p `orElse` newline
f p = p
f p = p `orElse` (newline <> p)

isSpaceNotNewline :: Char -> Bool
isSpaceNotNewline c = isSpace c && not (c == '\n')
Expand Down
243 changes: 154 additions & 89 deletions parser-typechecker/src/Unison/PrintError.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,10 +4,12 @@ module Unison.PrintError where

import Control.Lens ((%~))
import Control.Lens.Tuple (_1, _2, _3)
import Data.List (find, intersperse)
import Data.Function (on)
import Data.List (find, intersperse, sortBy)
import Data.List.Extra (nubOrd)
import Data.List.NonEmpty qualified as Nel
import Data.Map qualified as Map
import Data.Ord (comparing)
import Data.Proxy
import Data.Sequence (Seq (..))
import Data.Set qualified as Set
Expand Down Expand Up @@ -35,7 +37,7 @@ import Unison.Prelude
import Unison.PrettyPrintEnv qualified as PPE
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.Reference qualified as R
import Unison.Referent (Referent, pattern Ref)
import Unison.Referent (Referent, toReference, pattern Ref)
import Unison.Result (Note (..))
import Unison.Result qualified as Result
import Unison.Settings qualified as Settings
Expand Down Expand Up @@ -171,9 +173,8 @@ renderTypeError ::
TypeError v loc ->
Env ->
String ->
Path.Absolute ->
Pretty ColorText
renderTypeError e env src curPath = case e of
renderTypeError e env src = case e of
BooleanMismatch {..} ->
mconcat
[ Pr.wrap $
Expand Down Expand Up @@ -629,51 +630,112 @@ renderTypeError e env src curPath = case e of
_ -> Pr.wrap $ "It should be of type " <> Pr.group (style Type1 (renderType' env expectedType) <> ".")
UnknownTerm {..} ->
let (correct, wrongTypes, wrongNames) =
foldr sep id suggestions ([], [], [])
sep (C.Suggestion name typ _ match) r =
foldr
sep
id
( sortBy
( comparing length <> compare
`on` (Text.splitOn "." . C.suggestionName)
)
suggestions
)
([], [], [])
sep s@(C.Suggestion _ _ _ match) r =
case match of
C.Exact -> (_1 %~ ((name, typ) :)) . r
C.WrongType -> (_2 %~ ((name, typ) :)) . r
C.WrongName -> (_3 %~ ((name, typ) :)) . r
libPath = Path.absoluteToPath' curPath Path.:> "lib"
C.Exact -> (_1 %~ (s :)) . r
C.WrongType -> (_2 %~ (s :)) . r
C.WrongName -> (_3 %~ (s :)) . r
undefinedSymbolHelp =
mconcat
[ ( case expectedType of
Type.Var' (TypeVar.Existential {}) ->
Pr.wrap "I also don't know what type it should be."
_ ->
mconcat
[ Pr.wrap "I think its type should be:",
"\n\n",
Pr.indentN 4 (style Type1 (renderType' env expectedType))
]
),
"\n\n",
Pr.hang
"Some common causes of this error include:"
( Pr.bulleted
[ Pr.wrap "Your current namespace is too deep to contain the definition in its subtree",
Pr.wrap "The definition is part of a library which hasn't been added to this project",
Pr.wrap "You have a typo in the name"
]
)
]
in mconcat
[ "I couldn't find any definitions matching the name ",
[ "I couldn't figure out what ",
style ErrorSite (Var.nameStr unknownTermV),
" inside the namespace ",
prettyPath' (Path.absoluteToPath' curPath),
"\n\n",
" refers to here:\n\n",
annotatedAsErrorSite src termSite,
"\n",
Pr.hang
"Some common causes of this error include:"
( Pr.bulleted
[ Pr.wrap "Your current namespace is too deep to contain the definition in its subtree",
Pr.wrap "The definition is part of a library which hasn't been added to this project"
]
)
<> "\n\n"
<> "To add a library to this project use the command: "
<> Pr.backticked ("fork <.path.to.lib> " <> Pr.shown (libPath Path.:> "<libname>")),
"\n\n",
case expectedType of
Type.Var' (TypeVar.Existential {}) -> "There are no constraints on its type."
_ ->
"Whatever it is, its type should conform to "
<> style Type1 (renderType' env expectedType)
<> ".",
"\n\n",
-- ++ showTypeWithProvenance env src Type1 expectedType
case correct of
[] -> case wrongTypes of
[] -> case wrongNames of
[] -> mempty
[] -> undefinedSymbolHelp
wrongs -> formatWrongs wrongNameText wrongs
wrongs -> formatWrongs wrongTypeText wrongs
wrongs ->
let helpMeOut =
Pr.wrap
( mconcat
[ "Help me out by",
Pr.bold "using a more specific name here",
"or",
Pr.bold "adding a type annotation."
]
)
in Pr.wrap
( "The name "
<> style Identifier (Var.nameStr unknownTermV)
<> " is ambiguous. I tried to resolve it by type but"
)
<> " "
<> case expectedType of
Type.Var' (TypeVar.Existential {}) -> Pr.wrap ("its type could be anything." <> helpMeOut) <> "\n"
_ ->
mconcat
[ ( Pr.wrap $
mconcat
[ "no term with that name would pass typechecking.",
"I think its type should be:"
]
),
"\n\n",
Pr.indentN 4 (style Type1 (renderType' env expectedType)),
"\n\n",
Pr.wrap
( mconcat
[ "If that's not what you expected, you may have a type error somewhere else in your code.",
helpMeOut
]
)
]
<> "\n\n"
<> formatWrongs wrongTypeText wrongs
suggs ->
mconcat
[ "I found some terms in scope that have matching names and types. ",
"Maybe you meant one of these:\n\n",
intercalateMap "\n" formatSuggestion suggs
[ Pr.wrap
( mconcat
[ mconcat
[ "The name ",
style Identifier (Var.nameStr unknownTermV),
" is ambiguous. "
],
case expectedType of
Type.Var' (TypeVar.Existential {}) -> "I couldn't narrow it down by type, as any type would work here."
_ ->
"Its type should be:\n\n"
<> Pr.indentN 4 (style Type1 (renderType' env expectedType))
]
),
"\n\n",
Pr.wrap "I found some terms in scope that have matching names and types. Maybe you meant one of these:",
"\n\n",
intercalateMap "\n" (renderSuggestion env) suggs
]
]
DuplicateDefinitions {..} ->
Expand Down Expand Up @@ -735,47 +797,48 @@ renderTypeError e env src curPath = case e of
]
where
wrongTypeText pl =
mconcat
[ "I found ",
pl "a term" "some terms",
" in scope with ",
pl "a " "",
"matching name",
pl "" "s",
" but ",
pl "a " "",
"different type",
pl "" "s",
". ",
"If ",
pl "this" "one of these",
" is what you meant, try using the fully qualified name and I might ",
"be able to give you a more illuminating error message: \n\n"
]
Pr.paragraphyText
( mconcat
[ "I found ",
pl "a term" "some terms",
" in scope with ",
pl "a " "",
"matching name",
pl "" "s",
" but ",
pl "a " "",
"different type",
pl "" "s",
". ",
"If ",
pl "this" "one of these",
" is what you meant, try using its full name:"
]
)
<> "\n\n"
wrongNameText pl =
mconcat
[ "I found ",
pl "a term" "some terms",
" in scope with ",
pl "a " "",
"matching type",
pl "" "s",
" but ",
pl "a " "",
"different name",
pl "" "s",
". ",
"Maybe you meant ",
pl "this" "one of these",
":\n\n"
]
formatSuggestion :: (Text, C.Type v loc) -> Pretty ColorText
formatSuggestion (name, typ) =
" - " <> fromString (Text.unpack name) <> " : " <> renderType' env typ
Pr.paragraphyText
( mconcat
[ "I found ",
pl "a term" "some terms",
" in scope with ",
pl "a " "",
"matching type",
pl "" "s",
" but ",
pl "a " "",
"different name",
pl "" "s",
". ",
"Maybe you meant ",
pl "this" "one of these",
":\n\n"
]
)
formatWrongs txt wrongs =
let sz = length wrongs
pl a b = if sz == 1 then a else b
in mconcat [txt pl, intercalateMap "\n" formatSuggestion wrongs]
in mconcat [txt pl, intercalateMap "\n" (renderSuggestion env) wrongs]
ordinal :: (IsString s) => Int -> s
ordinal n =
fromString $
Expand Down Expand Up @@ -1134,7 +1197,12 @@ renderType env f t = renderType0 env f (0 :: Int) (cleanup t)
renderSuggestion ::
(IsString s, Semigroup s, Var v) => Env -> C.Suggestion v loc -> s
renderSuggestion env sug =
fromString (Text.unpack $ C.suggestionName sug)
renderTerm
env
( case C.suggestionReplacement sug of
Right ref -> Term.ref () (toReference ref)
Left v -> Term.var () v
)
<> " : "
<> renderType'
env
Expand Down Expand Up @@ -1242,10 +1310,9 @@ renderNoteAsANSI ::
Pr.Width ->
Env ->
String ->
Path.Absolute ->
Note v a ->
String
renderNoteAsANSI w e s curPath n = Pr.toANSI w $ printNoteWithSource e s curPath n
renderNoteAsANSI w e s n = Pr.toANSI w $ printNoteWithSource e s n

renderParseErrorAsANSI :: (Var v) => Pr.Width -> String -> Parser.Err v -> String
renderParseErrorAsANSI w src = Pr.toANSI w . prettyParseError src
Expand All @@ -1254,19 +1321,18 @@ printNoteWithSource ::
(Var v, Annotated a, Show a, Ord a) =>
Env ->
String ->
Path.Absolute ->
Note v a ->
Pretty ColorText
printNoteWithSource env _s _curPath (TypeInfo n) = prettyTypeInfo n env
printNoteWithSource _env s _curPath (Parsing e) = prettyParseError s e
printNoteWithSource env s curPath (TypeError e) = prettyTypecheckError e env s curPath
printNoteWithSource _env _s _curPath (NameResolutionFailures _es) = undefined
printNoteWithSource _env s _curPath (UnknownSymbol v a) =
printNoteWithSource env _s (TypeInfo n) = prettyTypeInfo n env
printNoteWithSource _env s (Parsing e) = prettyParseError s e
printNoteWithSource env s (TypeError e) = prettyTypecheckError e env s
printNoteWithSource _env _s (NameResolutionFailures _es) = undefined
printNoteWithSource _env s (UnknownSymbol v a) =
fromString ("Unknown symbol `" ++ Text.unpack (Var.name v) ++ "`\n\n")
<> annotatedAsErrorSite s a
printNoteWithSource env s _curPath (CompilerBug (Result.TypecheckerBug c)) =
printNoteWithSource env s (CompilerBug (Result.TypecheckerBug c)) =
renderCompilerBug env s c
printNoteWithSource _env _s _curPath (CompilerBug c) =
printNoteWithSource _env _s (CompilerBug c) =
fromString $ "Compiler bug: " <> show c

_printPosRange :: String -> L.Pos -> L.Pos -> String
Expand Down Expand Up @@ -1877,10 +1943,9 @@ prettyTypecheckError ::
C.ErrorNote v loc ->
Env ->
String ->
Path.Absolute ->
Pretty ColorText
prettyTypecheckError note env src curPath =
renderTypeError (typeErrorFromNote note) env src curPath
prettyTypecheckError note env src =
renderTypeError (typeErrorFromNote note) env src

prettyTypeInfo ::
(Var v, Ord loc, Show loc, Parser.Annotated loc) =>
Expand Down
3 changes: 1 addition & 2 deletions parser-typechecker/src/Unison/Runtime/IOSource.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,6 @@ import Text.RawString.QQ (r)
import Unison.Builtin qualified as Builtin
import Unison.Codebase.CodeLookup (CodeLookup (..))
import Unison.Codebase.CodeLookup.Util qualified as CL
import Unison.Codebase.Path qualified as Path
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.DataDeclaration qualified as DD
import Unison.DataDeclaration.ConstructorId qualified as DD
Expand Down Expand Up @@ -1002,7 +1001,7 @@ type EitherResult = Either String TFile

showNotes :: (Foldable f) => String -> PrintError.Env -> f Note -> String
showNotes source env =
intercalateMap "\n\n" $ PrintError.renderNoteAsANSI 60 env source Path.absoluteEmpty
intercalateMap "\n\n" $ PrintError.renderNoteAsANSI 60 env source

ppEnv :: PPE.PrettyPrintEnv
ppEnv = PPE.makePPE (PPE.hqNamer 10 Builtin.names) PPE.dontSuffixify
3 changes: 1 addition & 2 deletions parser-typechecker/tests/Unison/Test/UnisonSources.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,6 @@ import System.Directory (doesFileExist)
import System.FilePath (joinPath, replaceExtension, splitPath)
import System.FilePath.Find (always, extension, find, (==?))
import Unison.Builtin qualified as Builtin
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.Runtime (Runtime, evaluateWatches)
import Unison.NamesWithHistory qualified as Names
import Unison.Parser.Ann (Ann)
Expand Down Expand Up @@ -89,7 +88,7 @@ go rt files how = do

showNotes :: (Foldable f) => String -> PrintError.Env -> f Note -> String
showNotes source env =
intercalateMap "\n\n" $ PrintError.renderNoteAsANSI 60 env source Path.absoluteEmpty
intercalateMap "\n\n" $ PrintError.renderNoteAsANSI 60 env source

decodeResult ::
String -> SynthResult -> EitherResult -- String (UF.TypecheckedUnisonFile Symbol Ann)
Expand Down
Loading

0 comments on commit 0437666

Please sign in to comment.