error message tweaks

This commit is contained in:
rhiannon morris 2023-04-24 23:19:15 +02:00
parent b74ffa0077
commit adebfe090c
2 changed files with 40 additions and 10 deletions

View file

@ -251,7 +251,7 @@ fromPBaseNameNS name = pure $ addMods !(getAt NS) $ fromPBaseName name
private private
injTC : (Has (StateL DEFS Definitions) fs, Has (Except Error) fs) => injTC : (Has (StateL DEFS Definitions) fs, Has (Except Error) fs) =>
TC a -> Eff fs a TC a -> Eff fs a
injTC act = rethrow $ mapFst TypeError $ runTC !(getAt DEFS) act injTC act = rethrow $ mapFst WrapTypeError $ runTC !(getAt DEFS) act
export covering export covering
fromPDef : (Has (StateL DEFS Definitions) fs, fromPDef : (Has (StateL DEFS Definitions) fs,
@ -317,7 +317,7 @@ parameters {auto _ : (Has IO fs,
loadProcessFile file = loadProcessFile file =
case !(loadFile file) of case !(loadFile file) of
Just inp => do Just inp => do
tl <- either (throw . ParseError) pure $ lexParseInput inp tl <- either (throw . WrapParseError file) pure $ lexParseInput inp
concat <$> traverse fromPTopLevel tl concat <$> traverse fromPTopLevel tl
Nothing => pure [] Nothing => pure []

View file

@ -7,6 +7,15 @@ import System.File
import Quox.Pretty import Quox.Pretty
public export
TypeError, LexError, ParseError : Type
TypeError = Typing.Error
LexError = Lexer.Error
ParseError = Parser.Error
%hide Typing.Error
%hide Lexer.Error
%hide Parser.Error
public export public export
data Error = data Error =
AnnotationNeeded (NameContexts d n) (Term d n) AnnotationNeeded (NameContexts d n) (Term d n)
@ -15,15 +24,36 @@ data Error =
| DimNotInScope PBaseName | DimNotInScope PBaseName
| QtyNotGlobal Qty | QtyNotGlobal Qty
| DimNameInTerm PBaseName | DimNameInTerm PBaseName
| TypeError Typing.Error | WrapTypeError TypeError
| LoadError String FileError | LoadError String FileError
| ParseError Parser.Error | WrapParseError String ParseError
%hide Typing.Error
%hide Lexer.Error
%hide Parser.Error
parameters (unicode, showContext : Bool) parameters (unicode, showContext : Bool)
export
prettyBounds : String -> Bounds -> Doc HL
prettyBounds file (MkBounds l1 c1 l2 c2) =
hcat [hl Free $ pretty file, hl Delim ":",
hl TVar $ pretty l1, hl Delim ":",
hl DVar $ pretty c1, hl Delim "-",
hl TVar $ pretty l2, hl Delim ":",
hl DVar $ pretty c2]
export
prettyParseError1 : String -> ParsingError _ -> Doc HL
prettyParseError1 file (Error msg Nothing) =
pretty msg
prettyParseError1 file (Error msg (Just bounds)) =
asep [prettyBounds file bounds <+> hl Delim ":", pretty msg]
export
prettyParseError : String -> ParseError -> Doc HL
prettyParseError file (LexError err) =
vsep ["lexical error:", nest 2 $ pretty $ show err]
prettyParseError file (ParseError errs) =
vsep $ "parse error:" ::
map (("-" <++>) . prettyParseError1 file) (toList errs)
export export
prettyError : Error -> Doc HL prettyError : Error -> Doc HL
prettyError (AnnotationNeeded ctx tm) = prettyError (AnnotationNeeded ctx tm) =
@ -48,11 +78,11 @@ parameters (unicode, showContext : Bool)
sep ["dimension variable", pretty0 unicode $ DV $ fromString i, sep ["dimension variable", pretty0 unicode $ DV $ fromString i,
"used in a term context"] "used in a term context"]
prettyError (TypeError err) = prettyError (WrapTypeError err) =
Typing.prettyError unicode showContext $ trimContext 2 err Typing.prettyError unicode showContext $ trimContext 2 err
prettyError (LoadError str err) = prettyError (LoadError str err) =
vsep [hsep ["couldn't load file", pretty str], fromString $ show err] vsep [hsep ["couldn't load file", pretty str], fromString $ show err]
prettyError (ParseError err) = prettyError (WrapParseError file err) =
pretty $ show err prettyParseError file err