error message tweaks

lib/Quox/Parser/FromParser.idr

@@ -251,7 +251,7 @@ fromPBaseNameNS name = pure $ addMods !(getAt NS) $ fromPBaseName name
 private
 injTC : (Has (StateL DEFS Definitions) fs, Has (Except Error) fs) =>
         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
 fromPDef : (Has (StateL DEFS Definitions) fs,
@@ -317,7 +317,7 @@ parameters {auto _ : (Has IO fs,
   loadProcessFile file =
     case !(loadFile file) of
       Just inp => do
-        tl <- either (throw . ParseError) pure $ lexParseInput inp
+        tl <- either (throw . WrapParseError file) pure $ lexParseInput inp
         concat <$> traverse fromPTopLevel tl
       Nothing => pure []
 

lib/Quox/Parser/FromParser/Error.idr

@@ -7,6 +7,15 @@ import System.File
 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
 data Error =
     AnnotationNeeded (NameContexts d n) (Term d n)
@@ -15,15 +24,36 @@ data Error =
   | DimNotInScope PBaseName
   | QtyNotGlobal Qty
   | DimNameInTerm PBaseName
-  | TypeError Typing.Error
+  | WrapTypeError TypeError
   | LoadError String FileError
-  | ParseError Parser.Error
-%hide Typing.Error
-%hide Lexer.Error
-%hide Parser.Error
+  | WrapParseError String ParseError
 
 
 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
   prettyError : Error -> Doc HL
   prettyError (AnnotationNeeded ctx tm) =
@@ -48,11 +78,11 @@ parameters (unicode, showContext : Bool)
     sep ["dimension variable", pretty0 unicode $ DV $ fromString i,
          "used in a term context"]
 
-  prettyError (TypeError err) =
+  prettyError (WrapTypeError err) =
     Typing.prettyError unicode showContext $ trimContext 2 err
 
   prettyError (LoadError str err) =
     vsep [hsep ["couldn't load file", pretty str], fromString $ show err]
 
-  prettyError (ParseError err) =
-    pretty $ show err
+  prettyError (WrapParseError file err) =
+    prettyParseError file err