Fix ParseError. Add ShowErrorComponent to ParseError.

plutus-core/plutus-core/src/PlutusCore/Error.hs

@@ -43,6 +43,7 @@ import Data.Text qualified as T
 import ErrorCode
 import Prettyprinter (hardline, indent, squotes, (<+>))
 import Prettyprinter.Internal (Doc (Text))
+import Text.Megaparsec.Error (ShowErrorComponent, showErrorComponent)
 import Text.Megaparsec.Pos (SourcePos, sourcePosPretty)
 import Universe (Closed (Everywhere), GEq, GShow)
 
@@ -53,18 +54,18 @@ throwingEither r e = case e of
     Right v -> pure v
 
 -- | An error encountered during parsing.
-data ParseError ann
+data ParseError
     = LexErr String
     | Unexpected Token
-    | UnknownBuiltinType ann T.Text
-    | BuiltinTypeNotAStar ann T.Text
-    | UnknownBuiltinFunction ann T.Text
-    | InvalidBuiltinConstant ann T.Text T.Text
-    deriving (Eq, Ord, Generic, NFData, Functor)
+    | UnknownBuiltinType T.Text SourcePos
+    | BuiltinTypeNotAStar T.Text SourcePos
+    | UnknownBuiltinFunction T.Text SourcePos
+    | InvalidBuiltinConstant T.Text T.Text SourcePos
+    deriving (Eq, Ord, Generic, NFData)
 
 makeClassyPrisms ''ParseError
 
-instance Pretty ann => Show (ParseError ann)
+instance Show ParseError
     where
       show = show . pretty
 
@@ -99,15 +100,15 @@ data TypeError term uni fun ann
 makeClassyPrisms ''TypeError
 
 data Error uni fun ann
-    = ParseErrorE (ParseError ann)
+    = ParseErrorE ParseError
     | UniqueCoherencyErrorE (UniqueError ann)
     | TypeErrorE (TypeError (Term TyName Name uni fun ()) uni fun ann)
     | NormCheckErrorE (NormCheckError TyName Name uni fun ann)
     | FreeVariableErrorE FreeVariableError
     deriving (Show, Eq, Generic, NFData, Functor)
 makeClassyPrisms ''Error
 
-instance AsParseError (Error uni fun ann) ann where
+instance AsParseError (Error uni fun ann) where
     _ParseError = _ParseErrorE
 
 instance AsUniqueError (Error uni fun ann) ann where
@@ -126,13 +127,16 @@ instance AsFreeVariableError (Error uni fun ann) where
 instance Pretty SourcePos where
     pretty = pretty . sourcePosPretty
 
-instance Pretty ann => Pretty (ParseError ann) where
+instance Pretty ParseError where
     pretty (LexErr s)                       = "Lexical error:" <+> Text (length s) (T.pack s)
     pretty (Unexpected t)                   = "Unexpected" <+> squotes (pretty t) <+> "at" <+> pretty (tkLoc t)
-    pretty (UnknownBuiltinType loc s)       = "Unknown built-in type" <+> squotes (pretty s) <+> "at" <+> pretty loc
-    pretty (BuiltinTypeNotAStar loc ty)     = "Expected a type of kind star (to later parse a constant), but got:" <+> squotes (pretty ty) <+> "at" <+> pretty loc
-    pretty (UnknownBuiltinFunction loc s)   = "Unknown built-in function" <+> squotes (pretty s) <+> "at" <+> pretty loc
-    pretty (InvalidBuiltinConstant loc c s) = "Invalid constant" <+> squotes (pretty c) <+> "of type" <+> squotes (pretty s) <+> "at" <+> pretty loc
+    pretty (UnknownBuiltinType s loc)       = "Unknown built-in type" <+> squotes (pretty s) <+> "at" <+> pretty loc
+    pretty (BuiltinTypeNotAStar ty loc)     = "Expected a type of kind star (to later parse a constant), but got:" <+> squotes (pretty ty) <+> "at" <+> pretty loc
+    pretty (UnknownBuiltinFunction s loc)   = "Unknown built-in function" <+> squotes (pretty s) <+> "at" <+> pretty loc
+    pretty (InvalidBuiltinConstant c s loc) = "Invalid constant" <+> squotes (pretty c) <+> "of type" <+> squotes (pretty s) <+> "at" <+> pretty loc
+
+instance ShowErrorComponent ParseError where
+    showErrorComponent = show . pretty
 
 instance Pretty ann => Pretty (UniqueError ann) where
     pretty (MultiplyDefined u def redef) =
