diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 7c43b1c29b1..c083a8d18ef 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -86,6 +86,7 @@ library -- this modules are moved from Cabal -- they are needed for as long until cabal-install moves to parsec parser Distribution.Deprecated.ParseUtils + Distribution.Deprecated.ProjectParseUtils Distribution.Deprecated.ReadP Distribution.Deprecated.ViewAsFieldDescr diff --git a/cabal-install/src/Distribution/Client/Errors.hs b/cabal-install/src/Distribution/Client/Errors.hs index b4bff5f3ae1..de81012c6a5 100644 --- a/cabal-install/src/Distribution/Client/Errors.hs +++ b/cabal-install/src/Distribution/Client/Errors.hs @@ -33,6 +33,8 @@ import Distribution.Pretty import Distribution.Simple (VersionRange) import Distribution.Simple.Utils import Network.URI +import Text.PrettyPrint hiding (render, (<>)) +import qualified Text.PrettyPrint as PP import Text.Regex.Posix.ByteString (WrapError) data CabalInstallException @@ -112,7 +114,7 @@ data CabalInstallException | ParseExtraLinesFailedErr String String | ParseExtraLinesOkError [PWarning] | FetchPackageErr - | ReportParseResult String FilePath String String + | ReportParseResult String FilePath String Doc | ReportSourceRepoProblems String | BenchActionException | RenderBenchTargetProblem [String] @@ -495,13 +497,12 @@ exceptionMessageCabalInstall e = case e of ParseExtraLinesOkError ws -> unlines (map (showPWarning "Error parsing additional config lines") ws) FetchPackageErr -> "fetchPackage: source repos not supported" ReportParseResult filetype filename line msg -> - "Error parsing " - ++ filetype - ++ " " - ++ filename - ++ line - ++ ":\n" - ++ msg + PP.render $ + vcat + -- NOTE: As given to us, the line number string is prefixed by a colon. + [ text "Error parsing" <+> text filetype <+> text filename PP.<> text line PP.<> colon + , nest 1 $ text "-" <+> msg + ] ReportSourceRepoProblems errorStr -> errorStr BenchActionException -> "The bench command does not support '--only-dependencies'. " diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs index 3cde1f9af12..23e9f94baba 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs @@ -66,8 +66,18 @@ module Distribution.Client.ProjectConfig , maxNumFetchJobs ) where -import Distribution.Client.Compat.Prelude -import Text.PrettyPrint (nest, render, text, vcat) +import Distribution.Client.Compat.Prelude hiding (empty) +import Distribution.Simple.Utils + ( createDirectoryIfMissingVerbose + , dieWithException + , maybeExit + , notice + , noticeDoc + , ordNub + , rawSystemIOWithEnv + , warn + ) +import Text.PrettyPrint (cat, colon, comma, empty, hsep, nest, quotes, render, text, vcat) import Prelude () import Distribution.Client.Glob @@ -136,10 +146,12 @@ import Distribution.Client.Utils ( determineNumJobs ) import qualified Distribution.Deprecated.ParseUtils as OldParser - ( ParseResult (..) - , locatedErrorMsg + ( locatedErrorMsg , showPWarning ) +import qualified Distribution.Deprecated.ProjectParseUtils as OldParser + ( ProjectParseResult (..) + ) import Distribution.Fields ( PError , PWarning @@ -172,14 +184,6 @@ import Distribution.Simple.Setup , fromFlagOrDefault , toFlag ) -import Distribution.Simple.Utils - ( createDirectoryIfMissingVerbose - , dieWithException - , maybeExit - , notice - , rawSystemIOWithEnv - , warn - ) import Distribution.System ( Platform ) @@ -240,6 +244,7 @@ import System.IO , withBinaryFile ) +import Distribution.Deprecated.ProjectParseUtils (ProjectParseError (..), ProjectParseWarning) import Distribution.Solver.Types.ProjectConfigPath ---------------------------------------- @@ -874,16 +879,45 @@ readGlobalConfig verbosity configFileFlag = do monitorFiles [monitorFileHashed configFile] return (convertLegacyGlobalConfig config) -reportParseResult :: Verbosity -> String -> FilePath -> OldParser.ParseResult ProjectConfigSkeleton -> IO ProjectConfigSkeleton -reportParseResult verbosity _filetype filename (OldParser.ParseOk warnings x) = do +reportProjectParseWarnings :: Verbosity -> FilePath -> [ProjectParseWarning] -> IO () +reportProjectParseWarnings verbosity projectFile warnings = unless (null warnings) $ - let msg = unlines (map (OldParser.showPWarning (intercalate ", " $ filename : (projectConfigPathRoot <$> projectSkeletonImports x))) warnings) - in warn verbosity msg + let msgs = + [ OldParser.showPWarning pFilename w + | (p, w) <- warnings + , let pFilename = fst $ unconsProjectConfigPath p + ] + in noticeDoc verbosity $ + vcat + [ (text "Warnings found while parsing the project file" <> comma) <+> (text (takeFileName projectFile) <> colon) + , cat [nest 1 $ text "-" <+> text m | m <- ordNub msgs] + ] + +reportParseResult :: Verbosity -> String -> FilePath -> OldParser.ProjectParseResult ProjectConfigSkeleton -> IO ProjectConfigSkeleton +reportParseResult verbosity _filetype projectFile (OldParser.ProjectParseOk warnings x) = do + reportProjectParseWarnings verbosity projectFile warnings return x -reportParseResult verbosity filetype filename (OldParser.ParseFailed err) = +reportParseResult verbosity filetype projectFile (OldParser.ProjectParseFailed (ProjectParseError snippet rootOrImportee err)) = do let (line, msg) = OldParser.locatedErrorMsg err - errLineNo = maybe "" (\n -> ':' : show n) line - in dieWithException verbosity $ ReportParseResult filetype filename errLineNo msg + let errLineNo = maybe "" (\n -> ':' : show n) line + let (sourceFile, provenance) = + maybe + (projectFile, empty) + ( \p -> + ( fst $ unconsProjectConfigPath p + , if isTopLevelConfigPath p then empty else docProjectConfigPath p + ) + ) + rootOrImportee + let doc = case snippet of + Nothing -> vcat (text <$> lines msg) + Just s -> + vcat + [ provenance + , text "Failed to parse" <+> quotes (text s) <+> (text "with error" <> colon) + , nest 2 $ hsep $ text <$> lines msg + ] + dieWithException verbosity $ ReportParseResult filetype sourceFile errLineNo doc --------------------------------------------- -- Finding packages in the project diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs index 6593d60cb92..96c52858518 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs @@ -1,9 +1,11 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} -- | Project configuration, implementation in terms of legacy types. @@ -161,6 +163,11 @@ import Distribution.Deprecated.ParseUtils , syntaxError ) import qualified Distribution.Deprecated.ParseUtils as ParseUtils +import Distribution.Deprecated.ProjectParseUtils + ( ProjectParseResult (..) + , projectParse + , projectParseFail + ) import Distribution.Deprecated.ReadP ( ReadP , (+++) @@ -185,6 +192,7 @@ import Distribution.Utils.Path hiding ) import qualified Data.ByteString.Char8 as BS +import Data.Functor ((<&>)) import qualified Data.Map as Map import qualified Data.Set as Set import Network.URI (URI (..), nullURIAuth, parseURI) @@ -242,12 +250,15 @@ parseProject -> Verbosity -> ProjectConfigToParse -- ^ The contents of the file to parse - -> IO (ParseResult ProjectConfigSkeleton) -parseProject rootPath cacheDir httpTransport verbosity configToParse = do - let (dir, projectFileName) = splitFileName rootPath - projectDir <- makeAbsolute dir - projectPath <- canonicalizeConfigPath projectDir (ProjectConfigPath $ projectFileName :| []) - parseProjectSkeleton cacheDir httpTransport verbosity projectDir projectPath configToParse + -> IO (ProjectParseResult ProjectConfigSkeleton) +parseProject rootPath cacheDir httpTransport verbosity configToParse = + do + let (dir, projectFileName) = splitFileName rootPath + projectDir <- makeAbsolute dir + projectPath <- canonicalizeConfigPath projectDir (ProjectConfigPath $ projectFileName :| []) + parseProjectSkeleton cacheDir httpTransport verbosity projectDir projectPath configToParse + -- NOTE: Reverse the warnings so they are in line number order. + <&> \case ProjectParseOk ws x -> ProjectParseOk (reverse ws) x; x -> x parseProjectSkeleton :: FilePath @@ -259,32 +270,32 @@ parseProjectSkeleton -- ^ The path of the file being parsed, either the root or an import -> ProjectConfigToParse -- ^ The contents of the file to parse - -> IO (ParseResult ProjectConfigSkeleton) + -> IO (ProjectParseResult ProjectConfigSkeleton) parseProjectSkeleton cacheDir httpTransport verbosity projectDir source (ProjectConfigToParse bs) = - (sanityWalkPCS False =<<) <$> liftPR (go []) (ParseUtils.readFields bs) + (sanityWalkPCS False =<<) <$> liftPR source (go []) (ParseUtils.readFields bs) where - go :: [ParseUtils.Field] -> [ParseUtils.Field] -> IO (ParseResult ProjectConfigSkeleton) + go :: [ParseUtils.Field] -> [ParseUtils.Field] -> IO (ProjectParseResult ProjectConfigSkeleton) go acc (x : xs) = case x of (ParseUtils.F _ "import" importLoc) -> do let importLocPath = importLoc `consProjectConfigPath` source -- Once we canonicalize the import path, we can check for cyclical imports + normSource <- canonicalizeConfigPath projectDir source normLocPath <- canonicalizeConfigPath projectDir importLocPath - debug verbosity $ "\nimport path, normalized\n=======================\n" ++ render (docProjectConfigPath normLocPath) if isCyclicConfigPath normLocPath - then pure . parseFail $ ParseUtils.FromString (render $ cyclicalImportMsg normLocPath) Nothing + then pure . projectParseFail Nothing (Just normSource) $ ParseUtils.FromString (render $ cyclicalImportMsg normLocPath) Nothing else do when (isUntrimmedUriConfigPath importLocPath) (noticeDoc verbosity $ untrimmedUriImportMsg (Disp.text "Warning:") importLocPath) - normSource <- canonicalizeConfigPath projectDir source let fs = (\z -> CondNode z [normLocPath] mempty) <$> fieldsToConfig normSource (reverse acc) res <- parseProjectSkeleton cacheDir httpTransport verbosity projectDir importLocPath . ProjectConfigToParse =<< fetchImportConfig normLocPath rest <- go [] xs - pure . fmap mconcat . sequence $ [fs, res, rest] + pure . fmap mconcat . sequence $ [projectParse Nothing normSource fs, res, rest] (ParseUtils.Section l "if" p xs') -> do + normSource <- canonicalizeConfigPath projectDir source subpcs <- go [] xs' let fs = singletonProjectConfigSkeleton <$> fieldsToConfig source (reverse acc) (elseClauses, rest) <- parseElseClauses xs @@ -292,27 +303,32 @@ parseProjectSkeleton cacheDir httpTransport verbosity projectDir source (Project (\c pcs e -> CondNode mempty mempty [CondBranch c pcs e]) <$> -- we rewrap as as a section so the readFields lexer of the conditional parser doesn't get confused - adaptParseError l (parseConditionConfVarFromClause . BS.pack $ "if(" <> p <> ")") + ( let s = "if(" <> p <> ")" + in projectParse (Just s) normSource (adaptParseError l (parseConditionConfVarFromClause $ BS.pack s)) + ) <*> subpcs <*> elseClauses - pure . fmap mconcat . sequence $ [fs, condNode, rest] + pure . fmap mconcat . sequence $ [projectParse Nothing normSource fs, condNode, rest] _ -> go (x : acc) xs go acc [] = do normSource <- canonicalizeConfigPath projectDir source - pure . fmap singletonProjectConfigSkeleton . fieldsToConfig normSource $ reverse acc + pure . fmap singletonProjectConfigSkeleton . projectParse Nothing normSource . fieldsToConfig normSource $ reverse acc - parseElseClauses :: [ParseUtils.Field] -> IO (ParseResult (Maybe ProjectConfigSkeleton), ParseResult ProjectConfigSkeleton) + parseElseClauses :: [ParseUtils.Field] -> IO (ProjectParseResult (Maybe ProjectConfigSkeleton), ProjectParseResult ProjectConfigSkeleton) parseElseClauses x = case x of (ParseUtils.Section _l "else" _p xs' : xs) -> do subpcs <- go [] xs' rest <- go [] xs pure (Just <$> subpcs, rest) (ParseUtils.Section l "elif" p xs' : xs) -> do + normSource <- canonicalizeConfigPath projectDir source subpcs <- go [] xs' (elseClauses, rest) <- parseElseClauses xs let condNode = (\c pcs e -> CondNode mempty mempty [CondBranch c pcs e]) - <$> adaptParseError l (parseConditionConfVarFromClause . BS.pack $ "else(" <> p <> ")") + <$> ( let s = "elif(" <> p <> ")" + in projectParse (Just s) normSource (adaptParseError l (parseConditionConfVarFromClause $ BS.pack s)) + ) <*> subpcs <*> elseClauses pure (Just <$> condNode, rest) @@ -331,15 +347,16 @@ parseProjectSkeleton cacheDir httpTransport verbosity projectDir source (Project addProvenance :: ProjectConfigPath -> ProjectConfig -> ProjectConfig addProvenance sourcePath x = x{projectConfigProvenance = Set.singleton $ Explicit sourcePath} + adaptParseError :: Show e => ParseUtils.LineNo -> Either e a -> ParseResult a adaptParseError _ (Right x) = pure x adaptParseError l (Left e) = parseFail $ ParseUtils.FromString (show e) (Just l) - liftPR :: (a -> IO (ParseResult b)) -> ParseResult a -> IO (ParseResult b) - liftPR f (ParseOk ws x) = addWarnings <$> f x + liftPR :: ProjectConfigPath -> (a -> IO (ProjectParseResult b)) -> ParseResult a -> IO (ProjectParseResult b) + liftPR p f (ParseOk ws x) = addWarnings <$> f x where - addWarnings (ParseOk ws' x') = ParseOk (ws' ++ ws) x' + addWarnings (ProjectParseOk ws' x') = ProjectParseOk (ws' ++ ((p,) <$> ws)) x' addWarnings x' = x' - liftPR _ (ParseFailed e) = pure $ ParseFailed e + liftPR p _ (ParseFailed e) = pure $ projectParseFail Nothing (Just p) e fetchImportConfig :: ProjectConfigPath -> IO BS.ByteString fetchImportConfig (ProjectConfigPath (pci :| _)) = do @@ -362,12 +379,14 @@ parseProjectSkeleton cacheDir httpTransport verbosity projectDir source (Project where isSet f = f (projectConfigShared pc) /= NoFlag - sanityWalkPCS :: Bool -> ProjectConfigSkeleton -> ParseResult ProjectConfigSkeleton - sanityWalkPCS underConditional t@(CondNode d _c comps) - | underConditional && modifiesCompiler d = parseFail $ ParseUtils.FromString "Cannot set compiler in a conditional clause of a cabal project file" Nothing - | otherwise = mapM_ sanityWalkBranch comps >> pure t + sanityWalkPCS :: Bool -> ProjectConfigSkeleton -> ProjectParseResult ProjectConfigSkeleton + sanityWalkPCS underConditional t@(CondNode d (listToMaybe -> c) comps) + | underConditional && modifiesCompiler d = + projectParseFail Nothing c $ ParseUtils.FromString "Cannot set compiler in a conditional clause of a cabal project file" Nothing + | otherwise = + mapM_ sanityWalkBranch comps >> pure t - sanityWalkBranch :: CondBranch ConfVar [ProjectConfigPath] ProjectConfig -> ParseResult () + sanityWalkBranch :: CondBranch ConfVar [ProjectConfigPath] ProjectConfig -> ProjectParseResult () sanityWalkBranch (CondBranch _c t f) = traverse_ (sanityWalkPCS True) f >> sanityWalkPCS True t >> pure () ------------------------------------------------------------------ diff --git a/cabal-install/src/Distribution/Deprecated/ProjectParseUtils.hs b/cabal-install/src/Distribution/Deprecated/ProjectParseUtils.hs new file mode 100644 index 00000000000..790b7b6b352 --- /dev/null +++ b/cabal-install/src/Distribution/Deprecated/ProjectParseUtils.hs @@ -0,0 +1,51 @@ +{-# OPTIONS_HADDOCK hide #-} + +module Distribution.Deprecated.ProjectParseUtils + ( ProjectParseError (..) + , ProjectParseWarning + , ProjectParseResult (..) + , projectParseFail + , projectParse + ) where + +import Distribution.Client.Compat.Prelude hiding (get) +import Prelude () + +import qualified Distribution.Deprecated.ParseUtils as Pkg (PError, PWarning, ParseResult (..)) +import Distribution.Solver.Types.ProjectConfigPath (ProjectConfigPath) + +type ProjectParseWarning = (ProjectConfigPath, Pkg.PWarning) + +data ProjectParseError = ProjectParseError + { projectParseSnippet :: Maybe String + , projectParseSource :: Maybe ProjectConfigPath + , projectParseError :: Pkg.PError + } + deriving (Show) + +data ProjectParseResult a + = ProjectParseFailed ProjectParseError + | ProjectParseOk [ProjectParseWarning] a + deriving (Show) + +projectParse :: Maybe String -> ProjectConfigPath -> Pkg.ParseResult a -> ProjectParseResult a +projectParse s path (Pkg.ParseFailed err) = ProjectParseFailed $ ProjectParseError s (Just path) err +projectParse _ path (Pkg.ParseOk ws x) = ProjectParseOk [(path, w) | w <- ws] x + +instance Functor ProjectParseResult where + fmap _ (ProjectParseFailed err) = ProjectParseFailed err + fmap f (ProjectParseOk ws x) = ProjectParseOk ws $ f x + +instance Applicative ProjectParseResult where + pure = ProjectParseOk [] + (<*>) = ap + +instance Monad ProjectParseResult where + return = pure + ProjectParseFailed err >>= _ = ProjectParseFailed err + ProjectParseOk ws x >>= f = case f x of + ProjectParseFailed err -> ProjectParseFailed err + ProjectParseOk ws' x' -> ProjectParseOk (ws' ++ ws) x' + +projectParseFail :: Maybe String -> Maybe ProjectConfigPath -> Pkg.PError -> ProjectParseResult a +projectParseFail s p e = ProjectParseFailed $ ProjectParseError s p e diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.out b/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.out index fd408a95505..2ddeff77281 100644 --- a/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.out +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.out @@ -17,53 +17,53 @@ Warning: The directory /cabal.dist/home/.cabal/store/ghc-/incoming # checking cyclical loopback of a project importing itself # cabal v2-build Error: [Cabal-7090] -Error parsing project file /cyclical-0-self.project: -cyclical import of cyclical-0-self.project; - cyclical-0-self.project - imported by: cyclical-0-self.project +Error parsing project file cyclical-0-self.project: + - cyclical import of cyclical-0-self.project; + cyclical-0-self.project + imported by: cyclical-0-self.project # checking cyclical with hops; out and back # cabal v2-build Error: [Cabal-7090] -Error parsing project file /cyclical-1-out-back.project: -cyclical import of cyclical-1-out-back.project; - cyclical-1-out-back.project - imported by: cyclical-1-out-back.config - imported by: cyclical-1-out-back.project +Error parsing project file cyclical-1-out-back.config: + - cyclical import of cyclical-1-out-back.project; + cyclical-1-out-back.project + imported by: cyclical-1-out-back.config + imported by: cyclical-1-out-back.project # checking cyclical with hops; out to a config that imports itself # cabal v2-build Error: [Cabal-7090] -Error parsing project file /cyclical-1-out-self.project: -cyclical import of cyclical-1-out-self.config; - cyclical-1-out-self.config - imported by: cyclical-1-out-self.config - imported by: cyclical-1-out-self.project +Error parsing project file cyclical-1-out-self.config: + - cyclical import of cyclical-1-out-self.config; + cyclical-1-out-self.config + imported by: cyclical-1-out-self.config + imported by: cyclical-1-out-self.project # checking cyclical with hops; out, out, twice back # cabal v2-build Error: [Cabal-7090] -Error parsing project file /cyclical-2-out-out-backback.project: -cyclical import of cyclical-2-out-out-backback.project; - cyclical-2-out-out-backback.project - imported by: cyclical-2-out-out-backback-b.config - imported by: cyclical-2-out-out-backback-a.config - imported by: cyclical-2-out-out-backback.project +Error parsing project file cyclical-2-out-out-backback-b.config: + - cyclical import of cyclical-2-out-out-backback.project; + cyclical-2-out-out-backback.project + imported by: cyclical-2-out-out-backback-b.config + imported by: cyclical-2-out-out-backback-a.config + imported by: cyclical-2-out-out-backback.project # checking cyclical with hops; out, out, once back # cabal v2-build Error: [Cabal-7090] -Error parsing project file /cyclical-2-out-out-back.project: -cyclical import of cyclical-2-out-out-back-a.config; - cyclical-2-out-out-back-a.config - imported by: cyclical-2-out-out-back-b.config - imported by: cyclical-2-out-out-back-a.config - imported by: cyclical-2-out-out-back.project +Error parsing project file cyclical-2-out-out-back-b.config: + - cyclical import of cyclical-2-out-out-back-a.config; + cyclical-2-out-out-back-a.config + imported by: cyclical-2-out-out-back-b.config + imported by: cyclical-2-out-out-back-a.config + imported by: cyclical-2-out-out-back.project # checking cyclical with hops; out, out to a config that imports itself # cabal v2-build Error: [Cabal-7090] -Error parsing project file /cyclical-2-out-out-self.project: -cyclical import of cyclical-2-out-out-self-b.config; - cyclical-2-out-out-self-b.config - imported by: cyclical-2-out-out-self-b.config - imported by: cyclical-2-out-out-self-a.config - imported by: cyclical-2-out-out-self.project +Error parsing project file cyclical-2-out-out-self-b.config: + - cyclical import of cyclical-2-out-out-self-b.config; + cyclical-2-out-out-self-b.config + imported by: cyclical-2-out-out-self-b.config + imported by: cyclical-2-out-out-self-a.config + imported by: cyclical-2-out-out-self.project # checking that cyclical check doesn't false-positive on same file names in different folders; hoping within a folder and then into a subfolder # cabal v2-build Configuration is affected by the following files: @@ -93,30 +93,30 @@ Up to date # checking that cyclical check catches a same file name that imports itself # cabal v2-build Error: [Cabal-7090] -Error parsing project file /cyclical-same-filename-out-out-self.project: -cyclical import of same-filename/cyclical-same-filename-out-out-self.config; - same-filename/cyclical-same-filename-out-out-self.config - imported by: same-filename/cyclical-same-filename-out-out-self.config - imported by: cyclical-same-filename-out-out-self.config - imported by: cyclical-same-filename-out-out-self.project +Error parsing project file same-filename/cyclical-same-filename-out-out-self.config: + - cyclical import of same-filename/cyclical-same-filename-out-out-self.config; + same-filename/cyclical-same-filename-out-out-self.config + imported by: same-filename/cyclical-same-filename-out-out-self.config + imported by: cyclical-same-filename-out-out-self.config + imported by: cyclical-same-filename-out-out-self.project # checking that cyclical check catches importing its importer (with the same file name) # cabal v2-build Error: [Cabal-7090] -Error parsing project file /cyclical-same-filename-out-out-backback.project: -cyclical import of cyclical-same-filename-out-out-backback.project; - cyclical-same-filename-out-out-backback.project - imported by: same-filename/cyclical-same-filename-out-out-backback.config - imported by: cyclical-same-filename-out-out-backback.config - imported by: cyclical-same-filename-out-out-backback.project +Error parsing project file same-filename/cyclical-same-filename-out-out-backback.config: + - cyclical import of cyclical-same-filename-out-out-backback.project; + cyclical-same-filename-out-out-backback.project + imported by: same-filename/cyclical-same-filename-out-out-backback.config + imported by: cyclical-same-filename-out-out-backback.config + imported by: cyclical-same-filename-out-out-backback.project # checking that cyclical check catches importing its importer's importer (hopping over same file names) # cabal v2-build Error: [Cabal-7090] -Error parsing project file /cyclical-same-filename-out-out-back.project: -cyclical import of cyclical-same-filename-out-out-back.config; - cyclical-same-filename-out-out-back.config - imported by: same-filename/cyclical-same-filename-out-out-back.config - imported by: cyclical-same-filename-out-out-back.config - imported by: cyclical-same-filename-out-out-back.project +Error parsing project file same-filename/cyclical-same-filename-out-out-back.config: + - cyclical import of cyclical-same-filename-out-out-back.config; + cyclical-same-filename-out-out-back.config + imported by: same-filename/cyclical-same-filename-out-out-back.config + imported by: cyclical-same-filename-out-out-back.config + imported by: cyclical-same-filename-out-out-back.project # checking that imports work skipping into a subfolder and then back out again and again # cabal v2-build Configuration is affected by the following files: @@ -383,6 +383,6 @@ Up to date # cabal v2-build Error: [Cabal-7090] Error parsing project file /bad-conditional.project: -Cannot set compiler in a conditional clause of a cabal project file + - Cannot set compiler in a conditional clause of a cabal project file # checking that missing package message lists configuration provenance # cabal v2-build diff --git a/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.out b/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.out index 60680b86db3..b94b99a9a08 100644 --- a/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.out +++ b/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.out @@ -1,4 +1,4 @@ # cabal build Error: [Cabal-7090] -Error parsing project file /cabal.project:4: -'source-repository-package' is a stanza, not a field. Remove the trailing ':' to parse a stanza. +Error parsing project file cabal.project:4: + - 'source-repository-package' is a stanza, not a field. Remove the trailing ':' to parse a stanza. diff --git a/cabal-testsuite/PackageTests/ProjectImport/DedupUsingConfigFromSimple/z-empty.config b/cabal-testsuite/PackageTests/ProjectImport/DedupUsingConfigFromSimple/z-empty.config index 771bb389fde..3260f700ccb 100644 --- a/cabal-testsuite/PackageTests/ProjectImport/DedupUsingConfigFromSimple/z-empty.config +++ b/cabal-testsuite/PackageTests/ProjectImport/DedupUsingConfigFromSimple/z-empty.config @@ -1 +1 @@ --- This file is intentionally empty, just this comment. +-- This file is intentionally empty with these badly formed comment lines. diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.out b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.out index a3143ff9ffd..90847323f09 100644 --- a/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.out +++ b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.out @@ -1,5 +1,6 @@ # cabal v2-build -Warning: /else.project, else.project: Unrecognized section '_' on line 3 +Warnings found while parsing the project file, else.project: + - dir-else/else.config: Unrecognized section '_' on line 3 # Multiline string marking: # ^When using configuration from:$ # ^ - else.project$ @@ -8,3 +9,25 @@ Warning: /else.project, else.project: Unrecognized section '_' on line 3 # ^ - The package location 'no-pkg-here' does not exist.$ # Pseudo multiline string marking: # ^When using configuration from: - else.project - dir-else/else.config The following errors occurred: - The package location 'no-pkg-here' does not exist.$ +# cabal v2-build +Error: [Cabal-7090] +Error parsing project file cabal.project:3: + - Failed to parse 'if(_)' with error: + "" (line 1, column 1): unexpected SecArgName (Position 1 4) "_" +# cabal v2-build +Error: [Cabal-7090] +Error parsing project file dir-if/if.config:3: + - dir-if/if.config + imported by: if.project + Failed to parse 'if(_)' with error: + "" (line 1, column 1): unexpected SecArgName (Position 1 4) "_" +# cabal v2-build +Error: [Cabal-7090] +Error parsing project file dir-elif/elif.config:4: + - dir-elif/elif.config + imported by: elif.project + Failed to parse 'elif(_)' with error: + "" (line 1, column 1): unexpected SecArgName (Position 1 6) "_" +# cabal v2-build +Warnings found while parsing the project file, else.project: + - dir-else/else.config: Unrecognized section '_' on line 3 diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.project b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.project new file mode 100644 index 00000000000..d568a0e59fc --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.project @@ -0,0 +1,3 @@ +-- The following failing condition is not on the first line so we can check the +-- line number: +if _ diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.test.hs b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.test.hs index 49360b59872..6dfff2dd915 100644 --- a/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.test.hs +++ b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.test.hs @@ -21,4 +21,22 @@ main = cabalTest . recordMode RecordMarked $ do assertOutputContains msg outElse assertOutputDoesNotContain msgSingle outElse + + outDefault <- fails $ cabal' "v2-build" [ "all", "--dry-run", "--project-file=cabal.project" ] + assertOutputContains "Error parsing project file cabal.project:3" outDefault + assertOutputDoesNotContain "imported by:" outDefault + + outIf <- fails $ cabal' "v2-build" [ "all", "--dry-run", "--project-file=if.project" ] + assertOutputContains (normalizeWindowsOutput "Error parsing project file dir-if/if.config:3") outIf + assertOutputContains "imported by:" outIf + + outElif <- fails $ cabal' "v2-build" [ "all", "--dry-run", "--project-file=elif.project" ] + assertOutputContains (normalizeWindowsOutput "Error parsing project file dir-elif/elif.config:4") outElif + assertOutputContains "imported by:" outElif + + outElse <- fails $ cabal' "v2-build" [ "all", "--dry-run", "--project-file=else.project" ] + assertOutputContains "Warnings found while parsing the project file, else.project:" outElse + assertOutputContains (normalizeWindowsOutput "- dir-else/else.config: Unrecognized section '_' on line 3") outElse + assertOutputContains "When using configuration from:" outElse + return () diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/dir-elif/elif.config b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/dir-elif/elif.config new file mode 100644 index 00000000000..e704a4cd1c7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/dir-elif/elif.config @@ -0,0 +1,4 @@ +-- The following failing condition is not on the first line so we can check the +-- line number: +if false +elif _ diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/dir-if/if.config b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/dir-if/if.config new file mode 100644 index 00000000000..d568a0e59fc --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/dir-if/if.config @@ -0,0 +1,3 @@ +-- The following failing condition is not on the first line so we can check the +-- line number: +if _ diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/elif.project b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/elif.project new file mode 100644 index 00000000000..a361a5d817d --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/elif.project @@ -0,0 +1 @@ +import: dir-elif/elif.config diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/if.project b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/if.project new file mode 100644 index 00000000000..5bfe025daf3 --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/if.project @@ -0,0 +1 @@ +import: dir-if/if.config diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/with-ghc.config b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/with-ghc.config new file mode 100644 index 00000000000..140a00be1b9 --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/with-ghc.config @@ -0,0 +1,7 @@ +-- WARNING: Override the `with-compiler: ghc-x.y.z` of the stackage import, of +-- https://www.stackage.org/nightly-yyyy-mm-dd/cabal.config. Otherwise tests +-- will fail with: +-- -Error: [Cabal-5490] +-- -Cannot find the program 'ghc'. User-specified path 'ghc-x.y.z' does not +-- refer to an executable and the program is not on the system path. +with-compiler: ghc diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/cabal.out b/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/cabal.out new file mode 100644 index 00000000000..90265370e7a --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/cabal.out @@ -0,0 +1,10 @@ +# cabal v2-build +Warnings found while parsing the project file, cabal.project: + - dir-x/a.config: Unrecognized section '-' on line 1 + - dir-x/a.config: Unrecognized section '-' on line 2 + - dir-x/a.config: Unrecognized section '-' on line 3 + - dir-y/a.config: Unrecognized section '-' on line 123 + - x.config: Unrecognized section '-' on line 1 + - x.config: Unrecognized section '-' on line 2 + - x.config: Unrecognized section '-' on line 3 + - y.config: Unrecognized section '-' on line 123 diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/cabal.project b/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/cabal.project new file mode 100644 index 00000000000..38269d13847 --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/cabal.project @@ -0,0 +1,5 @@ +packages: no-pkg-dir +import: dir-x/a.config +import: dir-y/a.config +import: x.config +import: y.config diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/cabal.test.hs b/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/cabal.test.hs new file mode 100644 index 00000000000..8bb23f77ce9 --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/cabal.test.hs @@ -0,0 +1,10 @@ +import Test.Cabal.Prelude + +main = cabalTest . recordMode RecordMarked $ do + let log = recordHeader . pure + + out <- fails $ cabal' "v2-build" [ "all", "--dry-run" ] + + assertOutputContains "Warnings found while parsing the project file, cabal.project:" out + + return () diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/dir-x/a.config b/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/dir-x/a.config new file mode 100644 index 00000000000..2f09853e2aa --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/dir-x/a.config @@ -0,0 +1,3 @@ +- This file is intentionally empty with these badly formed comment lines. +- This file is intentionally empty with these badly formed comment lines. +- This file is intentionally empty with these badly formed comment lines. diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/dir-y/a.config b/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/dir-y/a.config new file mode 100644 index 00000000000..ea4fb127913 --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/dir-y/a.config @@ -0,0 +1,123 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +- This file is intentionally empty with this badly formed comment line. diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/with-ghc.config b/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/with-ghc.config new file mode 100644 index 00000000000..140a00be1b9 --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/with-ghc.config @@ -0,0 +1,7 @@ +-- WARNING: Override the `with-compiler: ghc-x.y.z` of the stackage import, of +-- https://www.stackage.org/nightly-yyyy-mm-dd/cabal.config. Otherwise tests +-- will fail with: +-- -Error: [Cabal-5490] +-- -Cannot find the program 'ghc'. User-specified path 'ghc-x.y.z' does not +-- refer to an executable and the program is not on the system path. +with-compiler: ghc diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/x.config b/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/x.config new file mode 100644 index 00000000000..2f09853e2aa --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/x.config @@ -0,0 +1,3 @@ +- This file is intentionally empty with these badly formed comment lines. +- This file is intentionally empty with these badly formed comment lines. +- This file is intentionally empty with these badly formed comment lines. diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/y.config b/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/y.config new file mode 100644 index 00000000000..ea4fb127913 --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/y.config @@ -0,0 +1,123 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +- This file is intentionally empty with this badly formed comment line. diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index d8699797943..4a43005b781 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -1130,6 +1130,9 @@ flakyIfCI ticket m = do flakyIfWindows :: IssueID -> TestM a -> TestM a flakyIfWindows ticket m = flakyIf isWindows ticket m +normalizeWindowsOutput :: String -> String +normalizeWindowsOutput = if isWindows then map (\x -> case x of '/' -> '\\'; _ -> x) else id + getOpenFilesLimit :: TestM (Maybe Integer) #ifdef mingw32_HOST_OS -- No MS-specified limit, was determined experimentally on Windows 10 Pro x64, diff --git a/changelog.d/pr-10644.md b/changelog.d/pr-10644.md new file mode 100644 index 00000000000..f6e31264567 --- /dev/null +++ b/changelog.d/pr-10644.md @@ -0,0 +1,165 @@ +--- +synopsis: Show source of project parse error or warning +packages: [cabal-install] +prs: 10644 +issues: 10635 +--- + +Improves warning and error messages shown when parsing project files and their +imports. + +## Warning Messages + +To trigger these warning messages, the examples use badly formed comments that +have a single dash instead of two as is required of a line comment in `.cabal` +and `.project` files (and imported `.config` files). + + +* Before the fix: + + The `cabal.project` file name is repeated. Warnings are misattributed to + having been in the project rather than from a configuration file imported by + the project. Warnings are shown in reverse line number order. + + ``` + $ ~/.ghcup/bin/cabal-3.12.1.0 build all --dry-run + ... + Warning: + /.../ParseWarningProvenance/cabal.project, + cabal.project, cabal.project, cabal.project, cabal.project: Unrecognized + section '-' on line 123 + /.../ParseWarningProvenance/cabal.project, + cabal.project, cabal.project, cabal.project, cabal.project: Unrecognized + section '-' on line 3 + /.../ParseWarningProvenance/cabal.project, + cabal.project, cabal.project, cabal.project, cabal.project: Unrecognized + section '-' on line 2 + /.../ParseWarningProvenance/cabal.project, + cabal.project, cabal.project, cabal.project, cabal.project: Unrecognized + section '-' on line 1 + /.../ParseWarningProvenance/cabal.project, + cabal.project, cabal.project, cabal.project, cabal.project: Unrecognized + section '-' on line 123 + /.../ParseWarningProvenance/cabal.project, + cabal.project, cabal.project, cabal.project, cabal.project: Unrecognized + section '-' on line 3 + /.../ParseWarningProvenance/cabal.project, + cabal.project, cabal.project, cabal.project, cabal.project: Unrecognized + section '-' on line 2 + /.../ParseWarningProvenance/cabal.project, + cabal.project, cabal.project, cabal.project, cabal.project: Unrecognized + section '-' on line 1 + ``` + +* After the fix: + + The warnings are shown in a list. For warnings within the same `.project` or + imported `.config` file, warnings are sorted by line number. The file that + is the source of the warning is shown. + + The warnings associated with configuration files are shown in the order + these files were imported by the project: + + ``` + $ cat cabal.project + packages: no-pkg-dir + import: dir-x/a.config + import: dir-y/a.config + import: x.config + import: y.config + ``` + + ``` + $ cabal build all --dry-run + ... + Warnings found while parsing the project file, cabal.project: + - dir-x/a.config: Unrecognized section '-' on line 1 + - dir-x/a.config: Unrecognized section '-' on line 2 + - dir-x/a.config: Unrecognized section '-' on line 3 + - dir-y/a.config: Unrecognized section '-' on line 123 + - x.config: Unrecognized section '-' on line 1 + - x.config: Unrecognized section '-' on line 2 + - x.config: Unrecognized section '-' on line 3 + - y.config: Unrecognized section '-' on line 123 + ``` + +## Error Messages from Project + +To trigger these error messages, the examples use badly formed conditions: + +``` +$ cat cabal.project +-- The following failing condition is not on the first line so we can check the +-- line number: +if _ +``` + +* Before the fix: + + The parse error is shown with hard line breaks. + + ``` + $ ~/.ghcup/bin/cabal-3.12.1.0 build all --dry-run + ... + Error: [Cabal-7090] + Error parsing project file /.../ParseErrorProvenance/cabal.project:3: + "" (line 1, column 1): + unexpected SecArgName (Position 1 4) "_" + ``` + +* After the fix: + + The snippet that failed to parse may be shown and the parse error is shown + as one line, with no hard line breaks. + + ``` + $ cabal build all --dry-run + ... + Error: [Cabal-7090] + Error parsing project file cabal.project:3: + - Failed to parse 'if(_)' with error: + "" (line 1, column 1): unexpected SecArgName (Position 1 4) "_" + ``` + +## Error Messages from Imported Config + +With the same setup but now with the error in an imported file: + +``` +$ cat elif.project +import: dir-elif/elif.config + +$ cat dir-elif/elif.config +-- The following failing condition is not on the first line so we can check the +-- line number: +if false +elif _ +``` + +* Before the fix: + + The project rather than the imported configuration file is shown as the source file. + + ``` + $ ~/.ghcup/bin/cabal-3.12.1.0 build all --dry-run + ... + Error: [Cabal-7090] + Error parsing project file /.../ParseErrorProvenance/elif.project:4: + "" (line 1, column 1): + unexpected SecArgName (Position 1 6) "_" + ``` + +* After the fix: + + The imported configuration file is shown as the source with a snippet of the error. + + ``` + $ cabal build all --dry-run + ... + Error: [Cabal-7090] + Error parsing project file dir-elif/elif.config:4: + - dir-elif/elif.config + imported by: elif.project + - Failed to parse 'elif(_)' with error: + "" (line 1, column 1): unexpected SecArgName (Position 1 6) "_" + ```