From af10fbaf942167a93fd1c2306ece1d25bad38e38 Mon Sep 17 00:00:00 2001 From: Steve Dunham Date: Sat, 11 Nov 2023 10:48:02 -0800 Subject: [PATCH] [ error ] Improve parse errors in ipkg files --- src/Idris/Package.idr | 90 +++++++++++++++++++------------ tests/idris2/pkg/pkg018/bad.ipkg | 2 + tests/idris2/pkg/pkg018/bad2.ipkg | 2 + tests/idris2/pkg/pkg018/expected | 14 +++++ tests/idris2/pkg/pkg018/run | 4 ++ 5 files changed, 77 insertions(+), 35 deletions(-) create mode 100644 tests/idris2/pkg/pkg018/bad.ipkg create mode 100644 tests/idris2/pkg/pkg018/bad2.ipkg create mode 100644 tests/idris2/pkg/pkg018/expected create mode 100644 tests/idris2/pkg/pkg018/run diff --git a/src/Idris/Package.idr b/src/Idris/Package.idr index 6bd20ba2eb..a447e0961c 100644 --- a/src/Idris/Package.idr +++ b/src/Idris/Package.idr @@ -34,6 +34,7 @@ import Libraries.Text.PrettyPrint.Prettyprinter.Render.String import Idris.CommandLine import Idris.Doc.HTML import Idris.Doc.String +import Idris.Error import Idris.ModTree import Idris.Pretty import Idris.ProcessIdr @@ -104,43 +105,52 @@ field fname <|> strField PPostclean "postclean" <|> do start <- location ignore $ exactProperty "version" - equals - vs <- sepBy1 dot' integerLit - end <- location - pure (PVersion (MkFC (PhysicalPkgSrc fname) start end) - (MkPkgVersion (fromInteger <$> vs))) + mustWork $ do + equals + vs <- choose stringLit (sepBy1 dot' integerLit) + end <- location + the (EmptyRule _) $ case vs of + Left v => pure (PVersionDep (MkFC (PhysicalPkgSrc fname) start end) v) + Right vs => pure (PVersion (MkFC (PhysicalPkgSrc fname) start end) + (MkPkgVersion (fromInteger <$> vs))) <|> do start <- location ignore $ exactProperty "langversion" - lvs <- langversions - end <- location - pure (PLangVersions (MkFC (PhysicalPkgSrc fname) start end) lvs) + mustWork $ do + lvs <- langversions + end <- location + pure (PLangVersions (MkFC (PhysicalPkgSrc fname) start end) lvs) <|> do start <- location ignore $ exactProperty "version" - equals - v <- stringLit - end <- location - pure (PVersionDep (MkFC (PhysicalPkgSrc fname) start end) v) + mustWork $ do + equals + v <- stringLit + end <- location + pure (PVersionDep (MkFC (PhysicalPkgSrc fname) start end) v) <|> do ignore $ exactProperty "depends" - equals - ds <- sep depends - pure (PDepends ds) + mustWork $ do + equals + ds <- sep depends + pure (PDepends ds) <|> do ignore $ exactProperty "modules" - equals - ms <- sep (do start <- location - m <- moduleIdent - end <- location - pure (MkFC (PhysicalPkgSrc fname) start end, m)) - pure (PModules ms) + mustWork $ do + equals + ms <- sep (do start <- location + m <- moduleIdent + end <- location + pure (MkFC (PhysicalPkgSrc fname) start end, m)) + pure (PModules ms) <|> do ignore $ exactProperty "main" - equals - start <- location - m <- moduleIdent - end <- location - pure (PMainMod (MkFC (PhysicalPkgSrc fname) start end) m) + mustWork $ do + equals + start <- location + m <- moduleIdent + end <- location + pure (PMainMod (MkFC (PhysicalPkgSrc fname) start end) m) <|> do ignore $ exactProperty "executable" - equals - e <- (stringLit <|> packageName) - pure (PExec e) + mustWork $ do + equals + e <- (stringLit <|> packageName) + pure (PExec e) where data Bound = LT PkgVersion Bool | GT PkgVersion Bool @@ -191,16 +201,20 @@ field fname strField fieldConstructor fieldName = do start <- location ignore $ exactProperty fieldName - equals - str <- stringLit - end <- location - pure $ fieldConstructor (MkFC (PhysicalPkgSrc fname) start end) str + mustWork $ do + equals + str <- stringLit + end <- location + pure $ fieldConstructor (MkFC (PhysicalPkgSrc fname) start end) str parsePkgDesc : String -> Rule (String, List DescField) parsePkgDesc fname = do ignore $ exactProperty "package" name <- packageName fields <- many (field fname) + EndOfInput <- peek + | DotSepIdent _ name => fail "Unrecognised property \{show name}" + | tok => fail "Expected end of file" pure (name, fields) data ParsedMods : Type where @@ -284,8 +298,14 @@ parsePkgFile : {auto c : Ref Ctxt Defs} -> (setSrc : Bool) -> -- parse package file as a dependency String -> Core PkgDesc parsePkgFile setSrc file = do - Right (pname, fs) <- coreLift $ parseFile file $ parsePkgDesc file <* eoi - | Left err => throw err + Right (pname, fs) <- coreLift $ parseFile file $ parsePkgDesc file + | Left err => do + Right res <- coreLift (readFile file) + | _ => throw err + setCurrentElabSource res + doc <- perror err + msg <- render doc + throw (UserError msg) addFields setSrc fs (initPkgDesc pname) -------------------------------------------------------------------------------- diff --git a/tests/idris2/pkg/pkg018/bad.ipkg b/tests/idris2/pkg/pkg018/bad.ipkg new file mode 100644 index 0000000000..0439da51fd --- /dev/null +++ b/tests/idris2/pkg/pkg018/bad.ipkg @@ -0,0 +1,2 @@ +package bad +depend = contrib diff --git a/tests/idris2/pkg/pkg018/bad2.ipkg b/tests/idris2/pkg/pkg018/bad2.ipkg new file mode 100644 index 0000000000..18617dcd9a --- /dev/null +++ b/tests/idris2/pkg/pkg018/bad2.ipkg @@ -0,0 +1,2 @@ +package bad +sourcedir = src diff --git a/tests/idris2/pkg/pkg018/expected b/tests/idris2/pkg/pkg018/expected new file mode 100644 index 0000000000..d5bf1accb6 --- /dev/null +++ b/tests/idris2/pkg/pkg018/expected @@ -0,0 +1,14 @@ +Uncaught error: Error: Unrecognised property "depend". + +"bad.ipkg":2:1--2:7 + 1 | package bad + 2 | depend = contrib + ^^^^^^ + +Uncaught error: Error: Expected string. + +"bad2.ipkg":2:13--2:16 + 1 | package bad + 2 | sourcedir = src + ^^^ + diff --git a/tests/idris2/pkg/pkg018/run b/tests/idris2/pkg/pkg018/run new file mode 100644 index 0000000000..17ddd77d4a --- /dev/null +++ b/tests/idris2/pkg/pkg018/run @@ -0,0 +1,4 @@ +. ../../../testutils.sh + +idris2 --build bad.ipkg +idris2 --build bad2.ipkg