@@ -191,7 +195,7 @@ instance (GShow uni, Closed uni, uni `Everywhere` PrettyConst, Pretty fun, Prett
     prettyBy config (NormCheckErrorE e)       = prettyBy config e
     prettyBy _      (FreeVariableErrorE e)    = pretty e
 
-instance HasErrorCode (ParseError _a) where
+instance HasErrorCode ParseError where
     errorCode InvalidBuiltinConstant {} = ErrorCode 10
     errorCode UnknownBuiltinFunction {} = ErrorCode 9
     errorCode UnknownBuiltinType {}     = ErrorCode 8

plutus-core/plutus-ir/src/PlutusIR/Parser.hs

@@ -9,7 +9,7 @@ module PlutusIR.Parser
     , parse
     , parseQuoted
     , term
-    , typ
+    , pType
     , program
     , plcTerm
     , plcProgram
@@ -92,7 +92,7 @@ kindBinary :: Text -> (SourcePos -> TyName -> Kind SourcePos -> PType -> PType)
 kindBinary name f = Prefix (f <$ symbol name)
 
 varDecl :: Parser (VarDecl TyName Name DefaultUni DefaultFun SourcePos)
-varDecl = inParens $ VarDecl <$> wordPos "vardecl" <*> name <*> typ
+varDecl = inParens $ VarDecl <$> wordPos "vardecl" <*> name <*> pType
 
 tyVarDecl :: Parser (TyVarDecl TyName SourcePos)
 tyVarDecl = inParens $ TyVarDecl <$> wordPos "tyvardecl" <*> tyName <*> kind
@@ -108,7 +108,7 @@ binding
     :: Parser (Binding TyName Name DefaultUni DefaultFun SourcePos)
 binding = inParens $
     (try $ wordPos "termbind" >> TermBind <$> getSourcePos <*> strictness <*> varDecl <*> term)
-    <|> (wordPos "typebind" >> TypeBind <$> getSourcePos <*> tyVarDecl <*> typ)
+    <|> (wordPos "typebind" >> TypeBind <$> getSourcePos <*> tyVarDecl <*> pType)
     <|> (wordPos "datatypebind" >> DatatypeBind <$> getSourcePos <*> datatype)
 
 -- A small type wrapper for parsers that are parametric in the type of term(PIR/PLC) they parse
@@ -121,13 +121,13 @@ absTerm :: Parametric
 absTerm tm = PIR.tyAbs <$> wordPos "abs" <*> tyName <*> kind <*> tm
 
 lamTerm :: Parametric
-lamTerm tm = PIR.lamAbs <$> wordPos "lam" <*> name <*> typ <*> tm
+lamTerm tm = PIR.lamAbs <$> wordPos "lam" <*> name <*> pType <*> tm
 
 conTerm :: Parametric
 conTerm _tm = PIR.constant <$> wordPos "con" <*> constant
 
 iwrapTerm :: Parametric
-iwrapTerm tm = PIR.iWrap <$> wordPos "iwrap" <*> typ <*> typ <*> tm
+iwrapTerm tm = PIR.iWrap <$> wordPos "iwrap" <*> pType <*> pType <*> tm
 
 builtinTerm :: Parametric
 builtinTerm _term = PIR.builtin <$> wordPos "builtin" <*> builtinFunction
@@ -136,7 +136,7 @@ unwrapTerm :: Parametric
 unwrapTerm tm = PIR.unwrap <$> wordPos "unwrap" <*> tm
 
 errorTerm :: Parametric
-errorTerm _tm = PIR.error <$> wordPos "error" <*> typ
+errorTerm _tm = PIR.error <$> wordPos "error" <*> pType
 
 letTerm :: Parser (Term TyName Name DefaultUni DefaultFun SourcePos)
 letTerm = Let <$> wordPos "let" <*> recursivity <*> NE.some (try binding) <*> term
@@ -145,7 +145,7 @@ appTerm :: Parametric
 appTerm tm = PIR.mkIterApp <$> getSourcePos <*> tm <*> some tm
 
 tyInstTerm :: Parametric
-tyInstTerm tm = PIR.mkIterInst <$> getSourcePos <*> tm <*> some typ
+tyInstTerm tm = PIR.mkIterInst <$> getSourcePos <*> tm <*> some pType
 
 -- Note that PIR programs do not actually carry a version number
 -- we (optionally) parse it all the same so we can parse all PLC code