From 86c71533aa4f42687af6b649eb6233779a28c3d8 Mon Sep 17 00:00:00 2001 From: jgotoh <18658140+jgotoh@users.noreply.github.com> Date: Fri, 31 May 2024 09:33:42 +0200 Subject: [PATCH 1/2] Replace cabal project parsing with parsec implementation The new parser replicates the grammar of the legacy parser while providing better error reporting and more maintainable code structure. The fallback strategy ensures smooth transition while the legacy parser is phased out. The flag `--project-file-parser` allows you to select which project file parser to use. * `legacy` - the old parser (will be removed in a future release) * `default` - the default parser (uses `fallback` unless compiled with `-f+legacy-comparison`) * `parsec` - the new parser using Parsec * `fallback` - the new parser using Parsec, but falling back to the old parser if it fails * `compare` - the new parser using Parsec, but comparing the results with the old parser When `cabal-install` is compiled, then the `-f+legacy-comparision` flag can be passed which changes the default parser mode to `compare`. Fixes #6101 #7748 #10611 --- Cabal-syntax/Cabal-syntax.cabal | 1 + Cabal-syntax/src/Distribution/FieldGrammar.hs | 15 + .../src/Distribution/FieldGrammar/Parsec.hs | 35 +- Cabal-syntax/src/Distribution/Fields.hs | 5 + .../src/Distribution/Fields/ConfVar.hs | 22 +- .../src/Distribution/Fields/ParseResult.hs | 141 ++-- .../src/Distribution/InstalledPackageInfo.hs | 10 +- .../PackageDescription/FieldGrammar.hs | 4 +- .../Distribution/PackageDescription/Parsec.hs | 82 +-- Cabal-syntax/src/Distribution/Parsec.hs | 17 +- Cabal-syntax/src/Distribution/Parsec/Error.hs | 14 +- .../src/Distribution/Parsec/Source.hs | 45 ++ .../src/Distribution/Parsec/Warning.hs | 21 +- Cabal-tests/tests/CheckTests.hs | 9 +- Cabal-tests/tests/HackageTests.hs | 14 +- Cabal-tests/tests/NoThunks.hs | 5 +- Cabal-tests/tests/ParserTests.hs | 28 +- Cabal/src/Distribution/Simple/Compiler.hs | 59 +- Cabal/src/Distribution/Simple/InstallDirs.hs | 90 +++ .../Distribution/Simple/PackageDescription.hs | 41 +- Cabal/src/Distribution/Simple/Setup/Config.hs | 9 - Cabal/src/Distribution/Types/DumpBuildInfo.hs | 10 + .../Solver/Types/ProjectConfigPath.hs | 12 + .../src/Distribution/Solver/Types/Settings.hs | 23 + cabal-install/cabal-install.cabal | 33 + cabal-install/parser-tests/Tests.hs | 7 + .../parser-tests/Tests/ParserTests.hs | 624 ++++++++++++++++++ .../files/all-packages-concat/cabal.project | 8 + .../Tests/files/empty/cabal.project | 0 .../Tests/files/extra-packages/cabal.project | 3 + .../haddock-all-overwrite-false/cabal.project | 2 + .../haddock-all-overwrite-true/cabal.project | 2 + .../Tests/files/haddock-all/cabal.project | 1 + .../Tests/files/install-dirs/cabal.project | 13 + .../files/library-coverage/cabal.project | 2 + .../files/local-no-index-repos/cabal.project | 5 + .../files/optional-packages/cabal.project | 1 + .../Tests/files/packages/cabal.project | 1 + .../program-locations-concat/cabal.project | 5 + .../program-options-concat/cabal.project | 9 + .../project-config-all-packages/cabal.project | 3 + .../project-config-build-only/cabal.project | 22 + .../cabal.project | 70 ++ .../files/project-config-shared/cabal.project | 39 ++ .../cabal.project | 12 + .../files/relax-deps-concat/cabal.project | 7 + .../Tests/files/remote-repos/cabal.project | 18 + .../source-repository-packages/cabal.project | 10 + .../specific-packages-concat/cabal.project | 7 + .../Client/BuildReports/Anonymous.hs | 4 +- .../src/Distribution/Client/Check.hs | 23 +- .../src/Distribution/Client/CmdConfigure.hs | 6 +- .../Client/CmdInstall/ClientInstallFlags.hs | 46 ++ .../src/Distribution/Client/Config.hs | 1 + .../src/Distribution/Client/Errors.hs | 27 +- .../src/Distribution/Client/Errors/Parser.hs | 277 ++++++++ .../src/Distribution/Client/ParseUtils.hs | 10 +- .../src/Distribution/Client/ProjectConfig.hs | 277 +++++--- .../Client/ProjectConfig/FieldGrammar.hs | 265 ++++++++ .../Client/ProjectConfig/Legacy.hs | 2 + .../Distribution/Client/ProjectConfig/Lens.hs | 557 ++++++++++++++++ .../Client/ProjectConfig/Parsec.hs | 427 ++++++++++++ .../Client/ProjectConfig/Types.hs | 21 + .../src/Distribution/Client/ProjectFlags.hs | 32 +- .../Distribution/Client/ProjectPlanning.hs | 8 +- .../src/Distribution/Client/ScriptUtils.hs | 2 +- .../Distribution/Client/Types/AllowNewer.hs | 6 + .../src/Distribution/Client/Types/Repo.hs | 34 +- .../Types/WriteGhcEnvironmentFilesPolicy.hs | 15 + .../src/Distribution/Client/Utils/Newtypes.hs | 120 ++++ .../src/Distribution/Client/Utils/Parsec.hs | 183 +++-- .../Distribution/Client/ProjectConfig.hs | 5 + .../Distribution/Client/TreeDiffInstances.hs | 1 + .../ConfiguredPackage/Sanity/NoName/cabal.out | 8 +- .../Sanity/NoVersion/cabal.out | 8 +- .../ConditionalAndImport/cabal.out | 198 ++++-- .../IndexCabalFileParseError/cabal.out | 3 +- .../FieldStanzaConfusion/cabal.out | 15 +- .../FieldStanzaConfusion/cabal.test.hs | 2 +- .../ParseErrorProvenance/cabal.out | 50 +- .../ParseErrorProvenance/cabal.test.hs | 8 +- .../ParseWarningProvenance/cabal.out | 16 +- .../PackageTests/Regression/T5213/cabal.out | 2 + .../Regression/T5213/cabal.project | 2 +- cabal-validate/src/Main.hs | 8 + cabal.validate.project | 6 +- changelog.d/pr-8889 | 27 + doc/cabal-project-description-file.rst | 18 +- 88 files changed, 3828 insertions(+), 508 deletions(-) create mode 100644 Cabal-syntax/src/Distribution/Parsec/Source.hs create mode 100644 cabal-install/parser-tests/Tests.hs create mode 100644 cabal-install/parser-tests/Tests/ParserTests.hs create mode 100644 cabal-install/parser-tests/Tests/files/all-packages-concat/cabal.project create mode 100644 cabal-install/parser-tests/Tests/files/empty/cabal.project create mode 100644 cabal-install/parser-tests/Tests/files/extra-packages/cabal.project create mode 100644 cabal-install/parser-tests/Tests/files/haddock-all-overwrite-false/cabal.project create mode 100644 cabal-install/parser-tests/Tests/files/haddock-all-overwrite-true/cabal.project create mode 100644 cabal-install/parser-tests/Tests/files/haddock-all/cabal.project create mode 100644 cabal-install/parser-tests/Tests/files/install-dirs/cabal.project create mode 100644 cabal-install/parser-tests/Tests/files/library-coverage/cabal.project create mode 100644 cabal-install/parser-tests/Tests/files/local-no-index-repos/cabal.project create mode 100644 cabal-install/parser-tests/Tests/files/optional-packages/cabal.project create mode 100644 cabal-install/parser-tests/Tests/files/packages/cabal.project create mode 100644 cabal-install/parser-tests/Tests/files/program-locations-concat/cabal.project create mode 100644 cabal-install/parser-tests/Tests/files/program-options-concat/cabal.project create mode 100644 cabal-install/parser-tests/Tests/files/project-config-all-packages/cabal.project create mode 100644 cabal-install/parser-tests/Tests/files/project-config-build-only/cabal.project create mode 100644 cabal-install/parser-tests/Tests/files/project-config-local-packages/cabal.project create mode 100644 cabal-install/parser-tests/Tests/files/project-config-shared/cabal.project create mode 100644 cabal-install/parser-tests/Tests/files/project-config-specific-packages/cabal.project create mode 100644 cabal-install/parser-tests/Tests/files/relax-deps-concat/cabal.project create mode 100644 cabal-install/parser-tests/Tests/files/remote-repos/cabal.project create mode 100644 cabal-install/parser-tests/Tests/files/source-repository-packages/cabal.project create mode 100644 cabal-install/parser-tests/Tests/files/specific-packages-concat/cabal.project create mode 100644 cabal-install/src/Distribution/Client/Errors/Parser.hs create mode 100644 cabal-install/src/Distribution/Client/ProjectConfig/FieldGrammar.hs create mode 100644 cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs create mode 100644 cabal-install/src/Distribution/Client/ProjectConfig/Parsec.hs create mode 100644 cabal-install/src/Distribution/Client/Utils/Newtypes.hs create mode 100644 changelog.d/pr-8889 diff --git a/Cabal-syntax/Cabal-syntax.cabal b/Cabal-syntax/Cabal-syntax.cabal index dd3137786e2..1d651252b45 100644 --- a/Cabal-syntax/Cabal-syntax.cabal +++ b/Cabal-syntax/Cabal-syntax.cabal @@ -107,6 +107,7 @@ library Distribution.Parsec.FieldLineStream Distribution.Parsec.Position Distribution.Parsec.Warning + Distribution.Parsec.Source Distribution.Pretty Distribution.SPDX Distribution.SPDX.License diff --git a/Cabal-syntax/src/Distribution/FieldGrammar.hs b/Cabal-syntax/src/Distribution/FieldGrammar.hs index e41dd6350c2..78739a37cfa 100644 --- a/Cabal-syntax/src/Distribution/FieldGrammar.hs +++ b/Cabal-syntax/src/Distribution/FieldGrammar.hs @@ -15,6 +15,7 @@ module Distribution.FieldGrammar , ParsecFieldGrammar , ParsecFieldGrammar' , parseFieldGrammar + , parseFieldGrammarCheckingStanzas , fieldGrammarKnownFieldList , PrettyFieldGrammar , PrettyFieldGrammar' @@ -65,6 +66,20 @@ x ^^^ f = f x data PS ann = PS (Fields ann) [Section ann] [[Section ann]] -- | Partition field list into field map and groups of sections. +-- Groups sections between fields. This means that the following snippet contains +-- two section groups: +-- +-- @ +-- -- first group +-- some-section +-- field: value +-- another-section +-- field: value +-- foo: bar +-- -- second group +-- yet-another-section +-- field: value +-- @ partitionFields :: [Field ann] -> (Fields ann, [[Section ann]]) partitionFields = finalize . foldl' f (PS mempty mempty mempty) where diff --git a/Cabal-syntax/src/Distribution/FieldGrammar/Parsec.hs b/Cabal-syntax/src/Distribution/FieldGrammar/Parsec.hs index 4721aa4ad08..461a76cdd44 100644 --- a/Cabal-syntax/src/Distribution/FieldGrammar/Parsec.hs +++ b/Cabal-syntax/src/Distribution/FieldGrammar/Parsec.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -- | This module provides a 'FieldGrammarParser', one way to parse @@ -54,6 +55,7 @@ module Distribution.FieldGrammar.Parsec ( ParsecFieldGrammar , parseFieldGrammar + , parseFieldGrammarCheckingStanzas , fieldGrammarKnownFieldList -- * Auxiliary @@ -112,24 +114,35 @@ data Section ann = MkSection !(Name ann) [SectionArg ann] [Field ann] data ParsecFieldGrammar s a = ParsecFG { fieldGrammarKnownFields :: !(Set FieldName) , fieldGrammarKnownPrefixes :: !(Set FieldName) - , fieldGrammarParser :: !(CabalSpecVersion -> Fields Position -> ParseResult a) + , fieldGrammarParser :: forall src. (CabalSpecVersion -> Fields Position -> ParseResult src a) } deriving (Functor) -parseFieldGrammar :: CabalSpecVersion -> Fields Position -> ParsecFieldGrammar s a -> ParseResult a +parseFieldGrammar :: CabalSpecVersion -> Fields Position -> ParsecFieldGrammar s a -> ParseResult src a parseFieldGrammar v fields grammar = do - for_ (Map.toList (Map.filterWithKey isUnknownField fields)) $ \(name, nfields) -> + for_ (Map.toList (Map.filterWithKey (isUnknownField grammar) fields)) $ \(name, nfields) -> for_ nfields $ \(MkNamelessField pos _) -> parseWarning pos PWTUnknownField $ "Unknown field: " ++ show name -- TODO: fields allowed in this section -- parse fieldGrammarParser grammar v fields - where - isUnknownField k _ = - not $ - k `Set.member` fieldGrammarKnownFields grammar - || any (`BS.isPrefixOf` k) (fieldGrammarKnownPrefixes grammar) + +isUnknownField :: ParsecFieldGrammar s a -> FieldName -> [NamelessField Position] -> Bool +isUnknownField grammar k _ = + not $ + k `Set.member` fieldGrammarKnownFields grammar + || any (`BS.isPrefixOf` k) (fieldGrammarKnownPrefixes grammar) + +-- | Parse a ParsecFieldGrammar and check for fields that should be stanzas. +parseFieldGrammarCheckingStanzas :: CabalSpecVersion -> Fields Position -> ParsecFieldGrammar s a -> Set BS.ByteString -> ParseResult src a +parseFieldGrammarCheckingStanzas v fields grammar sections = do + for_ (Map.toList (Map.filterWithKey (isUnknownField grammar) fields)) $ \(name, nfields) -> + for_ nfields $ \(MkNamelessField pos _) -> + if name `Set.member` sections + then parseFailure pos $ "'" ++ fromUTF8BS name ++ "' is a stanza, not a field. Remove the trailing ':' to parse a stanza." + else parseWarning pos PWTUnknownField $ "Unknown field: " ++ show name + fieldGrammarParser grammar v fields fieldGrammarKnownFieldList :: ParsecFieldGrammar s a -> [FieldName] fieldGrammarKnownFieldList = Set.toList . fieldGrammarKnownFields @@ -145,7 +158,7 @@ instance Applicative (ParsecFieldGrammar s) where (\v fields -> f'' v fields <*> x'' v fields) {-# INLINE (<*>) #-} -warnMultipleSingularFields :: FieldName -> [NamelessField Position] -> ParseResult () +warnMultipleSingularFields :: FieldName -> [NamelessField Position] -> ParseResult src () warnMultipleSingularFields _ [] = pure () warnMultipleSingularFields fn (x : xs) = do let pos = namelessFieldAnn x @@ -349,7 +362,7 @@ instance FieldGrammar Parsec ParsecFieldGrammar where -- Parsec ------------------------------------------------------------------------------- -runFieldParser' :: [Position] -> ParsecParser a -> CabalSpecVersion -> FieldLineStream -> ParseResult a +runFieldParser' :: [Position] -> ParsecParser a -> CabalSpecVersion -> FieldLineStream -> ParseResult src a runFieldParser' inputPoss p v str = case P.runParser p' [] "" str of Right (pok, ws) -> do traverse_ (\(PWarning t pos w) -> parseWarning (mapPosition pos) t w) ws @@ -378,7 +391,7 @@ runFieldParser' inputPoss p v str = case P.runParser p' [] "" str of go n (Position row col : _) | n <= 0 = Position row (col + pcol - 1) go n (_ : ps) = go (n - 1) ps -runFieldParser :: Position -> ParsecParser a -> CabalSpecVersion -> [FieldLine Position] -> ParseResult a +runFieldParser :: Position -> ParsecParser a -> CabalSpecVersion -> [FieldLine Position] -> ParseResult src a runFieldParser pp p v ls = runFieldParser' poss p v (fieldLinesToStream ls) where poss = map (\(FieldLine pos _) -> pos) ls ++ [pp] -- add "default" position diff --git a/Cabal-syntax/src/Distribution/Fields.hs b/Cabal-syntax/src/Distribution/Fields.hs index 4688bf547d9..9aabb9ff7fe 100644 --- a/Cabal-syntax/src/Distribution/Fields.hs +++ b/Cabal-syntax/src/Distribution/Fields.hs @@ -25,11 +25,16 @@ module Distribution.Fields -- ** Warnings , PWarnType (..) , PWarning (..) + , PWarningWithSource (..) + , PSource (..) , showPWarning + , showPWarningWithSource -- ** Errors , PError (..) + , PErrorWithSource (..) , showPError + , showPErrorWithSource -- * Pretty printing , CommentPosition (..) diff --git a/Cabal-syntax/src/Distribution/Fields/ConfVar.hs b/Cabal-syntax/src/Distribution/Fields/ConfVar.hs index 760e2335143..e5878db3df7 100644 --- a/Cabal-syntax/src/Distribution/Fields/ConfVar.hs +++ b/Cabal-syntax/src/Distribution/Fields/ConfVar.hs @@ -4,11 +4,12 @@ module Distribution.Fields.ConfVar (parseConditionConfVar, parseConditionConfVar import Distribution.Compat.CharParsing (char, integral) import Distribution.Compat.Prelude -import Distribution.Fields.Field (Field (..), SectionArg (..)) +import Distribution.Fields.Field (Field (..), SectionArg (..), sectionArgAnn) import Distribution.Fields.ParseResult import Distribution.Fields.Parser (readFields) -import Distribution.Parsec (Parsec (..), Position (..), runParsecParser) +import Distribution.Parsec (Parsec (..), runParsecParser) import Distribution.Parsec.FieldLineStream (fieldLineStreamFromBS) +import Distribution.Parsec.Position import Distribution.Types.Condition import Distribution.Types.ConfVar (ConfVar (..)) import Distribution.Version @@ -40,10 +41,10 @@ parseConditionConfVarFromClause x = -- | Parse @'Condition' 'ConfVar'@ from section arguments provided by parsec -- based outline parser. -parseConditionConfVar :: [SectionArg Position] -> ParseResult (Condition ConfVar) -parseConditionConfVar args = +parseConditionConfVar :: Position -> [SectionArg Position] -> ParseResult src (Condition ConfVar) +parseConditionConfVar start_pos args = -- The name of the input file is irrelevant, as we reformat the error message. - case P.runParser (parser <* P.eof) () "" args of + case P.runParser (P.setPosition startPos >> parser <* P.eof) () "" args of Right x -> pure x Left err -> do -- Mangle the position to the actual one @@ -59,7 +60,10 @@ parseConditionConfVar args = (P.errorMessages err) parseFailure epos msg pure $ Lit True + where + startPos = P.newPos "" (positionRow start_pos) (positionCol start_pos) +-- | Parser for 'Condition' 'ConfVar' type Parser = P.Parsec [SectionArg Position] () sepByNonEmpty :: Parser a -> Parser sep -> Parser (NonEmpty a) @@ -132,6 +136,7 @@ parser = condOr | s == "false" -> Just False _ -> Nothing + string :: B8.ByteString -> Parser () string s = tokenPrim $ \t -> case t of SecArgName _ s' | s == s' -> Just () _ -> Nothing @@ -142,9 +147,12 @@ parser = condOr parens = P.between (oper "(") (oper ")") + tokenPrim :: (SectionArg Position -> Maybe a) -> Parser a tokenPrim = P.tokenPrim prettySectionArg updatePosition - -- TODO: check where the errors are reported - updatePosition x _ _ = x + updatePosition :: P.SourcePos -> SectionArg Position -> [SectionArg Position] -> P.SourcePos + updatePosition x s _ = + let Position line col = sectionArgAnn s + in P.setSourceLine (P.setSourceColumn x col) (line) prettySectionArg = show fromParsec :: Parsec a => Parser a diff --git a/Cabal-syntax/src/Distribution/Fields/ParseResult.hs b/Cabal-syntax/src/Distribution/Fields/ParseResult.hs index 912ea7fb02f..6c2dbe5e552 100644 --- a/Cabal-syntax/src/Distribution/Fields/ParseResult.hs +++ b/Cabal-syntax/src/Distribution/Fields/ParseResult.hs @@ -6,6 +6,8 @@ module Distribution.Fields.ParseResult ( ParseResult , runParseResult + , PSource (..) + , CabalFileSource (..) , recoverWith , parseWarning , parseWarnings @@ -15,131 +17,160 @@ module Distribution.Fields.ParseResult , getCabalSpecVersion , setCabalSpecVersion , withoutWarnings + , liftParseResult + , withSource ) where import Distribution.Compat.Prelude -import Distribution.Parsec.Error (PError (..)) +import Distribution.Parsec.Error (PError (..), PErrorWithSource (..)) import Distribution.Parsec.Position (Position (..), zeroPos) -import Distribution.Parsec.Warning (PWarnType (..), PWarning (..)) +import Distribution.Parsec.Source +import Distribution.Parsec.Warning import Distribution.Version (Version) -- | A monad with failure and accumulating errors and warnings. -newtype ParseResult a = PR +newtype ParseResult src a = PR { unPR :: forall r - . PRState - -> (PRState -> r) -- failure, but we were able to recover a new-style spec-version declaration - -> (PRState -> a -> r) -- success + . PRState src + -> PRContext src + -> (PRState src -> r) -- failure, but we were able to recover a new-style spec-version declaration + -> (PRState src -> a -> r) -- success -> r } +data PRContext src = PRContext + { prContextSource :: PSource src + -- ^ The file we are parsing, if known. This field is parametric because we + -- use the same parser for cabal files and project files. + } + -- Note: we have version here, as we could get any version. -data PRState = PRState ![PWarning] ![PError] !(Maybe Version) +data PRState src = PRState ![PWarningWithSource src] ![PErrorWithSource src] !(Maybe Version) -emptyPRState :: PRState +emptyPRState :: PRState src emptyPRState = PRState [] [] Nothing -- | Forget 'ParseResult's warnings. -- -- @since 3.4.0.0 -withoutWarnings :: ParseResult a -> ParseResult a -withoutWarnings m = PR $ \s failure success -> - unPR m s failure $ \ !s1 -> success (s1 `withWarningsOf` s) +withoutWarnings :: ParseResult src a -> ParseResult src a +withoutWarnings m = PR $ \s ctx failure success -> + unPR m s ctx failure $ \ !s1 -> success (s1 `withWarningsOf` s) where withWarningsOf (PRState _ e v) (PRState w _ _) = PRState w e v -- | Destruct a 'ParseResult' into the emitted warnings and either -- a successful value or -- list of errors and possibly recovered a spec-version declaration. -runParseResult :: ParseResult a -> ([PWarning], Either (Maybe Version, NonEmpty PError) a) -runParseResult pr = unPR pr emptyPRState failure success +runParseResult :: ParseResult src a -> ([PWarningWithSource src], Either (Maybe Version, NonEmpty (PErrorWithSource src)) a) +runParseResult pr = unPR pr emptyPRState initialCtx failure success where - failure (PRState warns [] v) = (warns, Left (v, PError zeroPos "panic" :| [])) + initialCtx = PRContext PUnknownSource + + failure (PRState warns [] v) = (warns, Left (v, PErrorWithSource PUnknownSource (PError zeroPos "panic") :| [])) failure (PRState warns (err : errs) v) = (warns, Left (v, err :| errs)) success (PRState warns [] _) x = (warns, Right x) -- If there are any errors, don't return the result success (PRState warns (err : errs) v) _ = (warns, Left (v, err :| errs)) -instance Functor ParseResult where - fmap f (PR pr) = PR $ \ !s failure success -> - pr s failure $ \ !s' a -> +-- | Chain parsing operations that involve 'IO' actions. +liftParseResult :: (a -> IO (ParseResult src b)) -> ParseResult src a -> IO (ParseResult src b) +liftParseResult f pr = unPR pr emptyPRState initialCtx failure success + where + initialCtx = PRContext PUnknownSource + + failure s = return $ PR $ \s' _ctx failure' _ -> failure' (concatPRState s s') + success s a = do + pr' <- f a + return $ PR $ \s' ctx failure' success' -> unPR pr' (concatPRState s s') ctx failure' success' + concatPRState (PRState warnings errors version) (PRState warnings' errors' version') = + (PRState (warnings ++ warnings') (toList errors ++ errors') (version <|> version')) + +withSource :: src -> ParseResult src a -> ParseResult src a +withSource source (PR pr) = PR $ \s ctx failure success -> + pr s (ctx{prContextSource = PKnownSource source}) failure success + +instance Functor (ParseResult src) where + fmap f (PR pr) = PR $ \ !s fp failure success -> + pr s fp failure $ \ !s' a -> success s' (f a) {-# INLINE fmap #-} -instance Applicative ParseResult where - pure x = PR $ \ !s _ success -> success s x +instance Applicative (ParseResult src) where + pure x = PR $ \ !s _ _ success -> success s x {-# INLINE pure #-} - f <*> x = PR $ \ !s0 failure success -> - unPR f s0 failure $ \ !s1 f' -> - unPR x s1 failure $ \ !s2 x' -> + f <*> x = PR $ \ !s0 fp failure success -> + unPR f s0 fp failure $ \ !s1 f' -> + unPR x s1 fp failure $ \ !s2 x' -> success s2 (f' x') {-# INLINE (<*>) #-} - x *> y = PR $ \ !s0 failure success -> - unPR x s0 failure $ \ !s1 _ -> - unPR y s1 failure success + x *> y = PR $ \ !s0 fp failure success -> + unPR x s0 fp failure $ \ !s1 _ -> + unPR y s1 fp failure success {-# INLINE (*>) #-} - x <* y = PR $ \ !s0 failure success -> - unPR x s0 failure $ \ !s1 x' -> - unPR y s1 failure $ \ !s2 _ -> + x <* y = PR $ \ !s0 fp failure success -> + unPR x s0 fp failure $ \ !s1 x' -> + unPR y s1 fp failure $ \ !s2 _ -> success s2 x' {-# INLINE (<*) #-} -instance Monad ParseResult where +instance Monad (ParseResult src) where return = pure (>>) = (*>) - m >>= k = PR $ \ !s failure success -> - unPR m s failure $ \ !s' a -> - unPR (k a) s' failure success + m >>= k = PR $ \ !s fp failure success -> + unPR m s fp failure $ \ !s' a -> + unPR (k a) s' fp failure success {-# INLINE (>>=) #-} -- | "Recover" the parse result, so we can proceed parsing. -- 'runParseResult' will still result in 'Nothing', if there are recorded errors. -recoverWith :: ParseResult a -> a -> ParseResult a -recoverWith (PR pr) x = PR $ \ !s _failure success -> - pr s (\ !s' -> success s' x) success +recoverWith :: ParseResult src a -> a -> ParseResult src a +recoverWith (PR pr) x = PR $ \ !s fp _failure success -> + pr s fp (\ !s' -> success s' x) success -- | Set cabal spec version. -setCabalSpecVersion :: Maybe Version -> ParseResult () -setCabalSpecVersion v = PR $ \(PRState warns errs _) _failure success -> +setCabalSpecVersion :: Maybe Version -> ParseResult src () +setCabalSpecVersion v = PR $ \(PRState warns errs _) _fp _failure success -> success (PRState warns errs v) () -- | Get cabal spec version. -getCabalSpecVersion :: ParseResult (Maybe Version) -getCabalSpecVersion = PR $ \s@(PRState _ _ v) _failure success -> +getCabalSpecVersion :: ParseResult src (Maybe Version) +getCabalSpecVersion = PR $ \s@(PRState _ _ v) _fp _failure success -> success s v -- | Add a warning. This doesn't fail the parsing process. -parseWarning :: Position -> PWarnType -> String -> ParseResult () -parseWarning pos t msg = PR $ \(PRState warns errs v) _failure success -> - success (PRState (PWarning t pos msg : warns) errs v) () +parseWarning :: Position -> PWarnType -> String -> ParseResult src () +parseWarning pos t msg = PR $ \(PRState warns errs v) ctx _failure success -> + success (PRState (PWarningWithSource (prContextSource ctx) (PWarning t pos msg) : warns) errs v) () -- | Add multiple warnings at once. -parseWarnings :: [PWarning] -> ParseResult () -parseWarnings newWarns = PR $ \(PRState warns errs v) _failure success -> - success (PRState (newWarns ++ warns) errs v) () +parseWarnings :: [PWarning] -> ParseResult src () +parseWarnings newWarns = PR $ \(PRState warns errs v) ctx _failure success -> + success (PRState (map (PWarningWithSource (prContextSource ctx)) newWarns ++ warns) errs v) () -- | Add an error, but not fail the parser yet. -- -- For fatal failure use 'parseFatalFailure' -parseFailure :: Position -> String -> ParseResult () -parseFailure pos msg = PR $ \(PRState warns errs v) _failure success -> - success (PRState warns (PError pos msg : errs) v) () +parseFailure :: Position -> String -> ParseResult src () +parseFailure pos msg = PR $ \(PRState warns errs v) ctx _failure success -> + success (PRState warns (PErrorWithSource (prContextSource ctx) (PError pos msg) : errs) v) () -- | Add an fatal error. -parseFatalFailure :: Position -> String -> ParseResult a -parseFatalFailure pos msg = PR $ \(PRState warns errs v) failure _success -> - failure (PRState warns (PError pos msg : errs) v) +parseFatalFailure :: Position -> String -> ParseResult src a +parseFatalFailure pos msg = PR $ \(PRState warns errs v) ctx failure _success -> + failure (PRState warns (PErrorWithSource (prContextSource ctx) (PError pos msg) : errs) v) -- | A 'mzero'. -parseFatalFailure' :: ParseResult a +parseFatalFailure' :: ParseResult src a parseFatalFailure' = PR pr where - pr (PRState warns [] v) failure _success = failure (PRState warns [err] v) - pr s failure _success = failure s + pr (PRState warns [] v) _ctx failure _success = failure (PRState warns [err] v) + pr s _ctx failure _success = failure s - err = PError zeroPos "Unknown fatal error" + err = PErrorWithSource PUnknownSource (PError zeroPos "Unknown fatal error") diff --git a/Cabal-syntax/src/Distribution/InstalledPackageInfo.hs b/Cabal-syntax/src/Distribution/InstalledPackageInfo.hs index 2c15d678335..350b9fee757 100644 --- a/Cabal-syntax/src/Distribution/InstalledPackageInfo.hs +++ b/Cabal-syntax/src/Distribution/InstalledPackageInfo.hs @@ -47,9 +47,11 @@ import Distribution.Backpack import Distribution.CabalSpecVersion (cabalSpecLatest) import Distribution.FieldGrammar import Distribution.FieldGrammar.FieldDescrs +import Distribution.Fields.ParseResult import Distribution.Fields.Pretty import Distribution.ModuleName import Distribution.Package hiding (installedUnitId) +import Distribution.Parsec.Source import Distribution.Types.ComponentName import Distribution.Utils.Generic (toUTF8BS) @@ -98,18 +100,18 @@ parseInstalledPackageInfo parseInstalledPackageInfo s = case P.readFields s of Left err -> Left (show err :| []) Right fs -> case partitionFields fs of - (fs', _) -> case P.runParseResult $ parseFieldGrammar cabalSpecLatest fs' ipiFieldGrammar of + (fs', _) -> case P.runParseResult $ withSource PInstalledPackageInfo $ parseFieldGrammar cabalSpecLatest fs' ipiFieldGrammar of (ws, Right x) -> x `deepseq` Right (ws', x) where ws' = - [ P.showPWarning "" w - | w@(P.PWarning wt _ _) <- ws + [ P.showPWarningWithSource (fmap renderInstalledPackageInfoSource w) + | w@(P.PWarningWithSource _ (P.PWarning wt _ _)) <- ws , -- filter out warnings about experimental features wt /= P.PWTExperimental ] (_, Left (_, errs)) -> Left errs' where - errs' = fmap (P.showPError "") errs + errs' = fmap (P.showPErrorWithSource . fmap renderInstalledPackageInfoSource) errs -- ----------------------------------------------------------------------------- -- Pretty-printing diff --git a/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs b/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs index 0b04b446c04..24861389b8f 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs @@ -361,7 +361,7 @@ testSuiteFieldGrammar = <*> monoidalFieldAla "code-generators" (alaList' CommaFSep Token) testStanzaCodeGenerators ^^^ availableSince CabalSpecV3_8 [] -validateTestSuite :: CabalSpecVersion -> Position -> TestSuiteStanza -> ParseResult TestSuite +validateTestSuite :: CabalSpecVersion -> Position -> TestSuiteStanza -> ParseResult src TestSuite validateTestSuite cabalSpecVersion pos stanza = case testSuiteType of Nothing -> pure basicTestSuite Just tt@(TestTypeUnknown _ _) -> @@ -503,7 +503,7 @@ benchmarkFieldGrammar = <*> optionalField "benchmark-module" benchmarkStanzaBenchmarkModule <*> blurFieldGrammar benchmarkStanzaBuildInfo buildInfoFieldGrammar -validateBenchmark :: CabalSpecVersion -> Position -> BenchmarkStanza -> ParseResult Benchmark +validateBenchmark :: CabalSpecVersion -> Position -> BenchmarkStanza -> ParseResult src Benchmark validateBenchmark cabalSpecVersion pos stanza = case benchmarkStanzaType of Nothing -> pure diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs index 92256c98be5..c7e327ddb7f 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs @@ -20,6 +20,8 @@ module Distribution.PackageDescription.Parsec -- ** Parsing , ParseResult , runParseResult + , PSource (..) + , withSource -- * New-style spec-version , scanSpecVersion @@ -38,7 +40,7 @@ import Distribution.Compat.Lens import Distribution.FieldGrammar import Distribution.FieldGrammar.Parsec (NamelessField (..)) import Distribution.Fields.ConfVar (parseConditionConfVar) -import Distribution.Fields.Field (FieldName, getName) +import Distribution.Fields.Field (FieldName, getName, sectionArgAnn) import Distribution.Fields.LexerMonad (LexWarning, toPWarnings) import Distribution.Fields.ParseResult import Distribution.Fields.Parser @@ -48,7 +50,7 @@ import Distribution.PackageDescription.FieldGrammar import Distribution.PackageDescription.Quirks (patchQuirks) import Distribution.Parsec (parsec, simpleParsecBS) import Distribution.Parsec.FieldLineStream (fieldLineStreamFromBS) -import Distribution.Parsec.Position (Position (..), zeroPos) +import Distribution.Parsec.Position (Position (..), incPos, zeroPos) import Distribution.Parsec.Warning (PWarnType (..)) import Distribution.Pretty (prettyShow) import Distribution.Utils.Generic (breakMaybe, fromUTF8BS, toUTF8BS, unfoldrM, validateUTF8) @@ -74,7 +76,7 @@ import qualified Text.Parsec as P -- -- In Cabal 1.2 the syntax for package descriptions was changed to a format -- with sections and possibly indented property descriptions. -parseGenericPackageDescription :: BS.ByteString -> ParseResult GenericPackageDescription +parseGenericPackageDescription :: BS.ByteString -> ParseResult src GenericPackageDescription parseGenericPackageDescription bs = do -- set scanned version setCabalSpecVersion ver @@ -122,7 +124,7 @@ fieldlinesToBS :: [FieldLine ann] -> BS.ByteString fieldlinesToBS = BS.intercalate "\n" . map (\(FieldLine _ bs) -> bs) -- Monad in which sections are parsed -type SectionParser = StateT SectionS ParseResult +type SectionParser src = StateT SectionS (ParseResult src) -- | State of section parser data SectionS = SectionS @@ -150,7 +152,7 @@ parseGenericPackageDescription' -> [LexWarning] -> Maybe Int -> [Field Position] - -> ParseResult GenericPackageDescription + -> ParseResult src GenericPackageDescription parseGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = do parseWarnings (toPWarnings lexWarnings) for_ utf8WarnPos $ \pos -> @@ -220,7 +222,7 @@ parseGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = do newSyntaxVersion :: CabalSpecVersion newSyntaxVersion = CabalSpecV1_2 - maybeWarnCabalVersion :: Syntax -> PackageDescription -> ParseResult () + maybeWarnCabalVersion :: Syntax -> PackageDescription -> ParseResult src () maybeWarnCabalVersion syntax pkg | syntax == NewSyntax && specVersion pkg < newSyntaxVersion = parseWarning zeroPos PWTNewSyntax $ @@ -238,7 +240,7 @@ parseGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = do cabalFormatVersionsDesc :: String cabalFormatVersionsDesc = "Current cabal-version values are listed at https://cabal.readthedocs.io/en/stable/file-format-changelog.html." -goSections :: CabalSpecVersion -> [Field Position] -> SectionParser () +goSections :: CabalSpecVersion -> [Field Position] -> SectionParser src () goSections specVer = traverse_ process where process (Field (Name pos name) _) = @@ -261,10 +263,10 @@ goSections specVer = traverse_ process -> Map String CondTreeBuildInfo -- \^ common stanzas -> [Field Position] - -> ParseResult (CondTree ConfVar [Dependency] a) + -> ParseResult src (CondTree ConfVar [Dependency] a) parseCondTree' = parseCondTreeWithCommonStanzas specVer - parseSection :: Name Position -> [SectionArg Position] -> [Field Position] -> SectionParser () + parseSection :: Name Position -> [SectionArg Position] -> [Field Position] -> SectionParser src () parseSection (Name pos name) args fields | hasCommonStanzas == NoCommonStanzas , name == "common" = lift $ do @@ -413,10 +415,10 @@ goSections specVer = traverse_ process parseWarning pos PWTUnknownSection $ "Ignoring section: " ++ show name -parseName :: Position -> [SectionArg Position] -> SectionParser String +parseName :: Position -> [SectionArg Position] -> SectionParser src String parseName pos args = fromUTF8BS <$> parseNameBS pos args -parseNameBS :: Position -> [SectionArg Position] -> SectionParser BS.ByteString +parseNameBS :: Position -> [SectionArg Position] -> SectionParser src BS.ByteString -- TODO: use strict parser parseNameBS pos args = case args of [SecArgName _pos secName] -> @@ -431,7 +433,7 @@ parseNameBS pos args = case args of lift $ parseFailure pos $ "Invalid name " ++ show args pure "" -parseCommonName :: Position -> [SectionArg Position] -> ParseResult String +parseCommonName :: Position -> [SectionArg Position] -> ParseResult src String parseCommonName pos args = case args of [SecArgName _pos secName] -> pure $ fromUTF8BS secName @@ -446,7 +448,7 @@ parseCommonName pos args = case args of pure "" -- TODO: avoid conversion to 'String'. -parseUnqualComponentName :: Position -> [SectionArg Position] -> SectionParser UnqualComponentName +parseUnqualComponentName :: Position -> [SectionArg Position] -> SectionParser src UnqualComponentName parseUnqualComponentName pos args = mkUnqualComponentName <$> parseName pos args -- | Parse a non-recursive list of fields. @@ -455,18 +457,18 @@ parseFields -> [Field Position] -- ^ fields to be parsed -> ParsecFieldGrammar' a - -> ParseResult a + -> ParseResult src a parseFields v fields grammar = do let (fs0, ss) = partitionFields fields traverse_ (traverse_ warnInvalidSubsection) ss parseFieldGrammar v fs0 grammar -warnInvalidSubsection :: Section Position -> ParseResult () +warnInvalidSubsection :: Section Position -> ParseResult src () warnInvalidSubsection (MkSection (Name pos name) _ _) = void $ parseFailure pos $ "invalid subsection " ++ show name parseCondTree - :: forall a + :: forall src a . L.HasBuildInfo a => CabalSpecVersion -> HasElif @@ -480,7 +482,7 @@ parseCondTree -> (a -> [Dependency]) -- ^ condition extractor -> [Field Position] - -> ParseResult (CondTree ConfVar [Dependency] a) + -> ParseResult src (CondTree ConfVar [Dependency] a) parseCondTree v hasElif grammar commonStanzas fromBuildInfo cond = go where go fields0 = do @@ -494,10 +496,10 @@ parseCondTree v hasElif grammar commonStanzas fromBuildInfo cond = go branches <- concat <$> traverse parseIfs ss return $ endo $ CondNode x (cond x) branches - parseIfs :: [Section Position] -> ParseResult [CondBranch ConfVar [Dependency] a] + parseIfs :: [Section Position] -> ParseResult src [CondBranch ConfVar [Dependency] a] parseIfs [] = return [] - parseIfs (MkSection (Name _ name) test fields : sections) | name == "if" = do - test' <- parseConditionConfVar test + parseIfs (MkSection (Name pos name) test fields : sections) | name == "if" = do + test' <- parseConditionConfVar (startOfSection (incPos 2 pos) test) test fields' <- go fields (elseFields, sections') <- parseElseIfs sections return (CondBranch test' fields' elseFields : sections') @@ -507,7 +509,7 @@ parseCondTree v hasElif grammar commonStanzas fromBuildInfo cond = go parseElseIfs :: [Section Position] - -> ParseResult (Maybe (CondTree ConfVar [Dependency] a), [CondBranch ConfVar [Dependency] a]) + -> ParseResult src (Maybe (CondTree ConfVar [Dependency] a), [CondBranch ConfVar [Dependency] a]) parseElseIfs [] = return (Nothing, []) parseElseIfs (MkSection (Name pos name) args fields : sections) | name == "else" = do unless (null args) $ @@ -516,10 +518,10 @@ parseCondTree v hasElif grammar commonStanzas fromBuildInfo cond = go elseFields <- go fields sections' <- parseIfs sections return (Just elseFields, sections') - parseElseIfs (MkSection (Name _ name) test fields : sections) + parseElseIfs (MkSection (Name pos name) test fields : sections) | hasElif == HasElif , name == "elif" = do - test' <- parseConditionConfVar test + test' <- parseConditionConfVar (startOfSection (incPos 4 pos) test) test fields' <- go fields (elseFields, sections') <- parseElseIfs sections -- we parse an empty 'Fields', to get empty value for a node @@ -530,6 +532,12 @@ parseCondTree v hasElif grammar commonStanzas fromBuildInfo cond = go (,) Nothing <$> parseIfs sections parseElseIfs sections = (,) Nothing <$> parseIfs sections +startOfSection :: Position -> [SectionArg Position] -> Position +-- The case where we have no args is the start of the section +startOfSection defaultPos [] = defaultPos +-- Otherwise the start of the section is the position of the first argument. +startOfSection _ (cond : _) = sectionArgAnn cond + {- Note [Accumulating parser] Note: Outdated a bit @@ -618,7 +626,7 @@ instance FromBuildInfo BenchmarkStanza where fromBuildInfo' _ bi = BenchmarkStanza Nothing Nothing Nothing bi parseCondTreeWithCommonStanzas - :: forall a + :: forall src a . L.HasBuildInfo a => CabalSpecVersion -> ParsecFieldGrammar' a @@ -628,7 +636,7 @@ parseCondTreeWithCommonStanzas -> Map String CondTreeBuildInfo -- ^ common stanzas -> [Field Position] - -> ParseResult (CondTree ConfVar [Dependency] a) + -> ParseResult src (CondTree ConfVar [Dependency] a) parseCondTreeWithCommonStanzas v grammar fromBuildInfo commonStanzas fields = do (fields', endo) <- processImports v fromBuildInfo commonStanzas fields x <- parseCondTree v hasElif grammar commonStanzas fromBuildInfo (view L.targetBuildDepends) fields' @@ -637,7 +645,7 @@ parseCondTreeWithCommonStanzas v grammar fromBuildInfo commonStanzas fields = do hasElif = specHasElif v processImports - :: forall a + :: forall src a . L.HasBuildInfo a => CabalSpecVersion -> (BuildInfo -> a) @@ -645,7 +653,7 @@ processImports -> Map String CondTreeBuildInfo -- ^ common stanzas -> [Field Position] - -> ParseResult ([Field Position], CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a) + -> ParseResult src ([Field Position], CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a) processImports v fromBuildInfo commonStanzas = go [] where hasCommonStanzas = specHasCommonStanzas v @@ -677,7 +685,7 @@ processImports v fromBuildInfo commonStanzas = go [] pure $ (fields', \x -> foldr (mergeCommonStanza fromBuildInfo) x acc) -- | Warn on "import" fields, also map to Maybe, so erroneous fields can be filtered -warnImport :: CabalSpecVersion -> Field Position -> ParseResult (Maybe (Field Position)) +warnImport :: CabalSpecVersion -> Field Position -> ParseResult src (Maybe (Field Position)) warnImport v (Field (Name pos name) _) | name == "import" = do if specHasCommonStanzas v == NoCommonStanzas then parseWarning pos PWTUnknownField "Unknown field: import. You should set cabal-version: 2.2 or larger to use common stanzas" @@ -731,7 +739,7 @@ onAllBranches p = go mempty -- -- * don't use undefined flags (very bad) -- * define flags which are unused (just bad) -checkForUndefinedFlags :: GenericPackageDescription -> ParseResult () +checkForUndefinedFlags :: GenericPackageDescription -> ParseResult src () checkForUndefinedFlags gpd = do let definedFlags, usedFlags :: Set.Set FlagName definedFlags = toSetOf (L.genPackageFlags . traverse . getting flagName) gpd @@ -748,7 +756,7 @@ checkForUndefinedFlags gpd = do -- | Since @cabal-version: 1.24@ one can specify @custom-setup@. -- Let us require it. -checkForUndefinedCustomSetup :: GenericPackageDescription -> ParseResult () +checkForUndefinedCustomSetup :: GenericPackageDescription -> ParseResult src () checkForUndefinedCustomSetup gpd = do let pd = packageDescription gpd let csv = specVersion pd @@ -923,7 +931,7 @@ libFieldNames = fieldGrammarKnownFieldList (libraryFieldGrammar LMainLibName) -- Supplementary build information ------------------------------------------------------------------------------- -parseHookedBuildInfo :: BS.ByteString -> ParseResult HookedBuildInfo +parseHookedBuildInfo :: BS.ByteString -> ParseResult src HookedBuildInfo parseHookedBuildInfo bs = case readFields' bs of Right (fs, lexWarnings) -> do parseHookedBuildInfo' lexWarnings fs @@ -933,7 +941,7 @@ parseHookedBuildInfo bs = case readFields' bs of parseHookedBuildInfo' :: [LexWarning] -> [Field Position] - -> ParseResult HookedBuildInfo + -> ParseResult src HookedBuildInfo parseHookedBuildInfo' lexWarnings fs = do parseWarnings (toPWarnings lexWarnings) (mLibFields, exes) <- stanzas fs @@ -941,24 +949,24 @@ parseHookedBuildInfo' lexWarnings fs = do biExes <- traverse parseExe exes return (mLib, biExes) where - parseLib :: Fields Position -> ParseResult (Maybe BuildInfo) + parseLib :: Fields Position -> ParseResult src (Maybe BuildInfo) parseLib fields | Map.null fields = pure Nothing | otherwise = Just <$> parseFieldGrammar cabalSpecLatest fields buildInfoFieldGrammar - parseExe :: (UnqualComponentName, Fields Position) -> ParseResult (UnqualComponentName, BuildInfo) + parseExe :: (UnqualComponentName, Fields Position) -> ParseResult src (UnqualComponentName, BuildInfo) parseExe (n, fields) = do bi <- parseFieldGrammar cabalSpecLatest fields buildInfoFieldGrammar pure (n, bi) - stanzas :: [Field Position] -> ParseResult (Fields Position, [(UnqualComponentName, Fields Position)]) + stanzas :: [Field Position] -> ParseResult src (Fields Position, [(UnqualComponentName, Fields Position)]) stanzas fields = do let (hdr0, exes0) = breakMaybe isExecutableField fields hdr <- toFields hdr0 exes <- unfoldrM (traverse toExe) exes0 pure (hdr, exes) - toFields :: [Field Position] -> ParseResult (Fields Position) + toFields :: [Field Position] -> ParseResult src (Fields Position) toFields fields = do let (fields', ss) = partitionFields fields traverse_ (traverse_ warnInvalidSubsection) ss @@ -966,7 +974,7 @@ parseHookedBuildInfo' lexWarnings fs = do toExe :: ([FieldLine Position], [Field Position]) - -> ParseResult ((UnqualComponentName, Fields Position), Maybe ([FieldLine Position], [Field Position])) + -> ParseResult src ((UnqualComponentName, Fields Position), Maybe ([FieldLine Position], [Field Position])) toExe (fss, fields) = do name <- runFieldParser zeroPos parsec cabalSpecLatest fss let (hdr0, rest) = breakMaybe isExecutableField fields diff --git a/Cabal-syntax/src/Distribution/Parsec.hs b/Cabal-syntax/src/Distribution/Parsec.hs index d0197616fd6..a3f695bc95b 100644 --- a/Cabal-syntax/src/Distribution/Parsec.hs +++ b/Cabal-syntax/src/Distribution/Parsec.hs @@ -24,11 +24,16 @@ module Distribution.Parsec -- ** Warnings , PWarnType (..) , PWarning (..) + , PWarningWithSource (..) + , PSource (..) , showPWarning + , showPWarningWithSource -- ** Errors , PError (..) + , PErrorWithSource (..) , showPError + , showPErrorWithSource -- * Position , Position (..) @@ -58,10 +63,12 @@ import Data.Char (digitToInt, intToDigit) import Data.List (transpose) import Distribution.CabalSpecVersion import Distribution.Compat.Prelude -import Distribution.Parsec.Error (PError (..), showPError) +import Distribution.Parsec.Error (PError (..), PErrorWithSource (..), showPError, showPErrorWithSource) + +import Data.Monoid (Last (..)) import Distribution.Parsec.FieldLineStream (FieldLineStream, fieldLineStreamFromBS, fieldLineStreamFromString) import Distribution.Parsec.Position (Position (..), incPos, retPos, showPos, zeroPos) -import Distribution.Parsec.Warning (PWarnType (..), PWarning (..), showPWarning) +import Distribution.Parsec.Warning import Numeric (showIntAtBase) import Prelude () @@ -255,6 +262,12 @@ instance Parsec Bool where caseWarning = "Boolean values are case sensitive, use 'True' or 'False'." +instance Parsec a => Parsec (Last a) where + parsec = parsecLast + +parsecLast :: (Parsec a, CabalParsing m) => m (Last a) +parsecLast = (Last . Just <$> parsec) <|> pure mempty + -- | @[^ ,]@ parsecToken :: CabalParsing m => m String parsecToken = parsecHaskellString <|> ((P.munch1 (\x -> not (isSpace x) && x /= ',') P. "identifier") >>= checkNotDoubleDash) diff --git a/Cabal-syntax/src/Distribution/Parsec/Error.hs b/Cabal-syntax/src/Distribution/Parsec/Error.hs index 46114c3ea98..8c1d7326b33 100644 --- a/Cabal-syntax/src/Distribution/Parsec/Error.hs +++ b/Cabal-syntax/src/Distribution/Parsec/Error.hs @@ -1,22 +1,34 @@ +{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} module Distribution.Parsec.Error ( PError (..) + , PErrorWithSource (..) , showPError + , showPErrorWithSource ) where import Distribution.Compat.Prelude import Distribution.Parsec.Position +import Distribution.Parsec.Source +import Distribution.Parsec.Warning -- TODO: Move PSource into own module import System.FilePath (normalise) import Prelude () -- | Parser error. -data PError = PError Position String +data PError = PError {perrorPosition :: Position, perrorMessage :: String} deriving (Show, Generic) +data PErrorWithSource src = PErrorWithSource {perrorSource :: !(PSource src), perror :: !PError} + deriving (Show, Generic, Functor) + instance Binary PError instance NFData PError where rnf = genericRnf showPError :: FilePath -> PError -> String showPError fpath (PError pos msg) = normalise fpath ++ ":" ++ showPos pos ++ ": " ++ msg + +showPErrorWithSource :: PErrorWithSource String -> String +showPErrorWithSource (PErrorWithSource source (PError pos msg)) = + showPError (showPSourceAsFilePath source) (PError pos msg) diff --git a/Cabal-syntax/src/Distribution/Parsec/Source.hs b/Cabal-syntax/src/Distribution/Parsec/Source.hs new file mode 100644 index 00000000000..5d662679680 --- /dev/null +++ b/Cabal-syntax/src/Distribution/Parsec/Source.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} + +module Distribution.Parsec.Source + ( PSource (..) + , CabalFileSource (..) + , InstalledPackageInfoSource (..) + , renderCabalFileSource + , renderInstalledPackageInfoSource + ) where + +import qualified Data.ByteString as BS +import Distribution.Compat.Prelude +import Prelude () + +-- | The source of a parse error +data PSource src + = PKnownSource src + | PUnknownSource + deriving (Ord, Show, Generic, Functor) + +newtype CabalFileSource + = PCabalFile (FilePath, BS.ByteString) + deriving (Ord, Show, Generic) + +data InstalledPackageInfoSource + = PInstalledPackageInfo + deriving (Eq, Ord, Show, Generic) + +renderCabalFileSource :: CabalFileSource -> String +renderCabalFileSource (PCabalFile (path, _)) = path + +renderInstalledPackageInfoSource :: InstalledPackageInfoSource -> String +renderInstalledPackageInfoSource PInstalledPackageInfo = "" + +instance Eq CabalFileSource where + PCabalFile (path, _) == PCabalFile (path', _) = path == path' + +instance Eq src => Eq (PSource src) where + PKnownSource src == PKnownSource src' = src == src' + PUnknownSource == PUnknownSource = True + _ == _ = False + +instance Binary src => Binary (PSource src) +instance NFData src => NFData (PSource src) where rnf = genericRnf diff --git a/Cabal-syntax/src/Distribution/Parsec/Warning.hs b/Cabal-syntax/src/Distribution/Parsec/Warning.hs index ce7ffc4d6e9..65b1471b054 100644 --- a/Cabal-syntax/src/Distribution/Parsec/Warning.hs +++ b/Cabal-syntax/src/Distribution/Parsec/Warning.hs @@ -1,13 +1,19 @@ +{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} module Distribution.Parsec.Warning ( PWarning (..) + , PWarningWithSource (..) + , PSource (..) + , showPSourceAsFilePath , PWarnType (..) , showPWarning + , showPWarningWithSource ) where import Distribution.Compat.Prelude import Distribution.Parsec.Position +import Distribution.Parsec.Source import System.FilePath (normalise) import Prelude () @@ -67,12 +73,25 @@ instance Binary PWarnType instance NFData PWarnType where rnf = genericRnf -- | Parser warning. -data PWarning = PWarning !PWarnType !Position String +data PWarning = PWarning {pwarningType :: !PWarnType, pwarningPosition :: !Position, pwarningMessage :: !String} deriving (Eq, Ord, Show, Generic) +data PWarningWithSource src = PWarningWithSource {pwarningSource :: !(PSource src), pwarning :: !PWarning} + deriving (Eq, Ord, Show, Generic, Functor) + instance Binary PWarning instance NFData PWarning where rnf = genericRnf showPWarning :: FilePath -> PWarning -> String showPWarning fpath (PWarning _ pos msg) = normalise fpath ++ ":" ++ showPos pos ++ ": " ++ msg + +showPWarningWithSource :: PWarningWithSource String -> String +showPWarningWithSource (PWarningWithSource source pwarn) = + showPWarning (showPSourceAsFilePath source) pwarn + +showPSourceAsFilePath :: PSource String -> String +showPSourceAsFilePath source = + case source of + PKnownSource src -> src + PUnknownSource -> "???" diff --git a/Cabal-tests/tests/CheckTests.hs b/Cabal-tests/tests/CheckTests.hs index aa2f1e9b041..dfc716f6e33 100644 --- a/Cabal-tests/tests/CheckTests.hs +++ b/Cabal-tests/tests/CheckTests.hs @@ -6,10 +6,11 @@ import Test.Tasty import Test.Tasty.Golden.Advanced (goldenTest) import Data.Algorithm.Diff (PolyDiff (..), getGroupedDiff) -import Distribution.Fields (runParseResult) +import Distribution.Fields.ParseResult import Distribution.PackageDescription.Check (checkPackage) import Distribution.PackageDescription.Parsec (parseGenericPackageDescription) import Distribution.Parsec +import Distribution.Parsec.Source import Distribution.Utils.Generic (fromUTF8BS, toUTF8BS) import System.Directory (setCurrentDirectory) import System.Environment (getArgs, withArgs) @@ -62,16 +63,16 @@ checkTests = testGroup "regressions" checkTest :: FilePath -> TestTree checkTest fp = cabalGoldenTest fp correct $ do contents <- BS.readFile input - let res = parseGenericPackageDescription contents + let res = withSource (PCabalFile (fp, contents)) $ parseGenericPackageDescription contents let (ws, x) = runParseResult res return $ toUTF8BS $ case x of Right gpd -> -- Note: parser warnings are reported by `cabal check`, but not by -- D.PD.Check functionality. - unlines (map (showPWarning fp) ws) ++ + unlines (map (showPWarningWithSource . fmap renderCabalFileSource) ws) ++ unlines (map show (checkPackage gpd)) - Left (_, errs) -> unlines $ map (("ERROR: " ++) . showPError fp) $ NE.toList errs + Left (_, errs) -> unlines $ map (("ERROR: " ++) . showPErrorWithSource . fmap renderCabalFileSource) $ NE.toList errs where input = "tests" "ParserTests" "regressions" fp correct = replaceExtension input "check" diff --git a/Cabal-tests/tests/HackageTests.hs b/Cabal-tests/tests/HackageTests.hs index dbad37c30f4..1265c6cb13e 100644 --- a/Cabal-tests/tests/HackageTests.hs +++ b/Cabal-tests/tests/HackageTests.hs @@ -24,6 +24,8 @@ import Distribution.PackageDescription.Check (PackageCheck (..), checkPack import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription) import Distribution.PackageDescription.Quirks (patchQuirks) import Distribution.Simple.Utils (fromUTF8BS, toUTF8BS) +import Distribution.Fields.ParseResult +import Distribution.Parsec.Source import Numeric (showFFloat) import System.Directory (getXdgDirectory, XdgDirectory(XdgCache, XdgConfig), getAppUserDataDirectory, doesDirectoryExist) import System.Environment (lookupEnv) @@ -152,7 +154,7 @@ readFieldTest fpath bs = case Parsec.readFields bs' of parseParsecTest :: Bool -> FilePath -> B.ByteString -> IO ParsecResult parseParsecTest keepGoing fpath bs = do let (warnings, result) = Parsec.runParseResult $ - Parsec.parseGenericPackageDescription bs + withSource (PCabalFile (fpath, bs)) $ Parsec.parseGenericPackageDescription bs let w | null warnings = 0 | otherwise = 1 @@ -163,10 +165,10 @@ parseParsecTest keepGoing fpath bs = do return (ParsecResult 1 w 0) Left (_, errors) | keepGoing -> do - traverse_ (putStrLn . Parsec.showPError fpath) errors + traverse_ (putStrLn . Parsec.showPErrorWithSource . fmap renderCabalFileSource) errors return (ParsecResult 1 w 1) | otherwise -> do - traverse_ (putStrLn . Parsec.showPError fpath) errors + traverse_ (putStrLn . Parsec.showPErrorWithSource . fmap renderCabalFileSource) errors exitFailure -- | A hook to make queries on Hackage @@ -197,7 +199,7 @@ instance NFData ParsecResult where parseCheckTest :: FilePath -> B.ByteString -> IO CheckResult parseCheckTest fpath bs = do let (warnings, parsec) = Parsec.runParseResult $ - Parsec.parseGenericPackageDescription bs + withSource (PCabalFile (fpath, bs)) $ Parsec.parseGenericPackageDescription bs case parsec of Right gpd -> do let checks = checkPackage gpd @@ -210,7 +212,7 @@ parseCheckTest fpath bs = do -- one for file, many checks return (CheckResult 1 (w warnings) 0 0 0 0 0 0 <> foldMap toCheckResult checks) Left (_, errors) -> do - traverse_ (putStrLn . Parsec.showPError fpath) errors + traverse_ (putStrLn . Parsec.showPErrorWithSource . fmap renderCabalFileSource) errors exitFailure -- checkCppFlags :: BuildInfo -> IO BuildInfo @@ -304,7 +306,7 @@ roundtripTest testFieldsTransform fpath bs = do {- FOURMOLU_DISABLE -} parse phase c = do let (_, x') = Parsec.runParseResult $ - Parsec.parseGenericPackageDescription c + withSource (PCabalFile (fpath, c)) $ Parsec.parseGenericPackageDescription c case x' of Right gpd -> pure gpd Left (_, errs) -> do diff --git a/Cabal-tests/tests/NoThunks.hs b/Cabal-tests/tests/NoThunks.hs index 6a81475dc03..a53d404dd1e 100644 --- a/Cabal-tests/tests/NoThunks.hs +++ b/Cabal-tests/tests/NoThunks.hs @@ -21,7 +21,8 @@ import Distribution.Compat.NonEmptySet (NonEmptySet) import Distribution.Compiler (CompilerFlavor, PerCompilerFlavor) import Distribution.Fields (runParseResult) import Distribution.ModuleName (ModuleName) -import Distribution.PackageDescription.Parsec (parseGenericPackageDescription) +import Distribution.PackageDescription.Parsec (parseGenericPackageDescription, withSource) +import Distribution.Parsec.Source import Distribution.SPDX (License, LicenseExceptionId, LicenseExpression, LicenseId, LicenseRef, SimpleLicenseExpression) import Distribution.System (Arch, OS) import Distribution.Utils.Path (SymbolicPathX) @@ -45,7 +46,7 @@ main = defaultMain $ testGroup "nothunks" noThunksParse :: IO () noThunksParse = do bs <- BS.readFile "Cabal/Cabal.cabal" <|> BS.readFile "../Cabal/Cabal.cabal" - let res = parseGenericPackageDescription bs + let res = withSource (PCabalFile ("Cabal.cabal", bs)) $ parseGenericPackageDescription bs gpd <- either (assertFailure . show) return $ snd $ runParseResult res diff --git a/Cabal-tests/tests/ParserTests.hs b/Cabal-tests/tests/ParserTests.hs index 3990f19fc79..8368ed19451 100644 --- a/Cabal-tests/tests/ParserTests.hs +++ b/Cabal-tests/tests/ParserTests.hs @@ -13,16 +13,18 @@ import Test.Tasty.HUnit import Control.Monad (unless, void) import Data.Algorithm.Diff (PolyDiff (..), getGroupedDiff) import Data.Maybe (isNothing) -import Distribution.Fields (runParseResult) +import Distribution.Fields (pwarning) import Distribution.PackageDescription (GenericPackageDescription) import Distribution.PackageDescription.Parsec (parseGenericPackageDescription) import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription) -import Distribution.Parsec (PWarnType (..), PWarning (..), showPError, showPWarning) +import Distribution.Parsec (PWarnType (..), PWarning (..), showPErrorWithSource, showPWarningWithSource) import Distribution.Pretty (prettyShow) +import Distribution.Fields.ParseResult import Distribution.Utils.Generic (fromUTF8BS, toUTF8BS) import System.Directory (setCurrentDirectory) import System.Environment (getArgs, withArgs) import System.FilePath (replaceExtension, ()) +import Distribution.Parsec.Source import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 @@ -79,12 +81,12 @@ warningTest :: PWarnType -> FilePath -> TestTree warningTest wt fp = testCase (show wt) $ do contents <- BS.readFile $ "tests" "ParserTests" "warnings" fp - let res = parseGenericPackageDescription contents + let res = withSource (PCabalFile (fp, contents)) $ parseGenericPackageDescription contents let (warns, x) = runParseResult res assertBool ("should parse successfully: " ++ show x) $ isRight x - case warns of + case map pwarning warns of [PWarning wt' _ _] -> assertEqual "warning type" wt wt' [] -> assertFailure "got no warnings" _ -> assertFailure $ "got multiple warnings: " ++ show warns @@ -135,7 +137,7 @@ errorTests = testGroup "errors" errorTest :: FilePath -> TestTree errorTest fp = cabalGoldenTest fp correct $ do contents <- BS.readFile input - let res = parseGenericPackageDescription contents + let res = withSource (PCabalFile (fp, contents)) $ parseGenericPackageDescription contents let (_, x) = runParseResult res return $ toUTF8BS $ case x of @@ -143,7 +145,7 @@ errorTest fp = cabalGoldenTest fp correct $ do "UNEXPECTED SUCCESS\n" ++ showGenericPackageDescription gpd Left (v, errs) -> - unlines $ ("VERSION: " ++ show v) : map (showPError fp) (NE.toList errs) + unlines $ ("VERSION: " ++ show v) : map (showPErrorWithSource . fmap renderCabalFileSource) (NE.toList errs) where input = "tests" "ParserTests" "errors" fp correct = replaceExtension input "errors" @@ -212,18 +214,18 @@ regressionTest fp = testGroup fp formatGoldenTest :: FilePath -> TestTree formatGoldenTest fp = cabalGoldenTest "format" correct $ do contents <- BS.readFile input - let res = parseGenericPackageDescription contents + let res = withSource (PCabalFile (fp, contents)) $ parseGenericPackageDescription contents let (warns, x) = runParseResult res return $ toUTF8BS $ case x of Right gpd -> - unlines (map (showPWarning fp) warns) + unlines (map (showPWarningWithSource . fmap renderCabalFileSource) warns) ++ showGenericPackageDescription gpd Left (csv, errs) -> unlines $ "ERROR" : maybe "unknown-version" prettyShow csv : - map (showPError fp) (NE.toList errs) + map (showPErrorWithSource . fmap renderCabalFileSource) (NE.toList errs) where input = "tests" "ParserTests" "regressions" fp correct = replaceExtension input "format" @@ -232,11 +234,11 @@ formatGoldenTest fp = cabalGoldenTest "format" correct $ do treeDiffGoldenTest :: FilePath -> TestTree treeDiffGoldenTest fp = ediffGolden goldenTest "expr" exprFile $ do contents <- BS.readFile input - let res = parseGenericPackageDescription contents + let res = withSource (PCabalFile (fp, contents)) $ parseGenericPackageDescription contents let (_, x) = runParseResult res case x of Right gpd -> pure (toExpr gpd) - Left (_, errs) -> fail $ unlines $ "ERROR" : map (showPError fp) (NE.toList errs) + Left (_, errs) -> fail $ unlines $ "ERROR" : map (showPErrorWithSource . fmap renderCabalFileSource) (NE.toList errs) where input = "tests" "ParserTests" "regressions" fp exprFile = replaceExtension input "expr" @@ -269,11 +271,11 @@ formatRoundTripTest fp = testCase "roundtrip" $ do where parse :: BS.ByteString -> IO GenericPackageDescription parse c = do - let (_, x') = runParseResult $ parseGenericPackageDescription c + let (_, x') = runParseResult $ withSource (PCabalFile (fp, c)) $ parseGenericPackageDescription c case x' of Right gpd -> pure gpd Left (_, errs) -> do - void $ assertFailure $ unlines (map (showPError fp) $ NE.toList errs) + void $ assertFailure $ unlines (map (showPErrorWithSource . fmap renderCabalFileSource) $ NE.toList errs) fail "failure" input = "tests" "ParserTests" "regressions" fp {- FOURMOLU_ENABLE -} diff --git a/Cabal/src/Distribution/Simple/Compiler.hs b/Cabal/src/Distribution/Simple/Compiler.hs index 6c81b50f891..543ff1e0083 100644 --- a/Cabal/src/Distribution/Simple/Compiler.hs +++ b/Cabal/src/Distribution/Simple/Compiler.hs @@ -50,6 +50,7 @@ module Distribution.Simple.Compiler , interpretPackageDBStack , coercePackageDB , coercePackageDBStack + , readPackageDb -- * Support for optimisation levels , OptimisationLevel (..) @@ -93,7 +94,9 @@ module Distribution.Simple.Compiler , showProfDetailLevel ) where +import Distribution.Compat.CharParsing import Distribution.Compat.Prelude +import Distribution.Parsec import Distribution.Pretty import Prelude () @@ -104,6 +107,7 @@ import Distribution.Version import Language.Haskell.Extension +import Data.Bool (bool) import qualified Data.Map as Map (lookup) import System.Directory (canonicalizePath) @@ -203,6 +207,15 @@ data PackageDBX fp instance Binary fp => Binary (PackageDBX fp) instance Structured fp => Structured (PackageDBX fp) +-- | Parse a PackageDB stack entry +-- +-- @since 3.7.0.0 +readPackageDb :: String -> Maybe PackageDB +readPackageDb "clear" = Nothing +readPackageDb "global" = Just GlobalPackageDB +readPackageDb "user" = Just UserPackageDB +readPackageDb other = Just (SpecificPackageDB (makeSymbolicPath other)) + -- | We typically get packages from several databases, and stack them -- together. This type lets us be explicit about that stacking. For example -- typical stacks include: @@ -294,20 +307,36 @@ data OptimisationLevel instance Binary OptimisationLevel instance Structured OptimisationLevel +instance Parsec OptimisationLevel where + parsec = parsecOptimisationLevel + +parsecOptimisationLevel :: CabalParsing m => m OptimisationLevel +parsecOptimisationLevel = boolParser <|> intParser + where + boolParser = bool NoOptimisation NormalOptimisation <$> parsec + intParser = intToOptimisationLevel <$> integral + flagToOptimisationLevel :: Maybe String -> OptimisationLevel flagToOptimisationLevel Nothing = NormalOptimisation flagToOptimisationLevel (Just s) = case reads s of - [(i, "")] - | i >= fromEnum (minBound :: OptimisationLevel) - && i <= fromEnum (maxBound :: OptimisationLevel) -> - toEnum i - | otherwise -> - error $ - "Bad optimisation level: " - ++ show i - ++ ". Valid values are 0..2" + [(i, "")] -> intToOptimisationLevel i _ -> error $ "Can't parse optimisation level " ++ s +intToOptimisationLevel :: Int -> OptimisationLevel +intToOptimisationLevel i + | i >= minLevel && i <= maxLevel = toEnum i + | otherwise = + error $ + "Bad optimisation level: " + ++ show i + ++ ". Valid values are " + ++ show minLevel + ++ ".." + ++ show maxLevel + where + minLevel = fromEnum (minBound :: OptimisationLevel) + maxLevel = fromEnum (maxBound :: OptimisationLevel) + -- ------------------------------------------------------------ -- * Debug info levels @@ -327,6 +356,12 @@ data DebugInfoLevel instance Binary DebugInfoLevel instance Structured DebugInfoLevel +instance Parsec DebugInfoLevel where + parsec = parsecDebugInfoLevel + +parsecDebugInfoLevel :: CabalParsing m => m DebugInfoLevel +parsecDebugInfoLevel = flagToDebugInfoLevel . pure <$> parsecToken + flagToDebugInfoLevel :: Maybe String -> DebugInfoLevel flagToDebugInfoLevel Nothing = NormalDebugInfo flagToDebugInfoLevel (Just s) = case reads s of @@ -574,6 +609,12 @@ data ProfDetailLevel instance Binary ProfDetailLevel instance Structured ProfDetailLevel +instance Parsec ProfDetailLevel where + parsec = parsecProfDetailLevel + +parsecProfDetailLevel :: CabalParsing m => m ProfDetailLevel +parsecProfDetailLevel = flagToProfDetailLevel <$> parsecToken + flagToProfDetailLevel :: String -> ProfDetailLevel flagToProfDetailLevel "" = ProfDetailDefault flagToProfDetailLevel s = diff --git a/Cabal/src/Distribution/Simple/InstallDirs.hs b/Cabal/src/Distribution/Simple/InstallDirs.hs index 41143ea36ee..818b9273bfd 100644 --- a/Cabal/src/Distribution/Simple/InstallDirs.hs +++ b/Cabal/src/Distribution/Simple/InstallDirs.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} ----------------------------------------------------------------------------- @@ -44,6 +45,7 @@ module Distribution.Simple.InstallDirs , compilerTemplateEnv , packageTemplateEnv , abiTemplateEnv + , installDirsGrammar , installDirsTemplateEnv ) where @@ -51,9 +53,13 @@ import Distribution.Compat.Prelude import Prelude () import Distribution.Compat.Environment (lookupEnv) +import Distribution.Compat.Lens (Lens') import Distribution.Compiler +import Distribution.FieldGrammar import Distribution.Package +import Distribution.Parsec import Distribution.Pretty +import Distribution.Simple.Flag import Distribution.Simple.InstallDirs.Internal import Distribution.System @@ -506,6 +512,12 @@ instance Read PathTemplate where , (template, "") <- reads path ] +instance Parsec PathTemplate where + parsec = parsecPathTemplate + +parsecPathTemplate :: CabalParsing m => m PathTemplate +parsecPathTemplate = toPathTemplate <$> parsecFilePath + -- --------------------------------------------------------------------------- -- Internal utilities @@ -552,3 +564,81 @@ foreign import CALLCONV unsafe "shlobj.h SHGetFolderPathW" -> Prelude.IO CInt #endif {- FOURMOLU_ENABLE -} + +-- --------------------------------------------------------------------------- +-- FieldGrammar + +installDirsGrammar :: ParsecFieldGrammar' (InstallDirs (Flag PathTemplate)) +installDirsGrammar = + InstallDirs + <$> optionalFieldDef "prefix" installDirsPrefixLens mempty + <*> optionalFieldDef "bindir" installDirsBindirLens mempty + <*> optionalFieldDef "libdir" installDirsLibdirLens mempty + <*> optionalFieldDef "libsubdir" installDirsLibsubdirLens mempty + <*> optionalFieldDef "dynlibdir" installDirsDynlibdirLens mempty + <*> pure NoFlag -- flibdir + <*> optionalFieldDef "libexecdir" installDirsLibexecdirLens mempty + <*> optionalFieldDef "libexecsubdir" installDirsLibexecsubdirLens mempty + <*> pure NoFlag -- includedir + <*> optionalFieldDef "datadir" installDirsDatadirLens mempty + <*> optionalFieldDef "datasubdir" installDirsDatasubdirLens mempty + <*> optionalFieldDef "docdir" installDirsDocdirLens mempty + <*> pure NoFlag -- mandir + <*> optionalFieldDef "htmldir" installDirsHtmldirLens mempty + <*> optionalFieldDef "haddockdir" installDirsHaddockdirLens mempty + <*> optionalFieldDef "sysconfdir" installDirsSysconfdirLens mempty + +-- --------------------------------------------------------------------------- +-- Lenses + +installDirsPrefixLens :: Lens' (InstallDirs a) a +installDirsPrefixLens f c = fmap (\x -> c{prefix = x}) (f (prefix c)) +{-# INLINEABLE installDirsPrefixLens #-} + +installDirsBindirLens :: Lens' (InstallDirs a) a +installDirsBindirLens f c = fmap (\x -> c{bindir = x}) (f (bindir c)) +{-# INLINEABLE installDirsBindirLens #-} + +installDirsLibdirLens :: Lens' (InstallDirs a) a +installDirsLibdirLens f c = fmap (\x -> c{libdir = x}) (f (libdir c)) +{-# INLINEABLE installDirsLibdirLens #-} + +installDirsLibsubdirLens :: Lens' (InstallDirs a) a +installDirsLibsubdirLens f c = fmap (\x -> c{libsubdir = x}) (f (libsubdir c)) +{-# INLINEABLE installDirsLibsubdirLens #-} + +installDirsDynlibdirLens :: Lens' (InstallDirs a) a +installDirsDynlibdirLens f c = fmap (\x -> c{dynlibdir = x}) (f (dynlibdir c)) +{-# INLINEABLE installDirsDynlibdirLens #-} + +installDirsLibexecdirLens :: Lens' (InstallDirs a) a +installDirsLibexecdirLens f c = fmap (\x -> c{libexecdir = x}) (f (libexecdir c)) +{-# INLINEABLE installDirsLibexecdirLens #-} + +installDirsLibexecsubdirLens :: Lens' (InstallDirs a) a +installDirsLibexecsubdirLens f c = fmap (\x -> c{libexecsubdir = x}) (f (libexecsubdir c)) +{-# INLINEABLE installDirsLibexecsubdirLens #-} + +installDirsDatadirLens :: Lens' (InstallDirs a) a +installDirsDatadirLens f c = fmap (\x -> c{datadir = x}) (f (datadir c)) +{-# INLINEABLE installDirsDatadirLens #-} + +installDirsDatasubdirLens :: Lens' (InstallDirs a) a +installDirsDatasubdirLens f c = fmap (\x -> c{datasubdir = x}) (f (datasubdir c)) +{-# INLINEABLE installDirsDatasubdirLens #-} + +installDirsDocdirLens :: Lens' (InstallDirs a) a +installDirsDocdirLens f c = fmap (\x -> c{docdir = x}) (f (docdir c)) +{-# INLINEABLE installDirsDocdirLens #-} + +installDirsHtmldirLens :: Lens' (InstallDirs a) a +installDirsHtmldirLens f c = fmap (\x -> c{htmldir = x}) (f (htmldir c)) +{-# INLINEABLE installDirsHtmldirLens #-} + +installDirsHaddockdirLens :: Lens' (InstallDirs a) a +installDirsHaddockdirLens f c = fmap (\x -> c{haddockdir = x}) (f (haddockdir c)) +{-# INLINEABLE installDirsHaddockdirLens #-} + +installDirsSysconfdirLens :: Lens' (InstallDirs a) a +installDirsSysconfdirLens f c = fmap (\x -> c{sysconfdir = x}) (f (sysconfdir c)) +{-# INLINEABLE installDirsSysconfdirLens #-} diff --git a/Cabal/src/Distribution/Simple/PackageDescription.hs b/Cabal/src/Distribution/Simple/PackageDescription.hs index d0ee9d9f86b..e0f1806d6a1 100644 --- a/Cabal/src/Distribution/Simple/PackageDescription.hs +++ b/Cabal/src/Distribution/Simple/PackageDescription.hs @@ -18,6 +18,8 @@ module Distribution.Simple.PackageDescription -- * Utility Parsing function , parseString + , readAndParseFile + , flattenDups ) where import Distribution.Compat.Prelude @@ -31,11 +33,13 @@ import Distribution.PackageDescription.Parsec ( parseGenericPackageDescription , parseHookedBuildInfo ) -import Distribution.Parsec.Error (showPError) +import Distribution.Parsec.Error (showPErrorWithSource) +import Distribution.Parsec.Source import Distribution.Parsec.Warning ( PWarnType (PWTExperimental) , PWarning (..) - , showPWarning + , PWarningWithSource (..) + , showPWarningWithSource ) import Distribution.Simple.Errors import Distribution.Simple.Utils (dieWithException, equating, warn) @@ -70,7 +74,7 @@ readHookedBuildInfo = -- -- Argument order is chosen to encourage partial application. readAndParseFile - :: (BS.ByteString -> ParseResult a) + :: (BS.ByteString -> ParseResult CabalFileSource a) -- ^ File contents to final value parser -> Verbosity -- ^ Verbosity level @@ -90,7 +94,7 @@ readAndParseFile parser verbosity mbWorkDir fpath = do parseString parser verbosity upath bs parseString - :: (BS.ByteString -> ParseResult a) + :: (BS.ByteString -> ParseResult CabalFileSource a) -- ^ File contents to final value parser -> Verbosity -- ^ Verbosity level @@ -99,38 +103,41 @@ parseString -> BS.ByteString -> IO a parseString parser verbosity name bs = do - let (warnings, result) = runParseResult (parser bs) - traverse_ (warn verbosity . showPWarning name) (flattenDups verbosity warnings) + let (warnings, result) = runParseResult $ withSource (PCabalFile (name, bs)) (parser bs) + traverse_ (warn verbosity . showPWarningWithSource . fmap renderCabalFileSource) (flattenDups verbosity warnings) case result of Right x -> return x Left (_, errors) -> do - traverse_ (warn verbosity . showPError name) errors + traverse_ (warn verbosity . showPErrorWithSource . fmap renderCabalFileSource) errors dieWithException verbosity $ FailedParsing name -- | Collapse duplicate experimental feature warnings into single warning, with -- a count of further sites -flattenDups :: Verbosity -> [PWarning] -> [PWarning] +flattenDups :: Verbosity -> [PWarningWithSource src] -> [PWarningWithSource src] flattenDups verbosity ws | verbosity <= normal = rest ++ experimentals | otherwise = ws -- show all instances where - (exps, rest) = partition (\(PWarning w _ _) -> w == PWTExperimental) ws + (exps, rest) = partition (\(PWarningWithSource _ (PWarning w _ _)) -> w == PWTExperimental) ws experimentals = concatMap flatCount - . groupBy (equating warningStr) - . sortBy (comparing warningStr) + . groupBy (equating (warningStr . pwarning)) + . sortBy (comparing (warningStr . pwarning)) $ exps warningStr (PWarning _ _ w) = w -- flatten if we have 3 or more examples - flatCount :: [PWarning] -> [PWarning] + flatCount :: [PWarningWithSource src] -> [PWarningWithSource src] flatCount w@[] = w flatCount w@[_] = w flatCount w@[_, _] = w - flatCount (PWarning t pos w : xs) = - [ PWarning - t - pos - (w <> printf " (and %d more occurrences)" (length xs)) + flatCount (PWarningWithSource source (PWarning t pos w) : xs) = + [ PWarningWithSource + source + ( PWarning + t + pos + (w <> printf " (and %d more occurrences)" (length xs)) + ) ] diff --git a/Cabal/src/Distribution/Simple/Setup/Config.hs b/Cabal/src/Distribution/Simple/Setup/Config.hs index 729b466b4da..67945bd4d43 100644 --- a/Cabal/src/Distribution/Simple/Setup/Config.hs +++ b/Cabal/src/Distribution/Simple/Setup/Config.hs @@ -890,15 +890,6 @@ configureOptions showOrParseArgs = readPackageDbList :: String -> [Maybe PackageDB] readPackageDbList str = [readPackageDb str] --- | Parse a PackageDB stack entry --- --- @since 3.7.0.0 -readPackageDb :: String -> Maybe PackageDB -readPackageDb "clear" = Nothing -readPackageDb "global" = Just GlobalPackageDB -readPackageDb "user" = Just UserPackageDB -readPackageDb other = Just (SpecificPackageDB (makeSymbolicPath other)) - showPackageDbList :: [Maybe PackageDB] -> [String] showPackageDbList = map showPackageDb diff --git a/Cabal/src/Distribution/Types/DumpBuildInfo.hs b/Cabal/src/Distribution/Types/DumpBuildInfo.hs index 99020febc35..0e9cb8ce8d5 100644 --- a/Cabal/src/Distribution/Types/DumpBuildInfo.hs +++ b/Cabal/src/Distribution/Types/DumpBuildInfo.hs @@ -5,6 +5,7 @@ module Distribution.Types.DumpBuildInfo ) where import Distribution.Compat.Prelude +import Distribution.Parsec data DumpBuildInfo = NoDumpBuildInfo @@ -13,3 +14,12 @@ data DumpBuildInfo instance Binary DumpBuildInfo instance Structured DumpBuildInfo + +instance Parsec DumpBuildInfo where + parsec = parsecDumpBuildInfo + +parsecDumpBuildInfo :: CabalParsing m => m DumpBuildInfo +parsecDumpBuildInfo = boolToDumpBuildInfo <$> parsec + +boolToDumpBuildInfo :: Bool -> DumpBuildInfo +boolToDumpBuildInfo bool = if bool then DumpBuildInfo else NoDumpBuildInfo diff --git a/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs b/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs index be6ded8cff2..257ba808aaa 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs @@ -9,9 +9,11 @@ module Distribution.Solver.Types.ProjectConfigPath , nullProjectConfigPath , consProjectConfigPath , unconsProjectConfigPath + , currentProjectConfigPath -- * Messages , docProjectConfigPath + , docProjectImportedBy , docProjectConfigFiles , cyclicalImportMsg , untrimmedUriImportMsg @@ -131,6 +133,13 @@ docProjectConfigPath (ProjectConfigPath (p :| [])) = quoteUntrimmed p docProjectConfigPath (ProjectConfigPath (p :| ps)) = vcat $ quoteUntrimmed p : [ text " " <+> text "imported by:" <+> quoteUntrimmed l | l <- ps ] +-- | Render the paths which imports this config. +docProjectImportedBy :: ProjectConfigPath -> Doc +docProjectImportedBy (ProjectConfigPath (_ :| [])) = text "" +docProjectImportedBy (ProjectConfigPath (_ :| ps)) = vcat $ + [ text " " <+> text "imported by:" <+> quoteUntrimmed l | l <- ps ] + + -- | If the path has leading or trailing spaces then show it quoted. quoteUntrimmed :: FilePath -> Doc quoteUntrimmed s = if trim s /= s then quotes (text s) else text s @@ -237,6 +246,9 @@ consProjectConfigPath p ps = ProjectConfigPath (p <| coerce ps) unconsProjectConfigPath :: ProjectConfigPath -> (FilePath, Maybe ProjectConfigPath) unconsProjectConfigPath ps = fmap ProjectConfigPath <$> NE.uncons (coerce ps) +currentProjectConfigPath :: ProjectConfigPath -> FilePath +currentProjectConfigPath (ProjectConfigPath (p :| _)) = p + -- | Make paths relative to the directory of the root of the project, not -- relative to the file they were imported from. makeRelativeConfigPath :: FilePath -> ProjectConfigPath -> ProjectConfigPath diff --git a/cabal-install-solver/src/Distribution/Solver/Types/Settings.hs b/cabal-install-solver/src/Distribution/Solver/Types/Settings.hs index 4b7fe65b769..306c0c12185 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/Settings.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/Settings.hs @@ -105,3 +105,26 @@ instance Parsec OnlyConstrained where , P.string "none" >> return OnlyConstrainedNone ] +instance Parsec ReorderGoals where + parsec = ReorderGoals <$> parsec + +instance Parsec CountConflicts where + parsec = CountConflicts <$> parsec + +instance Parsec FineGrainedConflicts where + parsec = FineGrainedConflicts <$> parsec + +instance Parsec MinimizeConflictSet where + parsec = MinimizeConflictSet <$> parsec + +instance Parsec StrongFlags where + parsec = StrongFlags <$> parsec + +instance Parsec AllowBootLibInstalls where + parsec = AllowBootLibInstalls <$> parsec + +instance Parsec PreferOldest where + parsec = PreferOldest <$> parsec + +instance Parsec IndependentGoals where + parsec = IndependentGoals <$> parsec diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 8ace48c0a55..a8c97dab7fc 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -44,6 +44,11 @@ flag git-rev default: False manual: True +flag legacy-comparison + description: Enable comparison between the new and legacy cabal.project parser + default: False + manual: True + common warnings ghc-options: -Wall @@ -131,6 +136,7 @@ library Distribution.Client.Dependency.Types Distribution.Client.DistDirLayout Distribution.Client.Errors + Distribution.Client.Errors.Parser Distribution.Client.Fetch Distribution.Client.FetchUtils Distribution.Client.FileMonitor @@ -177,7 +183,10 @@ library Distribution.Client.ProjectBuilding.PackageFileMonitor Distribution.Client.ProjectBuilding.Types Distribution.Client.ProjectConfig + Distribution.Client.ProjectConfig.FieldGrammar Distribution.Client.ProjectConfig.Legacy + Distribution.Client.ProjectConfig.Lens + Distribution.Client.ProjectConfig.Parsec Distribution.Client.ProjectConfig.Types Distribution.Client.ProjectFlags Distribution.Client.ProjectOrchestration @@ -225,6 +234,7 @@ library Distribution.Client.Upload Distribution.Client.Utils Distribution.Client.Utils.Json + Distribution.Client.Utils.Newtypes Distribution.Client.Utils.Parsec Distribution.Client.VCS Distribution.Client.Version @@ -290,6 +300,9 @@ library build-depends: githash ^>= 0.1.7.0 cpp-options: -DGIT_REV + if flag(legacy-comparison) + cpp-options: -DLEGACY_COMPARISON + executable cabal import: warnings, base-dep main-is: Main.hs @@ -378,6 +391,26 @@ test-suite unit-tests , tree-diff , QuickCheck >= 2.14.3 && <2.17 +-- Tests for the project file parser +test-suite parser-tests + import: warnings, base-dep, cabal-dep, cabal-syntax-dep, cabal-install-solver-dep + default-language: Haskell2010 + ghc-options: -rtsopts -threaded + + type: exitcode-stdio-1.0 + main-is: Tests.hs + hs-source-dirs: parser-tests + build-depends: + , cabal-install + , containers + , directory + , filepath + , network-uri >= 2.6.2.0 && <2.7 + , tasty >= 1.2.3 && <1.6 + , tasty-hunit >= 0.10 + other-modules: + Tests.ParserTests + -- Tests to run with a limited stack and heap size -- The test suite name must be keep short cause a longer one -- could make the build generating paths which exceeds the windows diff --git a/cabal-install/parser-tests/Tests.hs b/cabal-install/parser-tests/Tests.hs new file mode 100644 index 00000000000..f5655ad5389 --- /dev/null +++ b/cabal-install/parser-tests/Tests.hs @@ -0,0 +1,7 @@ +module Main where + +import Test.Tasty (defaultMain) +import Tests.ParserTests (parserTests) + +main :: IO () +main = defaultMain parserTests diff --git a/cabal-install/parser-tests/Tests/ParserTests.hs b/cabal-install/parser-tests/Tests/ParserTests.hs new file mode 100644 index 00000000000..d9ab2f5247f --- /dev/null +++ b/cabal-install/parser-tests/Tests/ParserTests.hs @@ -0,0 +1,624 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +-- | Tests for the project file parser +module Tests.ParserTests (parserTests) where + +import Control.Monad.IO.Class + ( MonadIO (liftIO) + ) +import Data.Either (fromRight) +import qualified Data.Map as Map +import Data.Maybe (fromJust) +import qualified Data.Set as Set +import Distribution.Client.BuildReports.Types (ReportLevel (..)) +import Distribution.Client.CmdInstall.ClientInstallFlags (ClientInstallFlags (..)) +import Distribution.Client.Dependency.Types (PreSolver (..)) +import Distribution.Client.DistDirLayout +import Distribution.Client.HttpUtils +import Distribution.Client.IndexUtils.ActiveRepos (ActiveRepoEntry (..), ActiveRepos (..), CombineStrategy (..)) +import Distribution.Client.IndexUtils.IndexState (RepoIndexState (..), headTotalIndexState, insertIndexState) +import Distribution.Client.ProjectConfig +import Distribution.Client.RebuildMonad (runRebuild) +import Distribution.Client.Targets (readUserConstraint) +import Distribution.Client.Types.AllowNewer (AllowNewer (..), AllowOlder (..), RelaxDepMod (..), RelaxDepScope (..), RelaxDepSubject (..), RelaxDeps (..), RelaxedDep (..)) +import Distribution.Client.Types.InstallMethod (InstallMethod (..)) +import Distribution.Client.Types.OverwritePolicy (OverwritePolicy (..)) +import Distribution.Client.Types.Repo (LocalRepo (..), RemoteRepo (..), asPosixPath) +import Distribution.Client.Types.RepoName (RepoName (..)) +import Distribution.Client.Types.SourceRepo +import Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy (WriteGhcEnvironmentFilesPolicy (..)) +import Distribution.Compat.Prelude +import Distribution.Compiler (CompilerFlavor (..)) +import Distribution.Parsec (simpleParsec) +import Distribution.Simple.Compiler (DebugInfoLevel (..), OptimisationLevel (..), PackageDBX (..), ProfDetailLevel (..)) +import Distribution.Simple.Flag +import Distribution.Simple.InstallDirs (InstallDirs (..), toPathTemplate) +import Distribution.Simple.Setup (DumpBuildInfo (..), HaddockTarget (..), TestShowDetails (..)) +import Distribution.Solver.Types.ConstraintSource (ConstraintSource (..)) +import Distribution.Solver.Types.ProjectConfigPath (ProjectConfigPath (..)) +import Distribution.Solver.Types.Settings + ( AllowBootLibInstalls (..) + , CountConflicts (..) + , FineGrainedConflicts (..) + , IndependentGoals (..) + , MinimizeConflictSet (..) + , OnlyConstrained (..) + , PreferOldest (..) + , ReorderGoals (..) + , StrongFlags (..) + ) +import Distribution.System (OS (..), buildOS) +import Distribution.Types.CondTree (CondTree (..)) +import Distribution.Types.Flag (mkFlagAssignment) +import Distribution.Types.PackageId (PackageIdentifier (..)) +import Distribution.Types.PackageName +import Distribution.Types.PackageVersionConstraint (PackageVersionConstraint (..)) +import Distribution.Types.SourceRepo (KnownRepoType (..), RepoType (..)) +import Distribution.Types.Version (mkVersion) +import Distribution.Types.VersionRange.Internal (VersionRange (..)) +import Distribution.Utils.NubList +import Distribution.Verbosity +import Network.URI (parseURI) +import System.Directory (canonicalizePath, doesFileExist) +import System.FilePath (()) +import Prelude () + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (Assertion, assertBool, assertEqual, testCase) + +parserTests :: TestTree +parserTests = + testGroup + "project files parsec tests" + [ testCase "read packages" testPackages + , testCase "read optional-packages" testOptionalPackages + , testCase "read extra-packages" testExtraPackages + , testCase "read source-repository-package" testSourceRepoList + , testCase "read project-config-build-only" testProjectConfigBuildOnly + , testCase "read project-config-shared" testProjectConfigShared + , testCase "read install-dirs" testInstallDirs + , testCase "read remote-repos" testRemoteRepos + , testCase "read local-no-index-repos" testLocalNoIndexRepos + , testCase "set explicit provenance" testProjectConfigProvenance + , testCase "read project-config-local-packages" testProjectConfigLocalPackages + , testCase "read project-config-all-packages" testProjectConfigAllPackages + , testCase "read project-config-specific-packages" testProjectConfigSpecificPackages + , testCase "test projectConfigAllPackages concatenation" testAllPackagesConcat + , testCase "test projectConfigSpecificPackages concatenation" testSpecificPackagesConcat + , testCase "test program-locations concatenation" testProgramLocationsConcat + , testCase "test program-options concatenation" testProgramOptionsConcat + , testCase "test allow-newer and allow-older concatenation" testRelaxDepsConcat + , testCase "test library-coverage overwrites coverage" testLibraryCoverage + , testCase "test haddock-all flag" testHaddockAll + , testCase "test override haddock-all: True" testHaddockAllOverwriteTrue + , testCase "test override haddock-all: False" testHaddockAllOverwriteFalse + ] + +testPackages :: Assertion +testPackages = do + let expected = [".", "packages/packages.cabal"] + (config, legacy) <- readConfigDefault "packages" + assertConfigEquals expected config legacy (projectPackages . condTreeData) + +testOptionalPackages :: Assertion +testOptionalPackages = do + let expected = [".", "packages/packages.cabal"] + (config, legacy) <- readConfigDefault "optional-packages" + assertConfigEquals expected config legacy (projectPackagesOptional . condTreeData) + +testSourceRepoList :: Assertion +testSourceRepoList = do + (config, legacy) <- readConfigDefault "source-repository-packages" + assertConfigEquals expected config legacy (projectPackagesRepo . condTreeData) + where + expected = + [ SourceRepositoryPackage + { srpType = KnownRepoType Git + , srpLocation = "https://example.com/Project.git" + , srpTag = Just "1234" + , srpBranch = Nothing + , srpSubdir = [] + , srpCommand = [] + } + , SourceRepositoryPackage + { srpType = KnownRepoType Git + , srpLocation = "https://example.com/example-dir/" + , srpTag = Just "12345" + , srpBranch = Nothing + , srpSubdir = ["subproject"] + , srpCommand = [] + } + ] + +testExtraPackages :: Assertion +testExtraPackages = do + (config, legacy) <- readConfigDefault "extra-packages" + assertConfigEquals expected config legacy (projectPackagesNamed . condTreeData) + where + expected = + [ PackageVersionConstraint (mkPackageName "a") (OrLaterVersion (mkVersion [0])) + , PackageVersionConstraint (mkPackageName "b") (IntersectVersionRanges (OrLaterVersion (mkVersion [0, 7, 3])) (EarlierVersion (mkVersion [0, 9]))) + ] + +testProjectConfigBuildOnly :: Assertion +testProjectConfigBuildOnly = do + (config, legacy) <- readConfigDefault "project-config-build-only" + assertConfigEquals expected config legacy (projectConfigBuildOnly . condTreeData) + where + expected = ProjectConfigBuildOnly{..} + projectConfigVerbosity = toFlag (toEnum 2) + projectConfigDryRun = mempty -- cli only + projectConfigOnlyDeps = mempty -- cli only + projectConfigOnlyDownload = mempty -- cli only + projectConfigSummaryFile = toNubList [toPathTemplate "summaryFile", toPathTemplate "summaryFile2"] + projectConfigLogFile = toFlag $ toPathTemplate "myLog.log" + projectConfigBuildReports = toFlag DetailedReports + projectConfigReportPlanningFailure = toFlag True + projectConfigSymlinkBinDir = toFlag "some-bindir" + projectConfigNumJobs = toFlag $ Just 4 + projectConfigUseSemaphore = toFlag True + projectConfigKeepGoing = toFlag True + projectConfigOfflineMode = toFlag True + projectConfigKeepTempFiles = toFlag True + projectConfigHttpTransport = toFlag "wget" + projectConfigIgnoreExpiry = toFlag True + projectConfigCacheDir = toFlag "some-cache-dir" + projectConfigLogsDir = toFlag "logs-directory" + projectConfigClientInstallFlags = + ClientInstallFlags + { cinstInstallLibs = Flag True + , cinstEnvironmentPath = Flag "path/to/env" + , cinstOverwritePolicy = Flag AlwaysOverwrite + , cinstInstallMethod = Flag InstallMethodSymlink + , cinstInstalldir = Flag "path/to/installdir" + } + +testProjectConfigShared :: Assertion +testProjectConfigShared = do + (config, legacy) <- readConfigDefault "project-config-shared" + assertConfigEquals expected config legacy (projectConfigShared . condTreeData) + where + expected = ProjectConfigShared{..} + projectConfigDistDir = toFlag "something" + projectConfigConfigFile = mempty -- cli only + projectConfigProjectFileParser = mempty -- cli only + projectConfigProjectDir = toFlag "my-project-dir" + projectConfigProjectFile = toFlag "my-project" + projectConfigIgnoreProject = toFlag False + projectConfigHcFlavor = toFlag GHCJS + projectConfigHcPath = toFlag "/some/path/to/compiler" + projectConfigHcPkg = toFlag "/some/path/to/ghc-pkg" + projectConfigHaddockIndex = toFlag $ toPathTemplate "/path/to/haddock-index" + projectConfigInstallDirs = mempty -- tested below in testInstallDirs + projectConfigPackageDBs = [Nothing, Just (SpecificPackageDB "foo"), Nothing, Just (SpecificPackageDB "bar"), Just (SpecificPackageDB "baz")] + projectConfigRemoteRepos = mempty -- tested below in testRemoteRepos + projectConfigLocalNoIndexRepos = mempty -- tested below in testLocalNoIndexRepos + projectConfigActiveRepos = Flag (ActiveRepos [ActiveRepo (RepoName "hackage.haskell.org") CombineStrategyMerge, ActiveRepo (RepoName "my-repository") CombineStrategyOverride]) + projectConfigIndexState = + let + hackageState = IndexStateTime $ fromJust $ simpleParsec "2020-05-06T22:33:27Z" + indexState' = insertIndexState (RepoName "hackage.haskell.org") hackageState headTotalIndexState + headHackageState = IndexStateTime $ fromJust $ simpleParsec "2020-04-29T04:11:05Z" + indexState'' = insertIndexState (RepoName "head.hackage") headHackageState indexState' + in + toFlag indexState'' + projectConfigStoreDir = toFlag "a/store/dir/path" -- cli only + projectConfigConstraints = + let + bar = fromRight (error "error parsing bar") $ readUserConstraint "bar == 2.1" + barFlags = fromRight (error "error parsing bar flags") $ readUserConstraint "bar +foo -baz" + source = ConstraintSourceProjectConfig $ ProjectConfigPath $ "cabal.project" :| [] + in + [(bar, source), (barFlags, source)] + projectConfigPreferences = [PackageVersionConstraint (mkPackageName "foo") (ThisVersion (mkVersion [0, 9])), PackageVersionConstraint (mkPackageName "baz") (LaterVersion (mkVersion [2, 0]))] + projectConfigCabalVersion = Flag (mkVersion [1, 24, 0, 1]) + projectConfigSolver = Flag AlwaysModular + projectConfigAllowOlder = Just (AllowOlder $ RelaxDepsSome [RelaxedDep RelaxDepScopeAll RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "dep")), RelaxedDep (RelaxDepScopePackageId (PackageIdentifier (mkPackageName "pkga") (mkVersion [1, 1, 2]))) RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "dep-pkg"))]) + projectConfigAllowNewer = Just (AllowNewer $ RelaxDepsSome [RelaxedDep (RelaxDepScopePackageId (PackageIdentifier (mkPackageName "pkgb") (mkVersion [1, 2, 3]))) RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "dep-pkgb")), RelaxedDep RelaxDepScopeAll RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "importantlib"))]) + projectConfigWriteGhcEnvironmentFilesPolicy = Flag AlwaysWriteGhcEnvironmentFiles + projectConfigMaxBackjumps = toFlag 42 + projectConfigReorderGoals = Flag (ReorderGoals True) + projectConfigCountConflicts = Flag (CountConflicts False) + projectConfigFineGrainedConflicts = Flag (FineGrainedConflicts False) + projectConfigMinimizeConflictSet = Flag (MinimizeConflictSet True) + projectConfigStrongFlags = Flag (StrongFlags True) + projectConfigAllowBootLibInstalls = Flag (AllowBootLibInstalls True) + projectConfigOnlyConstrained = Flag OnlyConstrainedAll + projectConfigPerComponent = Flag True + projectConfigIndependentGoals = Flag (IndependentGoals True) + projectConfigPreferOldest = Flag (PreferOldest True) + projectConfigProgPathExtra = toNubList ["/foo/bar", "/baz/quux"] + projectConfigMultiRepl = toFlag True + +testInstallDirs :: Assertion +testInstallDirs = do + (config, legacy) <- readConfigDefault "install-dirs" + assertConfigEquals expected config legacy (projectConfigInstallDirs . projectConfigShared . condTreeData) + where + expected = + InstallDirs + { prefix = Flag $ toPathTemplate "my/prefix-path" + , bindir = Flag $ toPathTemplate "bin/dir/" + , libdir = Flag $ toPathTemplate "lib/dir/path" + , libsubdir = Flag $ toPathTemplate "/lib/sub/dir" + , dynlibdir = Flag $ toPathTemplate "dyn/lib/dir/path" + , flibdir = mempty + , libexecdir = Flag $ toPathTemplate "lib/exec/dir/" + , libexecsubdir = Flag $ toPathTemplate "libexec/subdir" + , includedir = mempty + , datadir = Flag $ toPathTemplate "path/to/datadir/" + , datasubdir = Flag $ toPathTemplate "a/datadir/subdir" + , docdir = Flag $ toPathTemplate "path/to/docs" + , mandir = mempty + , htmldir = Flag $ toPathTemplate "dir/html/" + , haddockdir = Flag $ toPathTemplate "haddock/dir" + , sysconfdir = Flag $ toPathTemplate "sys/conf/dir" + } + +testRemoteRepos :: Assertion +testRemoteRepos = do + (config, legacy) <- readConfigDefault "remote-repos" + let actualRemoteRepos = (fromNubList . projectConfigRemoteRepos . projectConfigShared . condTreeData) config + assertBool "Expected RemoteRepos do not match parsed values" $ compareLists expected actualRemoteRepos compareRemoteRepos + assertConfigEquals mempty config legacy (projectConfigLocalNoIndexRepos . projectConfigShared . condTreeData) + where + expected = [packagesRepository, morePackagesRepository, secureLocalRepository] + packagesRepository = + RemoteRepo + { remoteRepoName = RepoName "packages.example.org" + , remoteRepoURI = fromJust $ parseURI "http://packages.example.org/" + , remoteRepoSecure = pure True + , remoteRepoRootKeys = ["21", "42"] + , remoteRepoKeyThreshold = 2 + , remoteRepoShouldTryHttps = False + } + morePackagesRepository = + RemoteRepo + { remoteRepoName = RepoName "more-packages.example.org" + , remoteRepoURI = fromJust $ parseURI "https://more-packages.example.org/" + , remoteRepoSecure = pure True + , remoteRepoRootKeys = ["foo", "bar"] + , remoteRepoKeyThreshold = 1 + , remoteRepoShouldTryHttps = False + } + secureLocalRepository = + RemoteRepo + { remoteRepoName = RepoName "my-secure-local-repository" + , remoteRepoURI = fromJust $ parseURI "file:/path/to/secure/repo" + , remoteRepoSecure = pure True + , remoteRepoRootKeys = ["123"] + , remoteRepoKeyThreshold = 1 + , remoteRepoShouldTryHttps = False + } + +testLocalNoIndexRepos :: Assertion +testLocalNoIndexRepos = do + (config, legacy) <- readConfigDefault "local-no-index-repos" + let actualLocalRepos = (fromNubList . projectConfigLocalNoIndexRepos . projectConfigShared . condTreeData) config + assertBool "Expected LocalNoIndexRepos do not match parsed values" $ compareLists expected actualLocalRepos compareLocalRepos + assertConfigEquals mempty config legacy (projectConfigRemoteRepos . projectConfigShared . condTreeData) + where + expected = [myRepository, mySecureRepository] + myRepository = + LocalRepo + { localRepoName = RepoName "my-repository" + , localRepoPath = normalisePath "/absolute/path/to/directory" + , localRepoSharedCache = False + } + mySecureRepository = + LocalRepo + { localRepoName = RepoName "my-other-repository" + , localRepoPath = normalisePath "/another/path/to/repository" + , localRepoSharedCache = False + } + normalisePath path = case buildOS of + Windows -> asPosixPath path + _ -> path + +testProjectConfigProvenance :: Assertion +testProjectConfigProvenance = do + let expected = Set.singleton (Explicit (ProjectConfigPath $ "cabal.project" :| [])) + (config, legacy) <- readConfigDefault "empty" + assertConfigEquals expected config legacy (projectConfigProvenance . condTreeData) + +testProjectConfigLocalPackages :: Assertion +testProjectConfigLocalPackages = do + (config, legacy) <- readConfigDefault "project-config-local-packages" + assertConfigEquals expected config legacy (projectConfigLocalPackages . condTreeData) + where + expected = PackageConfig{..} + packageConfigProgramPaths = MapLast $ Map.fromList [("ghc", "/tmp/bin/ghc"), ("gcc", "/tmp/bin/gcc")] + packageConfigProgramArgs = MapMappend $ Map.fromList [("ghc", ["-fno-state-hack", "-foo"]), ("gcc", ["-baz", "-quux"])] + packageConfigProgramPathExtra = toNubList ["/tmp/bin/extra", "/usr/local/bin"] + packageConfigFlagAssignment = mkFlagAssignment [("foo", True), ("bar", False)] + packageConfigVanillaLib = Flag False + packageConfigSharedLib = Flag True + packageConfigStaticLib = Flag True + packageConfigDynExe = Flag True + packageConfigFullyStaticExe = Flag True + packageConfigProf = Flag True + packageConfigProfLib = Flag True + packageConfigProfShared = Flag False + packageConfigProfExe = Flag True + packageConfigProfDetail = Flag ProfDetailAllFunctions + packageConfigProfLibDetail = Flag ProfDetailExportedFunctions + packageConfigConfigureArgs = ["-some-arg", "/some/path"] + packageConfigOptimization = Flag MaximumOptimisation + packageConfigProgPrefix = Flag $ toPathTemplate "another/path" + packageConfigProgSuffix = Flag $ toPathTemplate "and/another/path" + packageConfigExtraLibDirs = ["so", "many", "lib/dirs"] + packageConfigExtraLibDirsStatic = ["a/few", "static/lib/dirs"] + packageConfigExtraFrameworkDirs = ["osx/framework", "dirs"] + packageConfigExtraIncludeDirs = ["incredible/amount", "of", "include", "directories"] + packageConfigGHCiLib = Flag False + packageConfigSplitSections = Flag True + packageConfigSplitObjs = Flag True + packageConfigStripExes = Flag False + packageConfigStripLibs = Flag False + packageConfigTests = Flag True + packageConfigBenchmarks = Flag True + packageConfigCoverage = Flag True + packageConfigRelocatable = Flag True + packageConfigDebugInfo = Flag MaximalDebugInfo + packageConfigDumpBuildInfo = Flag DumpBuildInfo + packageConfigRunTests = Flag True + packageConfigDocumentation = Flag True + -- Haddock options + packageConfigHaddockHoogle = Flag True + packageConfigHaddockHtml = Flag False + packageConfigHaddockHtmlLocation = Flag "http://hackage.haskell.org/packages/archive/$pkg/latest/doc/html" + packageConfigHaddockForeignLibs = Flag True + packageConfigHaddockExecutables = Flag True + packageConfigHaddockTestSuites = Flag True + packageConfigHaddockBenchmarks = Flag True + packageConfigHaddockInternal = Flag True + packageConfigHaddockCss = Flag "some/path/to/file.css" + packageConfigHaddockLinkedSource = Flag True + packageConfigHaddockQuickJump = Flag True + packageConfigHaddockHscolourCss = Flag "another/path/to/hscolour.css" + packageConfigHaddockContents = Flag $ toPathTemplate "https://example.com/$pkg/contents" + packageConfigHaddockIndex = Flag $ toPathTemplate "separately-generated/HTML/index" + packageConfigHaddockBaseUrl = Flag "https://example.com/haddock-base-url" + packageConfigHaddockResourcesDir = Flag "/haddock/static" + packageConfigHaddockOutputDir = Flag "/haddock/output" + packageConfigHaddockUseUnicode = Flag False + packageConfigHaddockForHackage = Flag ForHackage + packageConfigTestHumanLog = Flag $ toPathTemplate "human-log.log" + packageConfigTestMachineLog = Flag $ toPathTemplate "machine.log" + packageConfigTestShowDetails = Flag Streaming + packageConfigTestKeepTix = Flag True + packageConfigTestWrapper = Flag "/test-wrapper-path/" + packageConfigTestFailWhenNoTestSuites = Flag True + packageConfigTestTestOptions = [toPathTemplate "--some-option", toPathTemplate "42"] + packageConfigBenchmarkOptions = [toPathTemplate "--some-benchmark-option", toPathTemplate "--another-option"] + +testProjectConfigAllPackages :: Assertion +testProjectConfigAllPackages = do + (config, legacy) <- readConfigDefault "project-config-all-packages" + assertConfigEquals expected config legacy (projectConfigAllPackages . condTreeData) + where + expected :: PackageConfig + expected = + mempty + { packageConfigProfDetail = Flag ProfDetailAllFunctions + , packageConfigProfLibDetail = Flag ProfDetailExportedFunctions + } + +testProjectConfigSpecificPackages :: Assertion +testProjectConfigSpecificPackages = do + (config, legacy) <- readConfigDefault "project-config-specific-packages" + assertConfigEquals expected config legacy (projectConfigSpecificPackage . condTreeData) + where + expected = MapMappend $ Map.fromList [("foo", expectedFoo), ("bar", expectedBar), ("baz", expectedBaz)] + expectedFoo :: PackageConfig + expectedFoo = + mempty + { packageConfigProfDetail = Flag ProfDetailAllFunctions + , packageConfigProfLibDetail = Flag ProfDetailExportedFunctions + , packageConfigVanillaLib = Flag True + } + expectedBar :: PackageConfig + expectedBar = + mempty + { packageConfigProfDetail = Flag ProfDetailTopLate + , packageConfigProfLibDetail = Flag ProfDetailNone + , packageConfigProgPrefix = Flag $ toPathTemplate "prefix/path" + } + expectedBaz :: PackageConfig + expectedBaz = + mempty + { packageConfigSharedLib = Flag True + } + +testAllPackagesConcat :: Assertion +testAllPackagesConcat = do + (config, legacy) <- readConfigDefault "all-packages-concat" + assertConfigEquals expected config legacy (projectConfigAllPackages . condTreeData) + where + expected :: PackageConfig + expected = + mempty + { packageConfigSharedLib = Flag True + , packageConfigStaticLib = Flag True + , packageConfigProgramArgs = + MapMappend $ + Map.fromList + [ ("ghc", ["-fwarn-tabs", "-optc-fno-builtin-malloc", "-Wall", "-optc-fno-builtin-realloc", "-fwrite-ide-info"]) + ] + } + +testSpecificPackagesConcat :: Assertion +testSpecificPackagesConcat = do + (config, legacy) <- readConfigDefault "specific-packages-concat" + assertConfigEquals expected config legacy (projectConfigSpecificPackage . condTreeData) + where + expected = MapMappend $ Map.fromList [("foo", expectedFoo)] + expectedFoo :: PackageConfig + expectedFoo = + mempty + { packageConfigSharedLib = Flag True + , packageConfigStaticLib = Flag True + , packageConfigProgramArgs = MapMappend $ Map.fromList [("ghc", ["-fno-state-hack", "-threaded"])] + } + +testProgramLocationsConcat :: Assertion +testProgramLocationsConcat = do + (config, legacy) <- readConfigDefault "program-locations-concat" + assertConfigEquals expected config legacy (projectConfigLocalPackages . condTreeData) + where + expected :: PackageConfig + expected = + mempty + { packageConfigProgramPaths = MapLast $ Map.fromList [("gcc", "/tmp/bin/gcc"), ("ghc", "/tmp/bin/ghc")] + } + +testProgramOptionsConcat :: Assertion +testProgramOptionsConcat = do + (config, legacy) <- readConfigDefault "program-options-concat" + assertConfigEquals expected config legacy (projectConfigLocalPackages . condTreeData) + where + expected :: PackageConfig + expected = + mempty + { packageConfigProgramArgs = + MapMappend $ + Map.fromList + [ ("ghc", ["-threaded", "-Wall", "-fno-state-hack"]) + , ("gcc", ["-baz", "-foo", "-bar"]) + , ("haddock", ["--optghc=-optP -P"]) + , ("ld", ["-Wl,--gc-sections"]) + ] + } + +testRelaxDepsConcat :: Assertion +testRelaxDepsConcat = do + (config, legacy) <- readConfigDefault "relax-deps-concat" + assertConfigEquals expectedAllowNewer config legacy (projectConfigAllowNewer . projectConfigShared . condTreeData) + assertConfigEquals expectedAllowOlder config legacy (projectConfigAllowOlder . projectConfigShared . condTreeData) + where + expectedAllowNewer :: Maybe AllowNewer + expectedAllowNewer = + pure $ + AllowNewer $ + RelaxDepsSome + [ RelaxedDep (RelaxDepScopePackageId (PackageIdentifier (mkPackageName "cassava") (mkVersion [0, 5, 2, 0]))) RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "base")) + , RelaxedDep (RelaxDepScopePackageId (PackageIdentifier (mkPackageName "vector-th-unbox") (mkVersion [0, 2, 1, 7]))) RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "base")) + , RelaxedDep (RelaxDepScopePackageId (PackageIdentifier (mkPackageName "vector-th-unbox") (mkVersion [0, 2, 1, 7]))) RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "template-haskell")) + ] + expectedAllowOlder :: Maybe AllowOlder + expectedAllowOlder = + pure $ + AllowOlder $ + RelaxDepsSome + [ RelaxedDep (RelaxDepScopePackageId (PackageIdentifier (mkPackageName "mtl") (mkVersion [2, 3, 1]))) RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "base")) + , RelaxedDep (RelaxDepScopePackageId (PackageIdentifier (mkPackageName "aeson") (mkVersion [2, 2, 3, 0]))) RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "bytestring")) + , RelaxedDep (RelaxDepScopePackageId (PackageIdentifier (mkPackageName "containers") (mkVersion [0, 7]))) RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "array")) + ] + +-- | Tests that if both library-coverage and coverage flags are specified, library-coverage is used. +testLibraryCoverage :: Assertion +testLibraryCoverage = do + (config, legacy) <- readConfigDefault "library-coverage" + assertConfigEquals (Flag False) config legacy (packageConfigCoverage . projectConfigLocalPackages . condTreeData) + +testHaddockAll :: Assertion +testHaddockAll = do + (config, legacy) <- readConfigDefault "haddock-all" + assertConfigEquals (Flag True) config legacy (packageConfigHaddockExecutables . projectConfigLocalPackages . condTreeData) + assertConfigEquals (Flag True) config legacy (packageConfigHaddockTestSuites . projectConfigLocalPackages . condTreeData) + assertConfigEquals (Flag True) config legacy (packageConfigHaddockBenchmarks . projectConfigLocalPackages . condTreeData) + assertConfigEquals (Flag True) config legacy (packageConfigHaddockForeignLibs . projectConfigLocalPackages . condTreeData) + +-- | Tests that an explicitly set field can override a value inherited from haddock-all. +testHaddockAllOverwriteTrue :: Assertion +testHaddockAllOverwriteTrue = do + (config, legacy) <- readConfigDefault "haddock-all-overwrite-true" + assertConfigEquals (Flag True) config legacy (packageConfigHaddockExecutables . projectConfigLocalPackages . condTreeData) + assertConfigEquals (Flag True) config legacy (packageConfigHaddockTestSuites . projectConfigLocalPackages . condTreeData) + assertConfigEquals (Flag True) config legacy (packageConfigHaddockBenchmarks . projectConfigLocalPackages . condTreeData) + assertConfigEquals (Flag False) config legacy (packageConfigHaddockForeignLibs . projectConfigLocalPackages . condTreeData) + +testHaddockAllOverwriteFalse :: Assertion +testHaddockAllOverwriteFalse = do + (config, legacy) <- readConfigDefault "haddock-all-overwrite-false" + assertConfigEquals (Flag True) config legacy (packageConfigHaddockExecutables . projectConfigLocalPackages . condTreeData) + assertConfigEquals (Flag False) config legacy (packageConfigHaddockTestSuites . projectConfigLocalPackages . condTreeData) + assertConfigEquals (Flag False) config legacy (packageConfigHaddockBenchmarks . projectConfigLocalPackages . condTreeData) + assertConfigEquals (Flag False) config legacy (packageConfigHaddockForeignLibs . projectConfigLocalPackages . condTreeData) + +------------------------------------------------------------------------------- +-- Test Utilities +------------------------------------------------------------------------------- +baseDir :: FilePath +baseDir = "parser-tests" "Tests" "files" + +verbosity :: Verbosity +verbosity = normal + +readConfigDefault :: FilePath -> IO (ProjectConfigSkeleton, ProjectConfigSkeleton) +readConfigDefault testSubDir = readConfig testSubDir "cabal.project" + +readConfig :: FilePath -> FilePath -> IO (ProjectConfigSkeleton, ProjectConfigSkeleton) +readConfig testSubDir projectFileName = do + (TestDir testRootFp projectConfigFp distDirLayout) <- testDirInfo testSubDir projectFileName + exists <- liftIO $ doesFileExist projectConfigFp + assertBool ("projectConfig does not exist: " <> projectConfigFp) exists + httpTransport <- liftIO $ configureTransport verbosity [] Nothing + let extensionName = "" + extensionDescription = "" + parsec <- + liftIO $ + runRebuild testRootFp $ + readProjectFileSkeletonParsec verbosity httpTransport distDirLayout extensionName extensionDescription + legacy <- + liftIO $ + runRebuild testRootFp $ + readProjectFileSkeletonLegacy verbosity httpTransport distDirLayout extensionName extensionDescription + return (parsec, legacy) + +assertConfigEquals :: (Eq a, Show a) => a -> ProjectConfigSkeleton -> ProjectConfigSkeleton -> (ProjectConfigSkeleton -> a) -> Assertion +assertConfigEquals expected config configLegacy access = do + assertEqual "Expectation does not match result of Legacy parser" expected actualLegacy + assertEqual "Parsed Config does not match expected" expected actual + where + actual = access config + actualLegacy = access configLegacy + +-- | Represents the directory structure and associated file paths for a test +data TestDir = TestDir + { _testDirTestRootFp :: FilePath + -- ^ Every test has a root directory in ./files/ + , _testDirProjectConfigFp :: FilePath + -- ^ Every test has a project config in testDirTestRootFp/cabal.project + , _testDirDistDirLayout :: DistDirLayout + } + +testDirInfo :: FilePath -> FilePath -> IO TestDir +testDirInfo testSubDir projectFileName = do + projectRootDir <- canonicalizePath (baseDir testSubDir) + let + projectRoot = ProjectRootExplicit projectRootDir projectFileName + distDirLayout = defaultDistDirLayout projectRoot Nothing Nothing + extensionName = "" + projectConfigFp = distProjectFile distDirLayout extensionName + return $ TestDir projectRootDir projectConfigFp distDirLayout + +-- | Compares two lists element-wise using a comparison function. +compareLists :: [a] -> [a] -> (a -> a -> Bool) -> Bool +compareLists xs ys compare' = length xs == length ys && all (uncurry compare') (zip xs ys) + +-- | Compares LocalRepos ignoring field 'localRepoSharedCache' because we do not parse it. +compareLocalRepos :: LocalRepo -> LocalRepo -> Bool +compareLocalRepos repo1 repo2 = + localRepoName repo1 == localRepoName repo2 + && localRepoPath repo1 == localRepoPath repo2 + +-- | Compares RemoteRepos ignoring field 'remoteRepoShouldTryHttps' because we do not parse it. +compareRemoteRepos :: RemoteRepo -> RemoteRepo -> Bool +compareRemoteRepos repo1 repo2 = + remoteRepoName repo1 == remoteRepoName repo2 + && remoteRepoURI repo1 == remoteRepoURI repo2 + && remoteRepoSecure repo1 == remoteRepoSecure repo2 + && remoteRepoRootKeys repo1 == remoteRepoRootKeys repo2 + && remoteRepoKeyThreshold repo1 == remoteRepoKeyThreshold repo2 diff --git a/cabal-install/parser-tests/Tests/files/all-packages-concat/cabal.project b/cabal-install/parser-tests/Tests/files/all-packages-concat/cabal.project new file mode 100644 index 00000000000..a85e19b9868 --- /dev/null +++ b/cabal-install/parser-tests/Tests/files/all-packages-concat/cabal.project @@ -0,0 +1,8 @@ +package * + static: True + ghc-options: -fwrite-ide-info + ghc-options: -Wall -optc-fno-builtin-realloc + +package * + shared: True + ghc-options: -fwarn-tabs -optc-fno-builtin-malloc diff --git a/cabal-install/parser-tests/Tests/files/empty/cabal.project b/cabal-install/parser-tests/Tests/files/empty/cabal.project new file mode 100644 index 00000000000..e69de29bb2d diff --git a/cabal-install/parser-tests/Tests/files/extra-packages/cabal.project b/cabal-install/parser-tests/Tests/files/extra-packages/cabal.project new file mode 100644 index 00000000000..13d55f2ef33 --- /dev/null +++ b/cabal-install/parser-tests/Tests/files/extra-packages/cabal.project @@ -0,0 +1,3 @@ +extra-packages: + a + , b >= 0.7.3 && < 0.9, diff --git a/cabal-install/parser-tests/Tests/files/haddock-all-overwrite-false/cabal.project b/cabal-install/parser-tests/Tests/files/haddock-all-overwrite-false/cabal.project new file mode 100644 index 00000000000..c0c044081b6 --- /dev/null +++ b/cabal-install/parser-tests/Tests/files/haddock-all-overwrite-false/cabal.project @@ -0,0 +1,2 @@ +haddock-all: False +haddock-executables: True diff --git a/cabal-install/parser-tests/Tests/files/haddock-all-overwrite-true/cabal.project b/cabal-install/parser-tests/Tests/files/haddock-all-overwrite-true/cabal.project new file mode 100644 index 00000000000..c591d86a961 --- /dev/null +++ b/cabal-install/parser-tests/Tests/files/haddock-all-overwrite-true/cabal.project @@ -0,0 +1,2 @@ +haddock-all: True +haddock-foreign-libraries: False diff --git a/cabal-install/parser-tests/Tests/files/haddock-all/cabal.project b/cabal-install/parser-tests/Tests/files/haddock-all/cabal.project new file mode 100644 index 00000000000..275c4539524 --- /dev/null +++ b/cabal-install/parser-tests/Tests/files/haddock-all/cabal.project @@ -0,0 +1 @@ +haddock-all: True diff --git a/cabal-install/parser-tests/Tests/files/install-dirs/cabal.project b/cabal-install/parser-tests/Tests/files/install-dirs/cabal.project new file mode 100644 index 00000000000..e9397c1bbef --- /dev/null +++ b/cabal-install/parser-tests/Tests/files/install-dirs/cabal.project @@ -0,0 +1,13 @@ +prefix: my/prefix-path +bindir: bin/dir/ +libdir: lib/dir/path +libsubdir: /lib/sub/dir +dynlibdir: dyn/lib/dir/path +libexecdir: lib/exec/dir/ +libexecsubdir: libexec/subdir +datadir: path/to/datadir/ +datasubdir: a/datadir/subdir +docdir: path/to/docs +htmldir: dir/html/ +haddockdir: haddock/dir +sysconfdir: sys/conf/dir diff --git a/cabal-install/parser-tests/Tests/files/library-coverage/cabal.project b/cabal-install/parser-tests/Tests/files/library-coverage/cabal.project new file mode 100644 index 00000000000..074a06e7731 --- /dev/null +++ b/cabal-install/parser-tests/Tests/files/library-coverage/cabal.project @@ -0,0 +1,2 @@ +library-coverage: False +coverage: True diff --git a/cabal-install/parser-tests/Tests/files/local-no-index-repos/cabal.project b/cabal-install/parser-tests/Tests/files/local-no-index-repos/cabal.project new file mode 100644 index 00000000000..f6b42df28b6 --- /dev/null +++ b/cabal-install/parser-tests/Tests/files/local-no-index-repos/cabal.project @@ -0,0 +1,5 @@ +repository my-repository + url: file+noindex:///absolute/path/to/directory + +repository my-other-repository + url: file+noindex:/another/path/to/repository diff --git a/cabal-install/parser-tests/Tests/files/optional-packages/cabal.project b/cabal-install/parser-tests/Tests/files/optional-packages/cabal.project new file mode 100644 index 00000000000..37e21016d6a --- /dev/null +++ b/cabal-install/parser-tests/Tests/files/optional-packages/cabal.project @@ -0,0 +1 @@ +optional-packages: . packages/packages.cabal diff --git a/cabal-install/parser-tests/Tests/files/packages/cabal.project b/cabal-install/parser-tests/Tests/files/packages/cabal.project new file mode 100644 index 00000000000..6d9d4728a55 --- /dev/null +++ b/cabal-install/parser-tests/Tests/files/packages/cabal.project @@ -0,0 +1 @@ +packages: . packages/packages.cabal diff --git a/cabal-install/parser-tests/Tests/files/program-locations-concat/cabal.project b/cabal-install/parser-tests/Tests/files/program-locations-concat/cabal.project new file mode 100644 index 00000000000..95657d95a17 --- /dev/null +++ b/cabal-install/parser-tests/Tests/files/program-locations-concat/cabal.project @@ -0,0 +1,5 @@ +program-locations + gcc-location: /tmp/bin/gcc + +program-locations + ghc-location: /tmp/bin/ghc diff --git a/cabal-install/parser-tests/Tests/files/program-options-concat/cabal.project b/cabal-install/parser-tests/Tests/files/program-options-concat/cabal.project new file mode 100644 index 00000000000..a418091c0d5 --- /dev/null +++ b/cabal-install/parser-tests/Tests/files/program-options-concat/cabal.project @@ -0,0 +1,9 @@ +program-options + ghc-options: -fno-state-hack + gcc-options: -foo -bar + haddock-options: --optghc="-optP -P" + +program-options + ghc-options: -threaded -Wall + gcc-options: -baz + ld-options: -Wl,--gc-sections diff --git a/cabal-install/parser-tests/Tests/files/project-config-all-packages/cabal.project b/cabal-install/parser-tests/Tests/files/project-config-all-packages/cabal.project new file mode 100644 index 00000000000..2b336cf830c --- /dev/null +++ b/cabal-install/parser-tests/Tests/files/project-config-all-packages/cabal.project @@ -0,0 +1,3 @@ +package * + profiling-detail: all-functions + library-profiling-detail: exported-functions diff --git a/cabal-install/parser-tests/Tests/files/project-config-build-only/cabal.project b/cabal-install/parser-tests/Tests/files/project-config-build-only/cabal.project new file mode 100644 index 00000000000..eac06d8aadd --- /dev/null +++ b/cabal-install/parser-tests/Tests/files/project-config-build-only/cabal.project @@ -0,0 +1,22 @@ +verbose: 2 +build-summary: summaryFile, summaryFile2 +build-log: myLog.log +remote-build-reporting: detailed +report-planning-failure: True +symlink-bindir: some-bindir +jobs: 4 +semaphore: True +keep-going: True +offline: True +haddock-keep-temp-files: True +http-transport: wget +ignore-expiry: True +remote-repo-cache: some-cache-dir +logs-dir: logs-directory + +-- clientInstallFlags +lib: True +package-env: path/to/env +overwrite-policy: always +install-method: symlink +installdir: path/to/installdir diff --git a/cabal-install/parser-tests/Tests/files/project-config-local-packages/cabal.project b/cabal-install/parser-tests/Tests/files/project-config-local-packages/cabal.project new file mode 100644 index 00000000000..77ffb93ff00 --- /dev/null +++ b/cabal-install/parser-tests/Tests/files/project-config-local-packages/cabal.project @@ -0,0 +1,70 @@ +program-options + ghc-options: -fno-state-hack -foo + gcc-options: -baz -quux + +program-locations + ghc-location: /tmp/bin/ghc + gcc-location: /tmp/bin/gcc + +extra-prog-path: /tmp/bin/extra, /usr/local/bin +flags: +foo -bar +library-vanilla: False +shared: True +static: True +executable-dynamic: True +executable-static: True +profiling: True +library-profiling: True +profiling-shared: False +executable-profiling: True +profiling-detail: all-functions +library-profiling-detail: exported-functions +configure-options: -some-arg /some/path +optimization: 2 +program-prefix: another/path +program-suffix: and/another/path +extra-lib-dirs: so, many, lib/dirs +extra-lib-dirs-static: a/few, static/lib/dirs +extra-framework-dirs: osx/framework, dirs +extra-include-dirs: incredible/amount, of, include, directories +library-for-ghci: False +split-sections: True +split-objs: True +executable-stripping: False +library-stripping: False +tests: True +benchmarks: True +coverage: True +relocatable: True +debug-info: 3 +build-info: True +run-tests: True +documentation: True +haddock-hoogle: True +haddock-html: False +haddock-html-location: http://hackage.haskell.org/packages/archive/$pkg/latest/doc/html +haddock-foreign-libraries: True +haddock-executables: True +haddock-tests: True +haddock-benchmarks: True +haddock-internal: True +haddock-css: some/path/to/file.css +haddock-hyperlink-source: True +haddock-quickjump: True +haddock-hscolour-css: another/path/to/hscolour.css +haddock-contents-location: https://example.com/$pkg/contents +haddock-index-location: separately-generated/HTML/index +haddock-base-url: https://example.com/haddock-base-url +haddock-resources-dir: /haddock/static +haddock-output-dir: /haddock/output +haddock-use-unicode: False +haddock-for-hackage: for-hackage + +test-log: human-log.log +test-machine-log: machine.log +test-keep-tix-files: True +test-wrapper: /test-wrapper-path/ +test-fail-when-no-test-suites: True +test-show-details: streaming +test-options: --some-option 42 +benchmark-options: --some-benchmark-option --another-option diff --git a/cabal-install/parser-tests/Tests/files/project-config-shared/cabal.project b/cabal-install/parser-tests/Tests/files/project-config-shared/cabal.project new file mode 100644 index 00000000000..90f00f96278 --- /dev/null +++ b/cabal-install/parser-tests/Tests/files/project-config-shared/cabal.project @@ -0,0 +1,39 @@ +builddir: something +project-dir: my-project-dir +project-file: my-project +store-dir: a/store/dir/path +per-component: True +independent-goals: True +ignore-project: False +compiler: ghcjs +with-compiler: /some/path/to/compiler +with-hc-pkg: /some/path/to/ghc-pkg +doc-index-file: /path/to/haddock-index +package-dbs: clear, foo, clear, bar, baz +active-repositories: + , hackage.haskell.org + , my-repository:override +index-state: + , hackage.haskell.org 2020-05-06T22:33:27Z + , head.hackage 2020-04-29T04:11:05Z +constraints: bar == 2.1, + bar +foo -baz +preferences: foo == 0.9, + baz > 2.0 +cabal-lib-version: 1.24.0.1 +solver: modular +allow-older: dep, pkga-1.1.2:dep-pkg +allow-newer: pkgb-1.2.3:dep-pkgb, importantlib +write-ghc-environment-files: always +max-backjumps: 42 +reorder-goals: True +count-conflicts: False +fine-grained-conflicts: False +minimize-conflict-set: True +strong-flags: True +allow-boot-library-installs: True +reject-unconstrained-dependencies: all +prefer-oldest: True +extra-prog-path: /foo/bar, /baz/quux +extra-prog-path-shared-only: /foo/bar, /baz/quux +multi-repl: True diff --git a/cabal-install/parser-tests/Tests/files/project-config-specific-packages/cabal.project b/cabal-install/parser-tests/Tests/files/project-config-specific-packages/cabal.project new file mode 100644 index 00000000000..166b5db3d68 --- /dev/null +++ b/cabal-install/parser-tests/Tests/files/project-config-specific-packages/cabal.project @@ -0,0 +1,12 @@ +package foo + profiling-detail: all-functions + library-profiling-detail: exported-functions + library-vanilla: True + +package bar + profiling-detail: late-toplevel + library-profiling-detail: none + program-prefix: prefix/path + +package baz + shared: True diff --git a/cabal-install/parser-tests/Tests/files/relax-deps-concat/cabal.project b/cabal-install/parser-tests/Tests/files/relax-deps-concat/cabal.project new file mode 100644 index 00000000000..8e328432b64 --- /dev/null +++ b/cabal-install/parser-tests/Tests/files/relax-deps-concat/cabal.project @@ -0,0 +1,7 @@ +-- allow-newer: parallel-3.2.2.0:base +allow-newer: cassava-0.5.2.0:base +allow-newer: vector-th-unbox-0.2.1.7:base +allow-newer: vector-th-unbox-0.2.1.7:template-haskell + +allow-older: mtl-2.3.1:base, aeson-2.2.3.0:bytestring +allow-older: containers-0.7:array diff --git a/cabal-install/parser-tests/Tests/files/remote-repos/cabal.project b/cabal-install/parser-tests/Tests/files/remote-repos/cabal.project new file mode 100644 index 00000000000..819af437b03 --- /dev/null +++ b/cabal-install/parser-tests/Tests/files/remote-repos/cabal.project @@ -0,0 +1,18 @@ +repository packages.example.org + url: http://packages.example.org/ + secure: True + root-keys: 21, 42 + key-threshold: 2 + +repository more-packages.example.org + url: https://more-packages.example.org/ + secure: True + root-keys: foo + , bar + key-threshold: 1 + +repository my-secure-local-repository + url: file:/path/to/secure/repo + secure: True + root-keys: 123 + key-threshold: 1 diff --git a/cabal-install/parser-tests/Tests/files/source-repository-packages/cabal.project b/cabal-install/parser-tests/Tests/files/source-repository-packages/cabal.project new file mode 100644 index 00000000000..1ab7d417b54 --- /dev/null +++ b/cabal-install/parser-tests/Tests/files/source-repository-packages/cabal.project @@ -0,0 +1,10 @@ +source-repository-package + type: git + location: https://example.com/Project.git + tag: 1234 + +source-repository-package + type: git + location: https://example.com/example-dir/ + tag: 12345 + subdir: subproject diff --git a/cabal-install/parser-tests/Tests/files/specific-packages-concat/cabal.project b/cabal-install/parser-tests/Tests/files/specific-packages-concat/cabal.project new file mode 100644 index 00000000000..94766d451fa --- /dev/null +++ b/cabal-install/parser-tests/Tests/files/specific-packages-concat/cabal.project @@ -0,0 +1,7 @@ +package foo + static: True + ghc-options: -fno-state-hack + +package foo + shared: True + ghc-options: -threaded diff --git a/cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs b/cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs index ce1d1665327..7bc6bb8872b 100644 --- a/cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs +++ b/cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs @@ -140,10 +140,10 @@ fieldDescrs = parseBuildReport :: BS.ByteString -> Either String BuildReport parseBuildReport s = case snd $ runParseResult $ parseFields s of - Left (_, perrors) -> Left $ unlines [err | PError _ err <- toList perrors] + Left (_, perrors) -> Left $ unlines [err | PErrorWithSource _ (PError _ err) <- toList perrors] Right report -> Right report -parseFields :: BS.ByteString -> ParseResult BuildReport +parseFields :: BS.ByteString -> ParseResult src BuildReport parseFields input = do fields <- either (parseFatalFailure zeroPos . show) pure $ readFields input case partitionFields fields of diff --git a/cabal-install/src/Distribution/Client/Check.hs b/cabal-install/src/Distribution/Client/Check.hs index eb053d7e46e..6ca20139855 100644 --- a/cabal-install/src/Distribution/Client/Check.hs +++ b/cabal-install/src/Distribution/Client/Check.hs @@ -16,19 +16,16 @@ import Distribution.Client.Compat.Prelude import Prelude () import Distribution.Client.Errors -import Distribution.Client.Utils.Parsec (renderParseError) + +import Distribution.Client.Errors.Parser +import Distribution.Fields.ParseResult import Distribution.PackageDescription (GenericPackageDescription) import Distribution.PackageDescription.Check import Distribution.PackageDescription.Parsec - ( parseGenericPackageDescription - , runParseResult - ) -import Distribution.Parsec (PWarning (..), showPError) +import Distribution.Parsec import Distribution.Simple.Utils (defaultPackageDescCwd, dieWithException, notice, warn, warnError) import Distribution.Utils.Path (getSymbolicPath) -import System.IO (hPutStr, stderr) - import qualified Control.Monad as CM import qualified Data.ByteString as BS import qualified Data.Function as F @@ -36,19 +33,17 @@ import qualified Data.List as L import qualified Data.List.NonEmpty as NE import qualified System.Directory as Dir -readGenericPackageDescriptionCheck :: Verbosity -> FilePath -> IO ([PWarning], GenericPackageDescription) +readGenericPackageDescriptionCheck :: Verbosity -> FilePath -> IO ([PWarningWithSource CabalFileSource], GenericPackageDescription) readGenericPackageDescriptionCheck verbosity fpath = do exists <- Dir.doesFileExist fpath unless exists $ dieWithException verbosity $ FileDoesntExist fpath bs <- BS.readFile fpath - let (warnings, result) = runParseResult (parseGenericPackageDescription bs) + let (warnings, result) = runParseResult $ withSource (PCabalFile (fpath, bs)) (parseGenericPackageDescription bs) case result of - Left (_, errors) -> do - traverse_ (warn verbosity . showPError fpath) errors - hPutStr stderr $ renderParseError fpath bs errors warnings - dieWithException verbosity ParseError + Left (mspecVersion, errors) -> do + dieWithException verbosity (CabalCheckParseError (CabalFileParseError fpath bs errors mspecVersion warnings)) Right x -> return (warnings, x) -- | Checks a package for common errors. Returns @True@ if the package @@ -65,7 +60,7 @@ check verbosity ignores = do pdfile <- getSymbolicPath <$> defaultPackageDescCwd verbosity (ws, ppd) <- readGenericPackageDescriptionCheck verbosity pdfile -- convert parse warnings into PackageChecks - let ws' = map (wrapParseWarning pdfile) ws + let ws' = map (wrapParseWarning pdfile . pwarning) ws ioChecks <- checkPackageFilesGPD verbosity ppd "." let packageChecksPrim = ioChecks ++ checkPackage ppd ++ ws' (packageChecks, unrecs) = filterPackageChecksByIdString packageChecksPrim ignores diff --git a/cabal-install/src/Distribution/Client/CmdConfigure.hs b/cabal-install/src/Distribution/Client/CmdConfigure.hs index 8ce26f986ad..dbaec030520 100644 --- a/cabal-install/src/Distribution/Client/CmdConfigure.hs +++ b/cabal-install/src/Distribution/Client/CmdConfigure.hs @@ -159,7 +159,11 @@ configureAction' flags@NixStyleFlags{..} _extraArgs globalFlags = do (flagToMaybe . projectConfigHttpTransport $ projectConfigBuildOnly cliConfig) (CondNode conf imps bs) <- runRebuild (distProjectRootDirectory . distDirLayout $ baseCtx) $ - readProjectLocalExtraConfig v httpTransport (distDirLayout baseCtx) + readProjectLocalExtraConfig + v + (fromFlagOrDefault defaultProjectFileParser $ projectConfigProjectFileParser $ projectConfigShared cliConfig) + httpTransport + (distDirLayout baseCtx) when (not (null imps && null bs)) $ dieWithException v UnableToPerformInplaceUpdate return (baseCtx, conf <> cliConfig) else return (baseCtx, cliConfig) diff --git a/cabal-install/src/Distribution/Client/CmdInstall/ClientInstallFlags.hs b/cabal-install/src/Distribution/Client/CmdInstall/ClientInstallFlags.hs index 1be09c514a9..32077fe7b99 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall/ClientInstallFlags.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall/ClientInstallFlags.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} module Distribution.Client.CmdInstall.ClientInstallFlags @@ -6,9 +8,12 @@ module Distribution.Client.CmdInstall.ClientInstallFlags , ClientInstallFlags (..) , defaultClientInstallFlags , clientInstallOptions + , clientInstallFlagsGrammar ) where import Distribution.Client.Compat.Prelude +import Distribution.Compat.Lens (Lens') +import Distribution.FieldGrammar import Prelude () import Distribution.ReadE @@ -35,6 +40,7 @@ import Distribution.Client.Types.InstallMethod import Distribution.Client.Types.OverwritePolicy ( OverwritePolicy (..) ) +import Distribution.Client.Utils.Parsec import qualified Distribution.Compat.CharParsing as P @@ -114,6 +120,26 @@ clientInstallOptions _ = $ reqArg "DIR" (succeedReadE Flag) flagToList ] +clientInstallFlagsGrammar + :: ( FieldGrammar c g + , Applicative (g ClientInstallFlags) + , c (Identity (Flag Bool)) + , c (Flag' FilePathNT FilePath) + , c (Identity (Flag OverwritePolicy)) + , c (Identity (Flag InstallMethod)) + ) + => g ClientInstallFlags ClientInstallFlags +clientInstallFlagsGrammar = + ClientInstallFlags + <$> optionalFieldDef "lib" cinstInstallLibsLens mempty + <*> ( optionalFieldDefAla "package-env" (alaFlag FilePathNT) cinstEnvironmentPathLens mempty + <* optionalFieldDefAla "env" (alaFlag FilePathNT) cinstEnvironmentPathLens mempty + ) + <*> optionalFieldDef "overwrite-policy" cinstOverwritePolicyLens mempty + <*> optionalFieldDef "install-method" cinstInstallMethodLens mempty + <*> optionalFieldDefAla "installdir" (alaFlag FilePathNT) cinstInstalldirLens mempty +{-# SPECIALIZE clientInstallFlagsGrammar :: ParsecFieldGrammar' ClientInstallFlags #-} + parsecInstallMethod :: CabalParsing m => m InstallMethod parsecInstallMethod = do name <- P.munch1 isAlpha @@ -121,3 +147,23 @@ parsecInstallMethod = do "copy" -> pure InstallMethodCopy "symlink" -> pure InstallMethodSymlink _ -> P.unexpected $ "InstallMethod: " ++ name + +cinstInstallLibsLens :: Lens' ClientInstallFlags (Flag Bool) +cinstInstallLibsLens f c = fmap (\x -> c{cinstInstallLibs = x}) (f (cinstInstallLibs c)) +{-# INLINEABLE cinstInstallLibsLens #-} + +cinstEnvironmentPathLens :: Lens' ClientInstallFlags (Flag FilePath) +cinstEnvironmentPathLens f c = fmap (\x -> c{cinstEnvironmentPath = x}) (f (cinstEnvironmentPath c)) +{-# INLINEABLE cinstEnvironmentPathLens #-} + +cinstOverwritePolicyLens :: Lens' ClientInstallFlags (Flag OverwritePolicy) +cinstOverwritePolicyLens f c = fmap (\x -> c{cinstOverwritePolicy = x}) (f (cinstOverwritePolicy c)) +{-# INLINEABLE cinstOverwritePolicyLens #-} + +cinstInstallMethodLens :: Lens' ClientInstallFlags (Flag InstallMethod) +cinstInstallMethodLens f c = fmap (\x -> c{cinstInstallMethod = x}) (f (cinstInstallMethod c)) +{-# INLINEABLE cinstInstallMethodLens #-} + +cinstInstalldirLens :: Lens' ClientInstallFlags (Flag FilePath) +cinstInstalldirLens f c = fmap (\x -> c{cinstInstalldir = x}) (f (cinstInstalldir c)) +{-# INLINEABLE cinstInstalldirLens #-} diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs index 77348dbc638..d0c3db2c32e 100644 --- a/cabal-install/src/Distribution/Client/Config.hs +++ b/cabal-install/src/Distribution/Client/Config.hs @@ -675,6 +675,7 @@ instance Semigroup SavedConfig where { flagProjectDir = combine flagProjectDir , flagProjectFile = combine flagProjectFile , flagIgnoreProject = combine flagIgnoreProject + , flagProjectFileParser = combine flagProjectFileParser } where combine = combine' savedProjectFlags diff --git a/cabal-install/src/Distribution/Client/Errors.hs b/cabal-install/src/Distribution/Client/Errors.hs index 06f965fd972..4270435b54f 100644 --- a/cabal-install/src/Distribution/Client/Errors.hs +++ b/cabal-install/src/Distribution/Client/Errors.hs @@ -37,6 +37,8 @@ import Text.PrettyPrint hiding (render, (<>)) import qualified Text.PrettyPrint as PP import Text.Regex.Posix.ByteString (WrapError) +import Distribution.Client.Errors.Parser + data CabalInstallException = UnpackGet | NotTarballDir FilePath @@ -61,7 +63,7 @@ data CabalInstallException | UnableToPerformInplaceUpdate | EmptyValuePagerEnvVariable | FileDoesntExist FilePath - | ParseError + | CabalCheckParseError CabalFileParseError | CabalFileNotFound FilePath | FindOpenProgramLocationErr String | PkgConfParseFailed String @@ -187,6 +189,9 @@ data CabalInstallException | CmdPathAcceptsNoTargets | CmdPathCommandDoesn'tSupportDryRun | GenBoundsDoesNotSupportScript FilePath + | LegacyAndParsecParseResultsDiffer FilePath String String + | CabalFileParseFailure CabalFileParseError + | ProjectConfigParseFailure ProjectConfigParseError deriving (Show) exceptionCodeCabalInstall :: CabalInstallException -> Int @@ -214,7 +219,7 @@ exceptionCodeCabalInstall e = case e of UnableToPerformInplaceUpdate{} -> 7032 EmptyValuePagerEnvVariable{} -> 7033 FileDoesntExist{} -> 7034 - ParseError{} -> 7035 + CabalCheckParseError{} -> 7035 CabalFileNotFound{} -> 7036 FindOpenProgramLocationErr{} -> 7037 PkgConfParseFailed{} -> 7038 @@ -340,6 +345,9 @@ exceptionCodeCabalInstall e = case e of CmdPathAcceptsNoTargets{} -> 7161 CmdPathCommandDoesn'tSupportDryRun -> 7163 GenBoundsDoesNotSupportScript{} -> 7164 + LegacyAndParsecParseResultsDiffer{} -> 7165 + CabalFileParseFailure{} -> 7166 + ProjectConfigParseFailure{} -> 7167 exceptionMessageCabalInstall :: CabalInstallException -> String exceptionMessageCabalInstall e = case e of @@ -378,7 +386,7 @@ exceptionMessageCabalInstall e = case e of UnableToPerformInplaceUpdate -> "local project file has conditional and/or import logic, unable to perform and automatic in-place update" EmptyValuePagerEnvVariable -> "man: empty value of the PAGER environment variable" FileDoesntExist fpath -> "Error Parsing: file \"" ++ fpath ++ "\" doesn't exist. Cannot continue." - ParseError -> "parse error" + CabalCheckParseError err -> renderCabalFileParseError err CabalFileNotFound cabalFile -> "Package .cabal file not found in the tarball: " ++ cabalFile FindOpenProgramLocationErr err -> err PkgConfParseFailed perror -> @@ -864,6 +872,19 @@ exceptionMessageCabalInstall e = case e of "The 'path' command doesn't support the flag '--dry-run'." GenBoundsDoesNotSupportScript{} -> "The 'gen-bounds' command does not support script targets." + LegacyAndParsecParseResultsDiffer _fp legacyParsec parsec -> + unlines + [ "The legacy and parsec parsers produced different results for the project file. This is unexpected, please report this as a bug." + , "The legacy parser will be removed in the next major version." + , "Legacy parse result:" + , legacyParsec + , "Parsec parse result:" + , parsec + ] + CabalFileParseFailure cbfError -> + renderCabalFileParseError cbfError + ProjectConfigParseFailure pcfError -> + renderProjectConfigParseError pcfError instance Exception (VerboseException CabalInstallException) where displayException :: VerboseException CabalInstallException -> [Char] diff --git a/cabal-install/src/Distribution/Client/Errors/Parser.hs b/cabal-install/src/Distribution/Client/Errors/Parser.hs new file mode 100644 index 00000000000..b2e19397925 --- /dev/null +++ b/cabal-install/src/Distribution/Client/Errors/Parser.hs @@ -0,0 +1,277 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Distribution.Client.Errors.Parser where + +import Distribution.Client.Compat.Prelude +import System.FilePath (normalise) +import Prelude () + +import qualified Data.ByteString.Char8 as BS8 +import qualified Data.List.NonEmpty as NE +import qualified Data.Map as Map +import qualified Data.Map.Merge.Strict as Map +import Distribution.Parsec +import Distribution.Parsec.Source +import Distribution.Simple.Utils (fromUTF8BS) +import Distribution.Solver.Types.ProjectConfigPath +import Distribution.Version (Version) +import Text.PrettyPrint (render) + +-- Error when parsing a .cabal file + +-- | Errors reported upon failing to parse a @.cabal@ file. +data CabalFileParseError + = CabalFileParseError + FilePath + -- ^ @.cabal@ file path + BS8.ByteString + -- ^ @.cabal@ file contents + (NonEmpty (PErrorWithSource CabalFileSource)) + -- ^ errors + (Maybe Version) + -- ^ We might discover the spec version the package needs + [PWarningWithSource CabalFileSource] + -- ^ warnings + +-- | Manual instance which skips file contents +instance Show CabalFileParseError where + showsPrec d (CabalFileParseError fp _ es mv ws) = + showParen (d > 10) $ + showString "CabalFileParseError" + . showChar ' ' + . showsPrec 11 fp + . showChar ' ' + . showsPrec 11 ("" :: String) + . showChar ' ' + . showsPrec 11 es + . showChar ' ' + . showsPrec 11 mv + . showChar ' ' + . showsPrec 11 ws + +instance Exception CabalFileParseError where + displayException = renderCabalFileParseError + +renderCabalFileParseError :: CabalFileParseError -> String +renderCabalFileParseError (CabalFileParseError _filePath _contents errors _ warnings) = + renderParseErrorCabalFile errors warnings + +-- Error when parsing a project file + +-- | Errors reported upon failing to parse a @cabal.project@ file. +data ProjectConfigParseError + = ProjectConfigParseError + (NonEmpty (PErrorWithSource ProjectFileSource)) + -- ^ errors + [PWarningWithSource ProjectFileSource] + -- ^ warnings + +-- | Manual instance which skips file contents +instance Show ProjectConfigParseError where + showsPrec d (ProjectConfigParseError es ws) = + showParen (d > 10) $ + showString "ProjectConfigParseError" + . showChar ' ' + . showsPrec 11 es + . showChar ' ' + . showsPrec 11 ws + +instance Exception ProjectConfigParseError where + displayException = renderProjectConfigParseError + +renderProjectConfigParseError :: ProjectConfigParseError -> String +renderProjectConfigParseError (ProjectConfigParseError errors warnings) = + renderParseError displayProjectFileSource errors warnings + where + displayProjectFileSource (ProjectFileSource (path, contents)) = + renderParseErrorFile "project" (currentProjectConfigPath path) (if isTopLevelConfigPath path then Nothing else Just $ render (docProjectImportedBy path)) contents + +data ProjectFileSource = ProjectFileSource (ProjectConfigPath, BS8.ByteString) deriving (Show, Generic) + +instance Eq ProjectFileSource where + (ProjectFileSource (path1, _)) == (ProjectFileSource (path2, _)) = path1 == path2 + +instance Ord ProjectFileSource where + (ProjectFileSource (path1, _)) `compare` (ProjectFileSource (path2, _)) = path1 `compare` path2 + +renderProjectFileSource :: ProjectFileSource -> String +renderProjectFileSource (ProjectFileSource (path, _contents)) = + currentProjectConfigPath path + +renderParseErrorCabalFile :: NonEmpty (PErrorWithSource CabalFileSource) -> [PWarningWithSource CabalFileSource] -> String +renderParseErrorCabalFile errors warnings = + renderParseError renderCabalFileSourceMsgs errors warnings + +-- | Render parse error highlighting the part of the input file. +renderParseError + :: forall src + . (Ord src, Eq src) + => (src -> ([PError], [PWarning]) -> String) + -> NonEmpty (PErrorWithSource src) + -> [PWarningWithSource src] + -> String +renderParseError display errors warnings = + unlines [renderParseErrorsWarnings (fmap display source) ws | (source, ws) <- joinedErrorsWarningsList] + where + mkErrorGroup :: NonEmpty (PErrorWithSource src) -> (PSource src, [PError]) + mkErrorGroup (x :| xs) = (perrorSource x, perror x : map perror xs) + + mkWarningGroup :: NonEmpty (PWarningWithSource src) -> (PSource src, [PWarning]) + mkWarningGroup (x :| xs) = (pwarningSource x, pwarning x : map pwarning xs) + + groupedErrors = + Map.fromListWith (++) $ + map mkErrorGroup $ + NE.groupBy + (\a b -> perrorSource a == perrorSource b) + errors + groupedWarnings = + Map.fromListWith (++) $ + map mkWarningGroup $ + NE.groupBy + (\a b -> pwarningSource a == pwarningSource b) + warnings + + joinedErrorsWarnings :: Map.Map (PSource src) ([PError], [PWarning]) + joinedErrorsWarnings = Map.merge (Map.mapMissing (\_ es -> (es, []))) (Map.mapMissing (\_ ps -> ([], ps))) (Map.zipWithMatched (\_ es ps -> (es, ps))) groupedErrors groupedWarnings + + joinedErrorsWarningsList = Map.toList joinedErrorsWarnings + +renderParseErrorsWarnings :: PSource (([PError], [PWarning]) -> String) -> ([PError], [PWarning]) -> String +renderParseErrorsWarnings source (errors, warnings) = + case source of + PKnownSource src -> src (errors, warnings) + PUnknownSource -> renderParseErrorNoFile "" errors warnings + +renderCabalFileSourceMsgs :: CabalFileSource -> ([PError], [PWarning]) -> String +renderCabalFileSourceMsgs (PCabalFile (fpath, contents)) (errors, warnings) = + renderParseErrorFile "cabal" fpath Nothing contents (errors, warnings) + +renderInstalledPackageInfoSourceMsgs :: InstalledPackageInfoSource -> ([PError], [PWarning]) -> String +renderInstalledPackageInfoSourceMsgs PInstalledPackageInfo (errors, warnings) = + renderParseErrorNoFile "installed package info" errors warnings + +renderParseErrorNoFile :: String -> [PError] -> [PWarning] -> String +renderParseErrorNoFile herald errors warnings = + renderParseErrorGeneral herald "" Nothing (const []) errors warnings + +-- | Render a parse error which resulted from a file on disk +renderParseErrorFile + :: String + -- ^ Human name for the kind of file (i.e. cabal, project "file") + -> FilePath + -- ^ Path to the file + -> Maybe String + -- ^ Provenance, any additional contextual info to print + -> BS8.ByteString + -- ^ Contents of the file + -> ([PError], [PWarning]) + -> String +renderParseErrorFile herald filepath provenance contents (errors, warnings) = + renderParseErrorGeneral (herald <> " file " <> filepath) (filepath' <> ":") provenance formatInput errors warnings + where + filepath' = normalise filepath + + -- lines of the input file. 'lines' is taken, so they are called rows + -- contents, line number, whether it's empty line + rows :: [(String, Int, Bool)] + rows = zipWith f (BS8.lines contents) [1 ..] + where + f bs i = let s = fromUTF8BS bs in (s, i, isEmptyOrComment s) + + rowsZipper = listToZipper rows + + isEmptyOrComment :: String -> Bool + isEmptyOrComment s = case dropWhile (== ' ') s of + "" -> True -- empty + ('-' : '-' : _) -> True -- comment + _ -> False + + -- format line: prepend the given line number + formatInput :: Position -> [String] + formatInput (Position row col) = case advance (row - 1) rowsZipper of + Zipper xs ys -> before ++ after + where + before = case span (\(_, _, b) -> b) xs of + (_, []) -> [] + (zs, z : _) -> map formatInputLine $ z : reverse zs + + after = case ys of + [] -> [] + (z : _zs) -> + [ formatInputLine z -- error line + , " | " ++ replicate (col - 1) ' ' ++ "^" -- pointer: ^ + ] + -- do we need rows after? + -- ++ map formatInputLine (take 1 zs) -- one row after + + formatInputLine :: (String, Int, Bool) -> String + formatInputLine (str, row, _) = leftPadShow row ++ " | " ++ str + + -- hopefully we don't need to work with over 99999 lines .cabal files + -- at that point small glitches in error messages are hopefully fine. + leftPadShow :: Int -> String + leftPadShow n = let s = show n in replicate (5 - length s) ' ' ++ s + +-- | A generic rendering function which can render from many sources. +renderParseErrorGeneral + :: String + -> String + -> Maybe String + -> (Position -> [String]) + -- ^ Extra information to render based on the position + -> [PError] + -> [PWarning] + -> String +renderParseErrorGeneral header err_header provenance extra_info errors warnings = + unlines $ + [ warningsOrErrors <> " encountered when parsing" <> header' <> ":" + ] + ++ [p | Just p <- [provenance]] + ++ renderedErrors + ++ renderedWarnings + where + warningsOrErrors = case errors of + [] -> case warnings of + [_] -> "Warning" + _ -> "Warnings" + [_] -> "Error" + _ -> "Errors" + + header' = if null header then "" else (" " <> header) + + renderedErrors = concatMap renderError (sortBy (comparing perrorPosition) errors) + renderedWarnings = concatMap renderWarning (sortBy (comparing pwarningPosition) warnings) + + renderError :: PError -> [String] + renderError (PError pos msg) + -- if position is 0:0, then it doesn't make sense to show input + -- looks like, Parsec errors have line-feed in them + | pos == zeroPos = msgs + | otherwise = msgs ++ extra_info pos + where + msgs = ["", err_header ++ showPos pos ++ ": error:", trimLF msg, ""] + + renderWarning :: PWarning -> [String] + renderWarning (PWarning _ pos msg) + | pos == zeroPos = msgs + | otherwise = msgs ++ extra_info pos + where + msgs = ["", err_header ++ showPos pos ++ ": warning:", trimLF msg, ""] + + -- sometimes there are (especially trailing) newlines. + trimLF :: String -> String + trimLF = dropWhile (== '\n') . reverse . dropWhile (== '\n') . reverse + +data Zipper a = Zipper [a] [a] + +listToZipper :: [a] -> Zipper a +listToZipper = Zipper [] + +advance :: Int -> Zipper a -> Zipper a +advance n z@(Zipper xs ys) + | n <= 0 = z + | otherwise = case ys of + [] -> z + (y : ys') -> advance (n - 1) $ Zipper (y : xs) ys' diff --git a/cabal-install/src/Distribution/Client/ParseUtils.hs b/cabal-install/src/Distribution/Client/ParseUtils.hs index 5d4bd8331a1..54d4c622976 100644 --- a/cabal-install/src/Distribution/Client/ParseUtils.hs +++ b/cabal-install/src/Distribution/Client/ParseUtils.hs @@ -89,9 +89,9 @@ import Distribution.FieldGrammar (parseFieldGrammar, partitionFields) import qualified Distribution.FieldGrammar as FG import qualified Distribution.Fields as F import Distribution.Fields.ParseResult (runParseResult) -import Distribution.Parsec.Error (showPError) +import Distribution.Parsec.Error (showPErrorWithSource) import Distribution.Parsec.Position (Position (..)) -import Distribution.Parsec.Warning (showPWarning) +import Distribution.Parsec.Warning (showPWarningWithSource) import Distribution.Simple.Utils (fromUTF8BS, toUTF8BS) ------------------------- @@ -321,12 +321,12 @@ parseFieldsAndSections fieldDescrs sectionDescrs fgSectionDescrs = ++ show line' case runParseResult $ parseFieldGrammar cabalSpecLatest fields2 grammar of (warnings, Right b) -> do - for_ warnings $ \w -> warning $ showPWarning "???" w + for_ warnings $ \w -> warning $ showPWarningWithSource $ w setter line param b a (warnings, Left (_, errs)) -> do - for_ warnings $ \w -> warning $ showPWarning "???" w + for_ warnings $ \w -> warning $ showPWarningWithSource $ w case errs of - err :| _errs -> fail $ showPError "???" err + err :| _errs -> fail $ showPErrorWithSource $ err Nothing -> do warning $ "Unrecognized section '" diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs index 5d2c3981c0e..32d8048b2b5 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs @@ -1,8 +1,10 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} -- | Handling project configuration. module Distribution.Client.ProjectConfig @@ -11,6 +13,7 @@ module Distribution.Client.ProjectConfig , ProjectConfigToParse (..) , ProjectConfigBuildOnly (..) , ProjectConfigShared (..) + , ProjectConfigSkeleton , ProjectConfigProvenance (..) , PackageConfig (..) , MapLast (..) @@ -40,6 +43,12 @@ module Distribution.Client.ProjectConfig , readSourcePackageCabalFile , readSourcePackageCabalFile' , CabalFileParseError (..) + , readProjectFileSkeleton + , ProjectFileParser (..) + , readProjectFileSkeletonLegacy + , readProjectFileSkeletonParsec + , readProjectFileSkeletonFallback + , readProjectFileSkeletonCompare -- * Packages within projects , ProjectPackageLocation (..) @@ -68,8 +77,10 @@ module Distribution.Client.ProjectConfig ) where import Distribution.Client.Compat.Prelude hiding (empty) +import Distribution.Parsec.Source import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose + , debug , dieWithException , maybeExit , notice @@ -86,6 +97,7 @@ import Distribution.Client.Glob ) import Distribution.Client.JobControl import Distribution.Client.ProjectConfig.Legacy +import qualified Distribution.Client.ProjectConfig.Parsec as Parsec import Distribution.Client.ProjectConfig.Types import Distribution.Client.RebuildMonad import Distribution.Client.VCS @@ -96,6 +108,7 @@ import Distribution.Client.VCS , syncSourceRepos , validateSourceRepos ) +import Distribution.Fields.ParseResult import Distribution.Client.BuildReports.Types ( ReportLevel (..) @@ -110,6 +123,7 @@ import Distribution.Client.DistDirLayout , ProjectRoot (..) , defaultProjectFile ) +import Distribution.Client.Errors.Parser import Distribution.Client.GlobalFlags ( RepoContext (..) , withRepoContext' @@ -122,7 +136,6 @@ import Distribution.Client.HttpUtils , transportCheckHttps ) import Distribution.Client.Types -import Distribution.Client.Utils.Parsec (renderParseError) import Distribution.Solver.Types.ConstraintSource import Distribution.Solver.Types.PackageConstraint @@ -154,11 +167,6 @@ import qualified Distribution.Deprecated.ProjectParseUtils as OldParser ( ProjectParseResult (..) ) import Distribution.Fields - ( PError - , PWarning - , runParseResult - , showPWarning - ) import Distribution.Package import Distribution.PackageDescription.Parsec ( parseGenericPackageDescription @@ -751,35 +759,37 @@ withProjectOrGlobalConfig' with without = do -- file if any, plus other global config. readProjectConfig :: Verbosity + -> ProjectFileParser -> HttpTransport -> Flag Bool -- ^ @--ignore-project@ -> Flag FilePath -> DistDirLayout -> Rebuild ProjectConfigSkeleton -readProjectConfig verbosity _ (Flag True) configFileFlag _ = do +readProjectConfig verbosity parserOption _ (Flag True) configFileFlag _ = do global <- singletonProjectConfigSkeleton <$> readGlobalConfig verbosity configFileFlag return (global <> singletonProjectConfigSkeleton defaultImplicitProjectConfig) -readProjectConfig verbosity httpTransport _ configFileFlag distDirLayout = do +readProjectConfig verbosity parserOption httpTransport _ configFileFlag distDirLayout = do global <- singletonProjectConfigSkeleton <$> readGlobalConfig verbosity configFileFlag - local <- readProjectLocalConfigOrDefault verbosity httpTransport distDirLayout - freeze <- readProjectLocalFreezeConfig verbosity httpTransport distDirLayout - extra <- readProjectLocalExtraConfig verbosity httpTransport distDirLayout + local <- readProjectLocalConfigOrDefault verbosity parserOption httpTransport distDirLayout + freeze <- readProjectLocalFreezeConfig verbosity parserOption httpTransport distDirLayout + extra <- readProjectLocalExtraConfig verbosity parserOption httpTransport distDirLayout return (global <> local <> freeze <> extra) -- | Reads an explicit @cabal.project@ file in the given project root dir, -- or returns the default project config for an implicitly defined project. readProjectLocalConfigOrDefault :: Verbosity + -> ProjectFileParser -> HttpTransport -> DistDirLayout -> Rebuild ProjectConfigSkeleton -readProjectLocalConfigOrDefault verbosity httpTransport distDirLayout = do +readProjectLocalConfigOrDefault verbosity parserOption httpTransport distDirLayout = do let projectFile = distProjectFile distDirLayout "" usesExplicitProjectRoot <- liftIO $ doesFileExist projectFile if usesExplicitProjectRoot then do - readProjectFileSkeleton verbosity httpTransport distDirLayout "" "project file" + readProjectFileSkeleton parserOption verbosity httpTransport distDirLayout "" "project file" else do monitorFiles [monitorNonExistentFile projectFile] return (singletonProjectConfigSkeleton defaultImplicitProjectConfig) @@ -797,11 +807,13 @@ defaultImplicitProjectConfig = -- principle can be edited manually or by other tools. readProjectLocalExtraConfig :: Verbosity + -> ProjectFileParser -> HttpTransport -> DistDirLayout -> Rebuild ProjectConfigSkeleton -readProjectLocalExtraConfig verbosity httpTransport distDirLayout = +readProjectLocalExtraConfig verbosity parserOption httpTransport distDirLayout = readProjectFileSkeleton + parserOption verbosity httpTransport distDirLayout @@ -813,11 +825,13 @@ readProjectLocalExtraConfig verbosity httpTransport distDirLayout = -- principle can be edited manually or by other tools. readProjectLocalFreezeConfig :: Verbosity + -> ProjectFileParser -> HttpTransport -> DistDirLayout -> Rebuild ProjectConfigSkeleton -readProjectLocalFreezeConfig verbosity httpTransport distDirLayout = +readProjectLocalFreezeConfig verbosity parserOption httpTransport distDirLayout = readProjectFileSkeleton + parserOption verbosity httpTransport distDirLayout @@ -825,30 +839,148 @@ readProjectLocalFreezeConfig verbosity httpTransport distDirLayout = "project freeze file" -- | Reads a named extended (with imports and conditionals) config file in the given project root dir, or returns empty. -readProjectFileSkeleton :: Verbosity -> HttpTransport -> DistDirLayout -> String -> String -> Rebuild ProjectConfigSkeleton -readProjectFileSkeleton +-- This function is generic and can be used with the legacy or parsec parser, or a combination of both. +readProjectFileSkeletonGen :: Verbosity -> HttpTransport -> DistDirLayout -> String -> String -> (FilePath -> IO ProjectConfigSkeleton) -> Rebuild ProjectConfigSkeleton +readProjectFileSkeletonGen verbosity httpTransport - DistDirLayout{distProjectFile, distDownloadSrcDirectory} + dir extensionName - extensionDescription = do - exists <- liftIO $ doesFileExist extensionFile - if exists - then do - monitorFiles [monitorFileHashed extensionFile] - pcs <- liftIO readExtensionFile - monitorFiles $ map monitorFileHashed (projectConfigPathRoot <$> projectSkeletonImports pcs) - pure pcs - else do - monitorFiles [monitorNonExistentFile extensionFile] - return mempty + extensionDescription + parseConfig = + do + exists <- liftIO $ doesFileExist extensionFile + if exists + then do + monitorFiles [monitorFileHashed extensionFile] + pcs <- liftIO $ parseConfig extensionFile + monitorFiles $ map monitorFileHashed (projectConfigPathRoot <$> projectSkeletonImports pcs) + return pcs + else do + monitorFiles [monitorNonExistentFile extensionFile] + return mempty where - extensionFile = distProjectFile extensionName + extensionFile = (distProjectFile dir) extensionName + +-- There are 3 different variants of the project parsing function. +-- 1. readProjectFileSkeletonLegacy: always uses the legacy parser +-- 2. readProjectFileSkeletonParsec: always uses the parsec parser +-- 3. readProjectFileSkeletonFallback: uses the parsec parser, but if that fails, it falls back to the legacy parser. +-- 4. readProjectFileSkeletonCompare: Run both parsers, and compare the results to check they are the same. +-- +-- +-- correspondingly there are two "pure" functions to attempt to parse a project +-- file using the "legacy" or "parsec" parser. +-- +-- 1. parseProjectFileSkeletonLegacy: parses a project file using the legacy parser +-- 2. parseProjectFileSkeletonParsec: parses a project file using the parsec parser +-- +-- Errors are handled in each case by +-- +-- 1. reportParseResult: reports legacy parse errors to the user +-- 2. reportParseResultParsec: reports parsec parse errors to the user + +readProjectFileSkeleton :: ProjectFileParser -> Verbosity -> HttpTransport -> DistDirLayout -> String -> String -> Rebuild ProjectConfigSkeleton +readProjectFileSkeleton option = + case option of + LegacyParser -> readProjectFileSkeletonLegacy + ParsecParser -> readProjectFileSkeletonParsec + FallbackParser -> readProjectFileSkeletonFallback + CompareParser -> readProjectFileSkeletonCompare + +-- | Read a project file using the legacy parser. +readProjectFileSkeletonLegacy :: Verbosity -> HttpTransport -> DistDirLayout -> String -> String -> Rebuild ProjectConfigSkeleton +readProjectFileSkeletonLegacy verbosity httpTransport distDirLayout extensionName extensionDescription = do + readProjectFileSkeletonGen verbosity httpTransport distDirLayout extensionName extensionDescription $ \fp -> do + debug verbosity $ "Reading project file using the legacy parser" + parseProjectFileSkeletonLegacy verbosity httpTransport distDirLayout extensionName extensionDescription fp + >>= liftIO . reportParseResult verbosity extensionDescription fp + +-- | Read a project file using the parsec parser, but if that fails, it falls back to the legacy parser. +readProjectFileSkeletonFallback :: Verbosity -> HttpTransport -> DistDirLayout -> String -> String -> Rebuild ProjectConfigSkeleton +readProjectFileSkeletonFallback verbosity httpTransport distDirLayout extensionName extensionDescription = do + readProjectFileSkeletonGen verbosity httpTransport distDirLayout extensionName extensionDescription $ \fp -> do + debug verbosity $ "Reading project file using the fallback parser" + (res, bs) <- parseProjectFileSkeletonParsec verbosity httpTransport distDirLayout extensionName extensionDescription fp + let (_, pres) = runParseResult res + case pres of + -- 1. Successful parse with parsec parser, handle the result as normal. + Right{} -> liftIO $ reportParseResultParsec verbosity fp bs res + -- 2. The parse failed with the parsec parser, fallback to the legacy parser. + Left{} -> do + lres <- parseProjectFileSkeletonLegacy verbosity httpTransport distDirLayout extensionName extensionDescription fp + case lres of + -- 3a. The legacy parser worked, but the parsec parser failed! + -- Report a warning to the user that this happened. + OldParser.ProjectParseOk{} -> do + warn verbosity $ "The new parsec parser failed, but the legacy parser worked. This is unexpected, please report this as a bug.\nThe legacy parser will be removed in the next major version." + liftIO $ reportParseResult verbosity extensionDescription fp lres + -- 3b. The legacy parser failed as well, report the original error. + OldParser.ProjectParseFailed{} -> do + liftIO $ reportParseResultParsec verbosity fp bs res + +-- | Read a project file using the parsec parser. +readProjectFileSkeletonParsec :: Verbosity -> HttpTransport -> DistDirLayout -> String -> String -> Rebuild ProjectConfigSkeleton +readProjectFileSkeletonParsec verbosity httpTransport distDirLayout extensionName extensionDescription = do + readProjectFileSkeletonGen verbosity httpTransport distDirLayout extensionName extensionDescription $ \fp -> do + debug verbosity $ "Reading project file using the parsec parser" + (res, bs) <- parseProjectFileSkeletonParsec verbosity httpTransport distDirLayout extensionName extensionDescription fp + liftIO $ reportParseResultParsec verbosity fp bs res + +readProjectFileSkeletonCompare :: Verbosity -> HttpTransport -> DistDirLayout -> String -> String -> Rebuild ProjectConfigSkeleton +readProjectFileSkeletonCompare verbosity httpTransport distDirLayout extensionName extensionDescription = do + readProjectFileSkeletonGen verbosity httpTransport distDirLayout extensionName extensionDescription $ \fp -> do + debug verbosity $ "Reading project file using the comparative parser" + (pres, bs) <- parseProjectFileSkeletonParsec verbosity httpTransport distDirLayout extensionName extensionDescription fp + lres <- parseProjectFileSkeletonLegacy verbosity httpTransport distDirLayout extensionName extensionDescription fp + let (_, ppres) = runParseResult pres + case (lres, ppres) of + -- 1. Both succeed, compare the results + (OldParser.ProjectParseOk lwarns lpcs, Right ppcs) -> do + unless (lpcs == ppcs) (dieWithException verbosity $ LegacyAndParsecParseResultsDiffer fp (show lpcs) (show ppcs)) + liftIO $ reportParseResultParsec verbosity fp bs pres + -- 2. The legacy parser failed, but the parsec parser succeeded. + -- Report a warning to the user that this happened. + (OldParser.ProjectParseFailed{}, Right{}) -> do + warn verbosity $ "The legacy parser failed, but the new parsec parser worked. This is unexpected, please report this as a bug.\nThe legacy parser will be removed in the next major version." + liftIO $ reportParseResult verbosity extensionDescription fp lres + -- 3. The legacy parser succeeded, but the parsec parser failed. + -- Report a warning to the user that this happened. + (OldParser.ProjectParseOk{}, Left{}) -> do + warn verbosity $ "The new parsec parser failed, but the legacy parser worked. This is unexpected, please report this as a bug.\nThe legacy parser will be removed in the next major version." + liftIO $ reportParseResult verbosity extensionDescription fp lres + (OldParser.ProjectParseFailed{}, Left{}) -> do + -- 4. Both failed, report the original error. We don't check that the same errors are reported. + liftIO $ reportParseResultParsec verbosity fp bs pres + +reportParseResultParsec + :: Verbosity + -> FilePath + -> BS.ByteString + -> Parsec.ParseResult ProjectFileSource a + -> IO a +reportParseResultParsec verbosity fpath contents pr = do + let (warnings, result) = runParseResult pr + case result of + Right x -> do + let sortKey p = (pwarningSource p, pwarningPosition (pwarning p)) + sortedWarnings = sortBy (comparing sortKey) warnings + reportProjectParseWarnings verbosity fpath (map (showPWarningWithSource . fmap renderProjectFileSource) sortedWarnings) + return x + Left (_, errors) -> do + dieWithException verbosity $ ProjectConfigParseFailure $ ProjectConfigParseError errors warnings - readExtensionFile = - reportParseResult verbosity extensionDescription extensionFile - =<< parseProject extensionFile distDownloadSrcDirectory httpTransport verbosity . ProjectConfigToParse - =<< BS.readFile extensionFile +-- | Reads a named extended (with imports and conditionals) config file in the given project root dir, or returns empty. +parseProjectFileSkeletonLegacy :: Verbosity -> HttpTransport -> DistDirLayout -> String -> String -> FilePath -> IO (OldParser.ProjectParseResult ProjectConfigSkeleton) +parseProjectFileSkeletonLegacy verbosity httpTransport distDirLayout extensionName extensionDescription extensionFile = + parseProject extensionFile (distDownloadSrcDirectory distDirLayout) httpTransport verbosity . ProjectConfigToParse + =<< BS.readFile extensionFile + +parseProjectFileSkeletonParsec :: Verbosity -> HttpTransport -> DistDirLayout -> String -> String -> FilePath -> IO (Parsec.ParseResult ProjectFileSource ProjectConfigSkeleton, BS.ByteString) +parseProjectFileSkeletonParsec verbosity httpTransport distDirLayout extensionName extensionDescription extensionFile = do + bs <- BS.readFile extensionFile + res <- Parsec.parseProject extensionFile (distDownloadSrcDirectory distDirLayout) httpTransport verbosity $ ProjectConfigToParse bs + return (res, bs) -- | Render the 'ProjectConfig' format. -- @@ -881,23 +1013,27 @@ readGlobalConfig verbosity configFileFlag = do monitorFiles [monitorFileHashed configFile] return (convertLegacyGlobalConfig config) -reportProjectParseWarnings :: Verbosity -> FilePath -> [ProjectParseWarning] -> IO () -reportProjectParseWarnings verbosity projectFile warnings = - unless (null warnings) $ - 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] - ] +reportProjectParseWarningsLegacy :: Verbosity -> FilePath -> [ProjectParseWarning] -> IO () +reportProjectParseWarningsLegacy verbosity projectFile warnings = + let msgs = + [ OldParser.showPWarning pFilename w + | (p, w) <- warnings + , let pFilename = fst $ unconsProjectConfigPath p + ] + in reportProjectParseWarnings verbosity projectFile msgs + +reportProjectParseWarnings :: Verbosity -> FilePath -> [String] -> IO () +reportProjectParseWarnings verbosity projectFile msgs = + unless (null msgs) $ + 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 + reportProjectParseWarningsLegacy verbosity projectFile warnings return x reportParseResult verbosity filetype projectFile (OldParser.ProjectParseFailed (ProjectParseError snippet rootOrImportee err)) = do let (line, msg) = OldParser.locatedErrorMsg err @@ -906,7 +1042,7 @@ reportParseResult verbosity filetype projectFile (OldParser.ProjectParseFailed ( maybe (projectFile, empty) ( \p -> - ( fst $ unconsProjectConfigPath p + ( currentProjectConfigPath p , if isTopLevelConfigPath p then empty else docProjectConfigPath p ) ) @@ -1602,43 +1738,6 @@ mkSpecificSourcePackage location pkg = , srcpkgDescrOverride = Nothing } --- | Errors reported upon failing to parse a @.cabal@ file. -data CabalFileParseError - = CabalFileParseError - FilePath - -- ^ @.cabal@ file path - BS.ByteString - -- ^ @.cabal@ file contents - (NonEmpty PError) - -- ^ errors - (Maybe Version) - -- ^ We might discover the spec version the package needs - [PWarning] - -- ^ warnings - --- | Manual instance which skips file contents -instance Show CabalFileParseError where - showsPrec d (CabalFileParseError fp _ es mv ws) = - showParen (d > 10) $ - showString "CabalFileParseError" - . showChar ' ' - . showsPrec 11 fp - . showChar ' ' - . showsPrec 11 ("" :: String) - . showChar ' ' - . showsPrec 11 es - . showChar ' ' - . showsPrec 11 mv - . showChar ' ' - . showsPrec 11 ws - -instance Exception CabalFileParseError where - displayException = renderCabalFileParseError - -renderCabalFileParseError :: CabalFileParseError -> String -renderCabalFileParseError (CabalFileParseError filePath contents errors _ warnings) = - renderParseError filePath contents errors warnings - -- | Wrapper for the @.cabal@ file parser. It reports warnings on higher -- verbosity levels and throws 'CabalFileParseError' on failure. readSourcePackageCabalFile @@ -1659,10 +1758,10 @@ readSourcePackageCabalFile' -> BS.ByteString -> IO GenericPackageDescription readSourcePackageCabalFile' logWarnings pkgfilename content = - case runParseResult (parseGenericPackageDescription content) of + case runParseResult (withSource (PCabalFile (pkgfilename, content)) $ parseGenericPackageDescription content) of (warnings, Right pkg) -> do unless (null warnings) $ - logWarnings (formatWarnings warnings) + logWarnings (formatWarnings . map (fmap renderCabalFileSource) $ warnings) return pkg (warnings, Left (mspecVersion, errors)) -> throwIO $ CabalFileParseError pkgfilename content errors mspecVersion warnings @@ -1671,7 +1770,7 @@ readSourcePackageCabalFile' logWarnings pkgfilename content = "The package description file " ++ pkgfilename ++ " has warnings: " - ++ unlines (map (showPWarning pkgfilename) warnings) + ++ unlines (map showPWarningWithSource warnings) -- | When looking for a package's @.cabal@ file we can find none, or several, -- both of which are failures. diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/FieldGrammar.hs b/cabal-install/src/Distribution/Client/ProjectConfig/FieldGrammar.hs new file mode 100644 index 00000000000..591bf0ba03d --- /dev/null +++ b/cabal-install/src/Distribution/Client/ProjectConfig/FieldGrammar.hs @@ -0,0 +1,265 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +-- | 'ProjectConfig' Field descriptions +module Distribution.Client.ProjectConfig.FieldGrammar + ( projectConfigFieldGrammar + , packageConfigFieldGrammar + ) where + +import qualified Data.ByteString.Char8 as BS +import qualified Data.Set as Set +import Distribution.CabalSpecVersion (CabalSpecVersion (..)) +import Distribution.Client.CmdInstall.ClientInstallFlags (clientInstallFlagsGrammar) +import qualified Distribution.Client.ProjectConfig.Lens as L +import Distribution.Client.ProjectConfig.Types (PackageConfig (..), ProjectConfig (..), ProjectConfigBuildOnly (..), ProjectConfigProvenance (..), ProjectConfigShared (..)) +import Distribution.Client.Utils.Parsec +import Distribution.Compat.Prelude +import Distribution.FieldGrammar +import Distribution.Simple.Flag +import Distribution.Simple.InstallDirs +import Distribution.Solver.Types.ConstraintSource (ConstraintSource (..)) +import Distribution.Solver.Types.ProjectConfigPath +import Distribution.Types.PackageVersionConstraint (PackageVersionConstraint (..)) + +projectConfigFieldGrammar :: ProjectConfigPath -> [String] -> ParsecFieldGrammar' ProjectConfig +projectConfigFieldGrammar source knownPrograms = + ProjectConfig + <$> monoidalFieldAla "packages" (alaList' FSep Token) L.projectPackages + <*> monoidalFieldAla "optional-packages" (alaList' FSep Token) L.projectPackagesOptional + <*> pure mempty -- source-repository-package stanza + <*> monoidalFieldAla "extra-packages" formatPackageVersionConstraints L.projectPackagesNamed + <*> blurFieldGrammar L.projectConfigBuildOnly projectConfigBuildOnlyFieldGrammar + <*> blurFieldGrammar L.projectConfigShared (projectConfigSharedFieldGrammar source) + <*> pure provenance + <*> pure mempty + -- \^ PackageConfig to be applied to all packages, specified inside 'package *' stanza + <*> blurFieldGrammar L.projectConfigLocalPackages (packageConfigFieldGrammar knownPrograms) + -- \^ PackageConfig to be applied to locally built packages, specified not inside a stanza + <*> pure mempty + where + -- \^ PackageConfig applied to explicitly named packages + provenance = Set.singleton (Explicit source) + +formatPackageVersionConstraints :: [PackageVersionConstraint] -> List CommaVCat (Identity PackageVersionConstraint) PackageVersionConstraint +formatPackageVersionConstraints = alaList CommaVCat + +projectConfigBuildOnlyFieldGrammar :: ParsecFieldGrammar' ProjectConfigBuildOnly +projectConfigBuildOnlyFieldGrammar = + ProjectConfigBuildOnly + <$> optionalFieldDef "verbose" L.projectConfigVerbosity mempty + <*> pure mempty -- cli flag: projectConfigDryRun + <*> pure mempty -- cli flag: projectConfigOnlyDeps + <*> pure mempty -- cli flag: projectConfigOnlyDownload + <*> monoidalFieldAla "build-summary" (alaNubList VCat) L.projectConfigSummaryFile + <*> optionalFieldDef "build-log" L.projectConfigLogFile mempty + <*> optionalFieldDef "remote-build-reporting" L.projectConfigBuildReports mempty + <*> optionalFieldDef "report-planning-failure" L.projectConfigReportPlanningFailure mempty + <*> optionalFieldDefAla "symlink-bindir" (alaFlag FilePathNT) L.projectConfigSymlinkBinDir mempty + <*> optionalFieldDefAla "jobs" (alaFlag NumJobs) L.projectConfigNumJobs mempty + <*> optionalFieldDef "semaphore" L.projectConfigUseSemaphore mempty + <*> optionalFieldDef "keep-going" L.projectConfigKeepGoing mempty + <*> optionalFieldDef "offline" L.projectConfigOfflineMode mempty + <*> optionalFieldDef "haddock-keep-temp-files" L.projectConfigKeepTempFiles mempty + <*> optionalFieldDefAla "http-transport" (alaFlag Token) L.projectConfigHttpTransport mempty + <*> optionalFieldDef "ignore-expiry" L.projectConfigIgnoreExpiry mempty + <*> optionalFieldDefAla "remote-repo-cache" (alaFlag FilePathNT) L.projectConfigCacheDir mempty + <*> optionalFieldDefAla "logs-dir" (alaFlag FilePathNT) L.projectConfigLogsDir mempty + <*> blurFieldGrammar L.projectConfigClientInstallFlags clientInstallFlagsGrammar + +projectConfigSharedFieldGrammar :: ProjectConfigPath -> ParsecFieldGrammar' ProjectConfigShared +projectConfigSharedFieldGrammar source = + ProjectConfigShared + <$> optionalFieldDefAla "builddir" (alaFlag FilePathNT) L.projectConfigDistDir mempty + <*> pure mempty -- cli flag: projectConfigConfigFile + <*> optionalFieldDefAla "project-dir" (alaFlag FilePathNT) L.projectConfigProjectDir mempty + <*> optionalFieldDefAla "project-file" (alaFlag FilePathNT) L.projectConfigProjectFile mempty + <*> pure mempty -- You can't set the parser type in the project file. + <*> optionalFieldDef "ignore-project" L.projectConfigIgnoreProject mempty + <*> optionalFieldDef "compiler" L.projectConfigHcFlavor mempty + <*> optionalFieldDefAla "with-compiler" (alaFlag FilePathNT) L.projectConfigHcPath mempty + <*> optionalFieldDefAla "with-hc-pkg" (alaFlag FilePathNT) L.projectConfigHcPkg mempty + <*> optionalFieldDef "doc-index-file" L.projectConfigHaddockIndex mempty + <*> blurFieldGrammar L.projectConfigInstallDirs installDirsGrammar + <*> monoidalFieldAla "package-dbs" (alaList' CommaFSep PackageDBNT) L.projectConfigPackageDBs + <*> pure mempty -- repository stanza for projectConfigRemoteRepos + <*> pure mempty -- repository stanza for projectConfigLocalNoIndexRepos + <*> monoidalField "active-repositories" L.projectConfigActiveRepos + <*> monoidalField "index-state" L.projectConfigIndexState + <*> optionalFieldDefAla "store-dir" (alaFlag FilePathNT) L.projectConfigStoreDir mempty + <*> monoidalFieldAla "constraints" (alaList' FSep ProjectConstraints) L.projectConfigConstraints + ^^^ (fmap . fmap) (\(userConstraint, _) -> (userConstraint, ConstraintSourceProjectConfig source)) + <*> monoidalFieldAla "preferences" formatPackageVersionConstraints L.projectConfigPreferences + <*> optionalFieldDef "cabal-lib-version" L.projectConfigCabalVersion mempty + <*> optionalFieldDef "solver" L.projectConfigSolver mempty + <*> monoidalFieldAla "allow-older" AllowOlderNT L.projectConfigAllowOlder + <*> monoidalFieldAla "allow-newer" AllowNewerNT L.projectConfigAllowNewer + <*> optionalFieldDef "write-ghc-environment-files" L.projectConfigWriteGhcEnvironmentFilesPolicy mempty + <*> optionalFieldDefAla "max-backjumps" (alaFlag MaxBackjumps) L.projectConfigMaxBackjumps mempty + <*> optionalFieldDef "reorder-goals" L.projectConfigReorderGoals mempty + <*> optionalFieldDef "count-conflicts" L.projectConfigCountConflicts mempty + <*> optionalFieldDef "fine-grained-conflicts" L.projectConfigFineGrainedConflicts mempty + <*> optionalFieldDef "minimize-conflict-set" L.projectConfigMinimizeConflictSet mempty + <*> optionalFieldDef "strong-flags" L.projectConfigStrongFlags mempty + <*> optionalFieldDef "allow-boot-library-installs" L.projectConfigAllowBootLibInstalls mempty + <*> optionalFieldDef "reject-unconstrained-dependencies" L.projectConfigOnlyConstrained mempty + <*> optionalFieldDef "per-component" L.projectConfigPerComponent mempty + <*> optionalFieldDef "independent-goals" L.projectConfigIndependentGoals mempty + <*> optionalFieldDef "prefer-oldest" L.projectConfigPreferOldest mempty + <*> monoidalFieldAla "extra-prog-path-shared-only" (alaNubList' FSep FilePathNT) L.projectConfigProgPathExtra + <*> optionalFieldDef "multi-repl" L.projectConfigMultiRepl mempty + +packageConfigFieldGrammar :: [String] -> ParsecFieldGrammar' PackageConfig +packageConfigFieldGrammar knownPrograms = + mkPackageConfig + <$> optionalFieldDef "haddock-all" noopLens mempty + ^^^ hiddenField + <*> pure mempty -- program-options stanza + <*> pure mempty -- program-locations stanza + <*> monoidalFieldAla "extra-prog-path" (alaNubList' FSep FilePathNT) L.packageConfigProgramPathExtra + <*> monoidalField "flags" L.packageConfigFlagAssignment + <*> optionalFieldDef "library-vanilla" L.packageConfigVanillaLib mempty + <*> optionalFieldDef "shared" L.packageConfigSharedLib mempty + <*> optionalFieldDef "static" L.packageConfigStaticLib mempty + <*> optionalFieldDef "executable-dynamic" L.packageConfigDynExe mempty + <*> optionalFieldDef "executable-static" L.packageConfigFullyStaticExe mempty + <*> optionalFieldDef "profiling" L.packageConfigProf mempty + <*> optionalFieldDef "library-profiling" L.packageConfigProfLib mempty + <*> optionalFieldDef "profiling-shared" L.packageConfigProfShared mempty + <*> optionalFieldDef "executable-profiling" L.packageConfigProfExe mempty + <*> optionalFieldDef "profiling-detail" L.packageConfigProfDetail mempty + <*> optionalFieldDef "library-profiling-detail" L.packageConfigProfLibDetail mempty + <*> monoidalFieldAla "configure-options" (alaList' NoCommaFSep Token) L.packageConfigConfigureArgs + <*> optionalFieldDef "optimization" L.packageConfigOptimization mempty + <*> optionalFieldDef "program-prefix" L.packageConfigProgPrefix mempty + <*> optionalFieldDef "program-suffix" L.packageConfigProgSuffix mempty + <*> monoidalFieldAla "extra-lib-dirs" (alaList' FSep FilePathNT) L.packageConfigExtraLibDirs + <*> monoidalFieldAla "extra-lib-dirs-static" (alaList' FSep FilePathNT) L.packageConfigExtraLibDirsStatic + <*> monoidalFieldAla "extra-framework-dirs" (alaList' FSep FilePathNT) L.packageConfigExtraFrameworkDirs + <*> monoidalFieldAla "extra-include-dirs" (alaList' FSep FilePathNT) L.packageConfigExtraIncludeDirs + <*> optionalFieldDef "library-for-ghci" L.packageConfigGHCiLib mempty + <*> optionalFieldDef "split-sections" L.packageConfigSplitSections mempty + <*> optionalFieldDef "split-objs" L.packageConfigSplitObjs mempty + <*> optionalFieldDef "executable-stripping" L.packageConfigStripExes mempty + <*> optionalFieldDef "library-stripping" L.packageConfigStripLibs mempty + <*> optionalFieldDef "tests" L.packageConfigTests mempty + <*> optionalFieldDef "benchmarks" L.packageConfigBenchmarks mempty + <*> packageConfigCoverageGrammar + <*> optionalFieldDef "relocatable" L.packageConfigRelocatable mempty + <*> optionalFieldDef "debug-info" L.packageConfigDebugInfo mempty + <*> optionalFieldDef "build-info" L.packageConfigDumpBuildInfo mempty + <*> optionalFieldDef "run-tests" L.packageConfigRunTests mempty + <*> optionalFieldDef "documentation" L.packageConfigDocumentation mempty + <*> optionalFieldDef "haddock-hoogle" L.packageConfigHaddockHoogle mempty + <*> optionalFieldDef "haddock-html" L.packageConfigHaddockHtml mempty + <*> optionalFieldDefAla "haddock-html-location" (alaFlag Token) L.packageConfigHaddockHtmlLocation mempty + <*> optionalFieldDef "haddock-foreign-libraries" L.packageConfigHaddockForeignLibs mempty + <*> optionalFieldDef "haddock-executables" L.packageConfigHaddockExecutables mempty + <*> optionalFieldDef "haddock-tests" L.packageConfigHaddockTestSuites mempty + <*> optionalFieldDef "haddock-benchmarks" L.packageConfigHaddockBenchmarks mempty + <*> optionalFieldDef "haddock-internal" L.packageConfigHaddockInternal mempty + <*> optionalFieldDefAla "haddock-css" (alaFlag FilePathNT) L.packageConfigHaddockCss mempty + <*> optionalFieldDef "haddock-hyperlink-source" L.packageConfigHaddockLinkedSource mempty + <*> optionalFieldDef "haddock-quickjump" L.packageConfigHaddockQuickJump mempty + <*> optionalFieldDefAla "haddock-hscolour-css" (alaFlag FilePathNT) L.packageConfigHaddockHscolourCss mempty + <*> optionalFieldDef "haddock-contents-location" L.packageConfigHaddockContents mempty + <*> optionalFieldDef "haddock-index-location" L.packageConfigHaddockIndex mempty + <*> optionalFieldDefAla "haddock-base-url" (alaFlag Token) L.packageConfigHaddockBaseUrl mempty + <*> optionalFieldDefAla "haddock-resources-dir" (alaFlag Token) L.packageConfigHaddockResourcesDir mempty + <*> optionalFieldDefAla "haddock-output-dir" (alaFlag FilePathNT) L.packageConfigHaddockOutputDir mempty + <*> optionalFieldDef "haddock-use-unicode" L.packageConfigHaddockUseUnicode mempty + <*> optionalFieldDef "haddock-for-hackage" L.packageConfigHaddockForHackage mempty + <*> optionalFieldDef "test-log" L.packageConfigTestHumanLog mempty + <*> optionalFieldDef "test-machine-log" L.packageConfigTestMachineLog mempty + <*> optionalFieldDef "test-show-details" L.packageConfigTestShowDetails mempty + <*> optionalFieldDef "test-keep-tix-files" L.packageConfigTestKeepTix mempty + <*> optionalFieldDefAla "test-wrapper" (alaFlag FilePathNT) L.packageConfigTestWrapper mempty + <*> optionalFieldDef "test-fail-when-no-test-suites" L.packageConfigTestFailWhenNoTestSuites mempty + <*> monoidalFieldAla "test-options" (alaList NoCommaFSep) L.packageConfigTestTestOptions + <*> monoidalFieldAla "benchmark-options" (alaList NoCommaFSep) L.packageConfigBenchmarkOptions + -- A PackageConfig may contain -options and -location fields inside a package * (projectConfigAllPackages) or package stanza (packageConfigSpecificPackage). + -- When declared at top level (packageConfigLocalPackages), the PackageConfig must contain a program-options stanza/program-locations for these fields. + <* traverse_ (knownField . BS.pack . (<> "-options")) knownPrograms + <* traverse_ (knownField . BS.pack . (<> "-location")) knownPrograms + where + noopLens f s = s <$ f mempty + mkPackageConfig + haddockAll + packageConfigProgramPaths + packageConfigProgramArgs + packageConfigProgramPathExtra + packageConfigFlagAssignment + packageConfigVanillaLib + packageConfigSharedLib + packageConfigStaticLib + packageConfigDynExe + packageConfigFullyStaticExe + packageConfigProf + packageConfigProfLib + packageConfigProfShared + packageConfigProfExe + packageConfigProfDetail + packageConfigProfLibDetail + packageConfigConfigureArgs + packageConfigOptimization + packageConfigProgPrefix + packageConfigProgSuffix + packageConfigExtraLibDirs + packageConfigExtraLibDirsStatic + packageConfigExtraFrameworkDirs + packageConfigExtraIncludeDirs + packageConfigGHCiLib + packageConfigSplitSections + packageConfigSplitObjs + packageConfigStripExes + packageConfigStripLibs + packageConfigTests + packageConfigBenchmarks + packageConfigCoverage + packageConfigRelocatable + packageConfigDebugInfo + packageConfigDumpBuildInfo + packageConfigRunTests + packageConfigDocumentation + packageConfigHaddockHoogle + packageConfigHaddockHtml + packageConfigHaddockHtmlLocation + packageConfigHaddockForeignLibs' + packageConfigHaddockExecutables' + packageConfigHaddockTestSuites' + packageConfigHaddockBenchmarks' + packageConfigHaddockInternal + packageConfigHaddockCss + packageConfigHaddockLinkedSource + packageConfigHaddockQuickJump + packageConfigHaddockHscolourCss + packageConfigHaddockContents + packageConfigHaddockIndex + packageConfigHaddockBaseUrl + packageConfigHaddockResourcesDir + packageConfigHaddockOutputDir + packageConfigHaddockUseUnicode + packageConfigHaddockForHackage + packageConfigTestHumanLog + packageConfigTestMachineLog + packageConfigTestShowDetails + packageConfigTestKeepTix + packageConfigTestWrapper + packageConfigTestFailWhenNoTestSuites + packageConfigTestTestOptions + packageConfigBenchmarkOptions = + PackageConfig + { -- The haddock-al` field provides a default value, but explicit declarations can override it + packageConfigHaddockForeignLibs = haddockAll <> packageConfigHaddockForeignLibs' + , packageConfigHaddockExecutables = haddockAll <> packageConfigHaddockExecutables' + , packageConfigHaddockTestSuites = haddockAll <> packageConfigHaddockTestSuites' + , packageConfigHaddockBenchmarks = haddockAll <> packageConfigHaddockBenchmarks' + , .. + } + +packageConfigCoverageGrammar :: ParsecFieldGrammar PackageConfig (Distribution.Simple.Flag.Flag Bool) +packageConfigCoverageGrammar = + (<>) + <$> optionalFieldDef "coverage" L.packageConfigCoverage mempty + <*> optionalFieldDef "library-coverage" L.packageConfigCoverage mempty + ^^^ deprecatedSince CabalSpecV1_22 "Please use 'coverage' field instead." diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs index 2e24a493d0e..32b3670b479 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs @@ -771,6 +771,7 @@ convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags { flagProjectDir = projectConfigProjectDir , flagProjectFile = projectConfigProjectFile , flagIgnoreProject = projectConfigIgnoreProject + , flagProjectFileParser = projectConfigProjectFileParser } = projectFlags -- | Helper used by other conversion functions that returns the @@ -1070,6 +1071,7 @@ convertToLegacySharedConfig { flagProjectDir = projectConfigProjectDir , flagProjectFile = projectConfigProjectFile , flagIgnoreProject = projectConfigIgnoreProject + , flagProjectFileParser = projectConfigProjectFileParser } convertToLegacyAllPackageConfig :: ProjectConfig -> LegacyPackageConfig diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs new file mode 100644 index 00000000000..03e05835cd6 --- /dev/null +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs @@ -0,0 +1,557 @@ +module Distribution.Client.ProjectConfig.Lens where + +import Distribution.Client.BuildReports.Types (ReportLevel (..)) +import Distribution.Client.CmdInstall.ClientInstallFlags (ClientInstallFlags (..)) +import Distribution.Client.Dependency.Types (PreSolver (..)) +import Distribution.Client.IndexUtils.ActiveRepos + ( ActiveRepos + ) +import Distribution.Client.IndexUtils.IndexState (TotalIndexState) +import Distribution.Client.ProjectConfig.Types (MapLast, MapMappend, PackageConfig, ProjectConfig (..), ProjectConfigBuildOnly (..), ProjectConfigProvenance, ProjectConfigShared) +import qualified Distribution.Client.ProjectConfig.Types as T +import Distribution.Client.Targets (UserConstraint) +import Distribution.Client.Types.AllowNewer (AllowNewer, AllowOlder) +import Distribution.Client.Types.Repo (LocalRepo, RemoteRepo) +import Distribution.Client.Types.SourceRepo (SourceRepoList) +import Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy (WriteGhcEnvironmentFilesPolicy) +import Distribution.Compat.Lens +import Distribution.Compat.Prelude +import Distribution.Compiler (CompilerFlavor (..)) +import Distribution.Package + ( PackageName + ) +import Distribution.PackageDescription + ( FlagAssignment + ) +import Distribution.Simple.Compiler + ( DebugInfoLevel (..) + , OptimisationLevel (..) + , PackageDBCWD + , ProfDetailLevel + ) +import Distribution.Simple.InstallDirs + ( InstallDirs + , PathTemplate + ) +import Distribution.Simple.Setup + ( DumpBuildInfo (..) + , Flag + , HaddockTarget (..) + , TestShowDetails (..) + ) +import Distribution.Solver.Types.ConstraintSource (ConstraintSource) +import Distribution.Solver.Types.Settings + ( AllowBootLibInstalls (..) + , CountConflicts (..) + , FineGrainedConflicts (..) + , IndependentGoals (..) + , MinimizeConflictSet (..) + , OnlyConstrained (..) + , PreferOldest (..) + , ReorderGoals (..) + , StrongFlags (..) + ) +import Distribution.Types.PackageVersionConstraint + ( PackageVersionConstraint + ) +import Distribution.Types.Version (Version) +import Distribution.Utils.NubList + ( NubList + ) +import Distribution.Verbosity + +projectPackages :: Lens' ProjectConfig [String] +projectPackages f s = fmap (\x -> s{T.projectPackages = x}) (f (T.projectPackages s)) +{-# INLINEABLE projectPackages #-} + +projectPackagesOptional :: Lens' ProjectConfig [String] +projectPackagesOptional f s = fmap (\x -> s{T.projectPackagesOptional = x}) (f (T.projectPackagesOptional s)) +{-# INLINEABLE projectPackagesOptional #-} + +projectPackagesRepo :: Lens' ProjectConfig [SourceRepoList] +projectPackagesRepo f s = fmap (\x -> s{T.projectPackagesRepo = x}) (f (T.projectPackagesRepo s)) +{-# INLINEABLE projectPackagesRepo #-} + +projectPackagesNamed :: Lens' ProjectConfig [PackageVersionConstraint] +projectPackagesNamed f s = fmap (\x -> s{T.projectPackagesNamed = x}) (f (T.projectPackagesNamed s)) +{-# INLINEABLE projectPackagesNamed #-} + +projectConfigBuildOnly :: Lens' ProjectConfig ProjectConfigBuildOnly +projectConfigBuildOnly f s = fmap (\x -> s{T.projectConfigBuildOnly = x}) (f (T.projectConfigBuildOnly s)) +{-# INLINEABLE projectConfigBuildOnly #-} + +projectConfigShared :: Lens' ProjectConfig ProjectConfigShared +projectConfigShared f s = fmap (\x -> s{T.projectConfigShared = x}) (f (T.projectConfigShared s)) +{-# INLINEABLE projectConfigShared #-} + +projectConfigProvenance :: Lens' ProjectConfig (Set ProjectConfigProvenance) +projectConfigProvenance f s = fmap (\x -> s{T.projectConfigProvenance = x}) (f (T.projectConfigProvenance s)) +{-# INLINEABLE projectConfigProvenance #-} + +projectConfigAllPackages :: Lens' ProjectConfig PackageConfig +projectConfigAllPackages f s = fmap (\x -> s{T.projectConfigAllPackages = x}) (f (T.projectConfigAllPackages s)) +{-# INLINEABLE projectConfigAllPackages #-} + +projectConfigLocalPackages :: Lens' ProjectConfig PackageConfig +projectConfigLocalPackages f s = fmap (\x -> s{T.projectConfigLocalPackages = x}) (f (T.projectConfigLocalPackages s)) +{-# INLINEABLE projectConfigLocalPackages #-} + +projectConfigSpecificPackage :: Lens' ProjectConfig (MapMappend PackageName PackageConfig) +projectConfigSpecificPackage f s = fmap (\x -> s{T.projectConfigSpecificPackage = x}) (f (T.projectConfigSpecificPackage s)) +{-# INLINEABLE projectConfigSpecificPackage #-} + +projectConfigVerbosity :: Lens' ProjectConfigBuildOnly (Flag Verbosity) +projectConfigVerbosity f s = fmap (\x -> s{T.projectConfigVerbosity = x}) (f (T.projectConfigVerbosity s)) +{-# INLINEABLE projectConfigVerbosity #-} + +projectConfigSummaryFile :: Lens' ProjectConfigBuildOnly (NubList PathTemplate) +projectConfigSummaryFile f s = fmap (\x -> s{T.projectConfigSummaryFile = x}) (f (T.projectConfigSummaryFile s)) +{-# INLINEABLE projectConfigSummaryFile #-} + +projectConfigLogFile :: Lens' ProjectConfigBuildOnly (Flag PathTemplate) +projectConfigLogFile f s = fmap (\x -> s{T.projectConfigLogFile = x}) (f (T.projectConfigLogFile s)) +{-# INLINEABLE projectConfigLogFile #-} + +projectConfigBuildReports :: Lens' ProjectConfigBuildOnly (Flag ReportLevel) +projectConfigBuildReports f s = fmap (\x -> s{T.projectConfigBuildReports = x}) (f (T.projectConfigBuildReports s)) +{-# INLINEABLE projectConfigBuildReports #-} + +projectConfigReportPlanningFailure :: Lens' ProjectConfigBuildOnly (Flag Bool) +projectConfigReportPlanningFailure f s = fmap (\x -> s{T.projectConfigReportPlanningFailure = x}) (f (T.projectConfigReportPlanningFailure s)) +{-# INLINEABLE projectConfigReportPlanningFailure #-} + +projectConfigSymlinkBinDir :: Lens' ProjectConfigBuildOnly (Flag FilePath) +projectConfigSymlinkBinDir f s = fmap (\x -> s{T.projectConfigSymlinkBinDir = x}) (f (T.projectConfigSymlinkBinDir s)) +{-# INLINEABLE projectConfigSymlinkBinDir #-} + +projectConfigNumJobs :: Lens' ProjectConfigBuildOnly (Flag (Maybe Int)) +projectConfigNumJobs f s = fmap (\x -> s{T.projectConfigNumJobs = x}) (f (T.projectConfigNumJobs s)) +{-# INLINEABLE projectConfigNumJobs #-} + +projectConfigUseSemaphore :: Lens' ProjectConfigBuildOnly (Flag Bool) +projectConfigUseSemaphore f s = fmap (\x -> s{T.projectConfigUseSemaphore = x}) (f (T.projectConfigUseSemaphore s)) +{-# INLINEABLE projectConfigUseSemaphore #-} + +projectConfigKeepGoing :: Lens' ProjectConfigBuildOnly (Flag Bool) +projectConfigKeepGoing f s = fmap (\x -> s{T.projectConfigKeepGoing = x}) (f (T.projectConfigKeepGoing s)) +{-# INLINEABLE projectConfigKeepGoing #-} + +projectConfigOfflineMode :: Lens' ProjectConfigBuildOnly (Flag Bool) +projectConfigOfflineMode f s = fmap (\x -> s{T.projectConfigOfflineMode = x}) (f (T.projectConfigOfflineMode s)) +{-# INLINEABLE projectConfigOfflineMode #-} + +projectConfigKeepTempFiles :: Lens' ProjectConfigBuildOnly (Flag Bool) +projectConfigKeepTempFiles f s = fmap (\x -> s{T.projectConfigKeepTempFiles = x}) (f (T.projectConfigKeepTempFiles s)) +{-# INLINEABLE projectConfigKeepTempFiles #-} + +projectConfigHttpTransport :: Lens' ProjectConfigBuildOnly (Flag String) +projectConfigHttpTransport f s = fmap (\x -> s{T.projectConfigHttpTransport = x}) (f (T.projectConfigHttpTransport s)) +{-# INLINEABLE projectConfigHttpTransport #-} + +projectConfigIgnoreExpiry :: Lens' ProjectConfigBuildOnly (Flag Bool) +projectConfigIgnoreExpiry f s = fmap (\x -> s{T.projectConfigIgnoreExpiry = x}) (f (T.projectConfigIgnoreExpiry s)) +{-# INLINEABLE projectConfigIgnoreExpiry #-} + +projectConfigCacheDir :: Lens' ProjectConfigBuildOnly (Flag FilePath) +projectConfigCacheDir f s = fmap (\x -> s{T.projectConfigCacheDir = x}) (f (T.projectConfigCacheDir s)) +{-# INLINEABLE projectConfigCacheDir #-} + +projectConfigLogsDir :: Lens' ProjectConfigBuildOnly (Flag FilePath) +projectConfigLogsDir f s = fmap (\x -> s{T.projectConfigLogsDir = x}) (f (T.projectConfigLogsDir s)) +{-# INLINEABLE projectConfigLogsDir #-} + +projectConfigClientInstallFlags :: Lens' ProjectConfigBuildOnly (ClientInstallFlags) +projectConfigClientInstallFlags f s = fmap (\x -> s{T.projectConfigClientInstallFlags = x}) (f (T.projectConfigClientInstallFlags s)) +{-# INLINEABLE projectConfigClientInstallFlags #-} + +projectConfigDistDir :: Lens' ProjectConfigShared (Flag FilePath) +projectConfigDistDir f s = fmap (\x -> s{T.projectConfigDistDir = x}) (f (T.projectConfigDistDir s)) +{-# INLINEABLE projectConfigDistDir #-} + +projectConfigProjectDir :: Lens' ProjectConfigShared (Flag FilePath) +projectConfigProjectDir f s = fmap (\x -> s{T.projectConfigProjectDir = x}) (f (T.projectConfigProjectDir s)) +{-# INLINEABLE projectConfigProjectDir #-} + +projectConfigStoreDir :: Lens' ProjectConfigShared (Flag FilePath) +projectConfigStoreDir f s = fmap (\x -> s{T.projectConfigStoreDir = x}) (f (T.projectConfigStoreDir s)) +{-# INLINEABLE projectConfigStoreDir #-} + +projectConfigPerComponent :: Lens' ProjectConfigShared (Flag Bool) +projectConfigPerComponent f s = fmap (\x -> s{T.projectConfigPerComponent = x}) (f (T.projectConfigPerComponent s)) +{-# INLINEABLE projectConfigPerComponent #-} + +projectConfigIndependentGoals :: Lens' ProjectConfigShared (Flag IndependentGoals) +projectConfigIndependentGoals f s = fmap (\x -> s{T.projectConfigIndependentGoals = x}) (f (T.projectConfigIndependentGoals s)) +{-# INLINEABLE projectConfigIndependentGoals #-} + +projectConfigProjectFile :: Lens' ProjectConfigShared (Flag FilePath) +projectConfigProjectFile f s = fmap (\x -> s{T.projectConfigProjectFile = x}) (f (T.projectConfigProjectFile s)) +{-# INLINEABLE projectConfigProjectFile #-} + +projectConfigIgnoreProject :: Lens' ProjectConfigShared (Flag Bool) +projectConfigIgnoreProject f s = fmap (\x -> s{T.projectConfigIgnoreProject = x}) (f (T.projectConfigIgnoreProject s)) +{-# INLINEABLE projectConfigIgnoreProject #-} + +projectConfigHcFlavor :: Lens' ProjectConfigShared (Flag CompilerFlavor) +projectConfigHcFlavor f s = fmap (\x -> s{T.projectConfigHcFlavor = x}) (f (T.projectConfigHcFlavor s)) +{-# INLINEABLE projectConfigHcFlavor #-} + +projectConfigHcPath :: Lens' ProjectConfigShared (Flag FilePath) +projectConfigHcPath f s = fmap (\x -> s{T.projectConfigHcPath = x}) (f (T.projectConfigHcPath s)) +{-# INLINEABLE projectConfigHcPath #-} + +projectConfigHcPkg :: Lens' ProjectConfigShared (Flag FilePath) +projectConfigHcPkg f s = fmap (\x -> s{T.projectConfigHcPkg = x}) (f (T.projectConfigHcPkg s)) +{-# INLINEABLE projectConfigHcPkg #-} + +projectConfigHaddockIndex :: Lens' ProjectConfigShared (Flag PathTemplate) +projectConfigHaddockIndex f s = fmap (\x -> s{T.projectConfigHaddockIndex = x}) (f (T.projectConfigHaddockIndex s)) +{-# INLINEABLE projectConfigHaddockIndex #-} + +projectConfigInstallDirs :: Lens' ProjectConfigShared (InstallDirs (Flag PathTemplate)) +projectConfigInstallDirs f s = fmap (\x -> s{T.projectConfigInstallDirs = x}) (f (T.projectConfigInstallDirs s)) +{-# INLINEABLE projectConfigInstallDirs #-} + +projectConfigPackageDBs :: Lens' ProjectConfigShared [Maybe PackageDBCWD] +projectConfigPackageDBs f s = fmap (\x -> s{T.projectConfigPackageDBs = x}) (f (T.projectConfigPackageDBs s)) +{-# INLINEABLE projectConfigPackageDBs #-} + +projectConfigLocalNoIndexRepos :: Lens' ProjectConfigShared (NubList LocalRepo) +projectConfigLocalNoIndexRepos f s = fmap (\x -> s{T.projectConfigLocalNoIndexRepos = x}) (f (T.projectConfigLocalNoIndexRepos s)) +{-# INLINEABLE projectConfigLocalNoIndexRepos #-} + +projectConfigRemoteRepos :: Lens' ProjectConfigShared (NubList RemoteRepo) +projectConfigRemoteRepos f s = fmap (\x -> s{T.projectConfigRemoteRepos = x}) (f (T.projectConfigRemoteRepos s)) +{-# INLINEABLE projectConfigRemoteRepos #-} + +projectConfigActiveRepos :: Lens' ProjectConfigShared (Flag ActiveRepos) +projectConfigActiveRepos f s = fmap (\x -> s{T.projectConfigActiveRepos = x}) (f (T.projectConfigActiveRepos s)) +{-# INLINEABLE projectConfigActiveRepos #-} + +projectConfigIndexState :: Lens' ProjectConfigShared (Flag TotalIndexState) +projectConfigIndexState f s = fmap (\x -> s{T.projectConfigIndexState = x}) (f (T.projectConfigIndexState s)) +{-# INLINEABLE projectConfigIndexState #-} + +projectConfigConstraints :: Lens' ProjectConfigShared [(UserConstraint, ConstraintSource)] +projectConfigConstraints f s = fmap (\x -> s{T.projectConfigConstraints = x}) (f (T.projectConfigConstraints s)) +{-# INLINEABLE projectConfigConstraints #-} + +projectConfigPreferences :: Lens' ProjectConfigShared [PackageVersionConstraint] +projectConfigPreferences f s = fmap (\x -> s{T.projectConfigPreferences = x}) (f (T.projectConfigPreferences s)) +{-# INLINEABLE projectConfigPreferences #-} + +projectConfigCabalVersion :: Lens' ProjectConfigShared (Flag Version) +projectConfigCabalVersion f s = fmap (\x -> s{T.projectConfigCabalVersion = x}) (f (T.projectConfigCabalVersion s)) +{-# INLINEABLE projectConfigCabalVersion #-} + +projectConfigSolver :: Lens' ProjectConfigShared (Flag PreSolver) +projectConfigSolver f s = fmap (\x -> s{T.projectConfigSolver = x}) (f (T.projectConfigSolver s)) +{-# INLINEABLE projectConfigSolver #-} + +projectConfigAllowOlder :: Lens' ProjectConfigShared (Maybe AllowOlder) +projectConfigAllowOlder f s = fmap (\x -> s{T.projectConfigAllowOlder = x}) (f (T.projectConfigAllowOlder s)) +{-# INLINEABLE projectConfigAllowOlder #-} + +projectConfigAllowNewer :: Lens' ProjectConfigShared (Maybe AllowNewer) +projectConfigAllowNewer f s = fmap (\x -> s{T.projectConfigAllowNewer = x}) (f (T.projectConfigAllowNewer s)) +{-# INLINEABLE projectConfigAllowNewer #-} + +projectConfigWriteGhcEnvironmentFilesPolicy :: Lens' ProjectConfigShared (Flag WriteGhcEnvironmentFilesPolicy) +projectConfigWriteGhcEnvironmentFilesPolicy f s = fmap (\x -> s{T.projectConfigWriteGhcEnvironmentFilesPolicy = x}) (f (T.projectConfigWriteGhcEnvironmentFilesPolicy s)) +{-# INLINEABLE projectConfigWriteGhcEnvironmentFilesPolicy #-} + +projectConfigMaxBackjumps :: Lens' ProjectConfigShared (Flag Int) +projectConfigMaxBackjumps f s = fmap (\x -> s{T.projectConfigMaxBackjumps = x}) (f (T.projectConfigMaxBackjumps s)) +{-# INLINEABLE projectConfigMaxBackjumps #-} + +projectConfigReorderGoals :: Lens' ProjectConfigShared (Flag ReorderGoals) +projectConfigReorderGoals f s = fmap (\x -> s{T.projectConfigReorderGoals = x}) (f (T.projectConfigReorderGoals s)) +{-# INLINEABLE projectConfigReorderGoals #-} + +projectConfigCountConflicts :: Lens' ProjectConfigShared (Flag CountConflicts) +projectConfigCountConflicts f s = fmap (\x -> s{T.projectConfigCountConflicts = x}) (f (T.projectConfigCountConflicts s)) +{-# INLINEABLE projectConfigCountConflicts #-} + +projectConfigFineGrainedConflicts :: Lens' ProjectConfigShared (Flag FineGrainedConflicts) +projectConfigFineGrainedConflicts f s = fmap (\x -> s{T.projectConfigFineGrainedConflicts = x}) (f (T.projectConfigFineGrainedConflicts s)) +{-# INLINEABLE projectConfigFineGrainedConflicts #-} + +projectConfigMinimizeConflictSet :: Lens' ProjectConfigShared (Flag MinimizeConflictSet) +projectConfigMinimizeConflictSet f s = fmap (\x -> s{T.projectConfigMinimizeConflictSet = x}) (f (T.projectConfigMinimizeConflictSet s)) +{-# INLINEABLE projectConfigMinimizeConflictSet #-} + +projectConfigStrongFlags :: Lens' ProjectConfigShared (Flag StrongFlags) +projectConfigStrongFlags f s = fmap (\x -> s{T.projectConfigStrongFlags = x}) (f (T.projectConfigStrongFlags s)) +{-# INLINEABLE projectConfigStrongFlags #-} + +projectConfigAllowBootLibInstalls :: Lens' ProjectConfigShared (Flag AllowBootLibInstalls) +projectConfigAllowBootLibInstalls f s = fmap (\x -> s{T.projectConfigAllowBootLibInstalls = x}) (f (T.projectConfigAllowBootLibInstalls s)) +{-# INLINEABLE projectConfigAllowBootLibInstalls #-} + +projectConfigOnlyConstrained :: Lens' ProjectConfigShared (Flag OnlyConstrained) +projectConfigOnlyConstrained f s = fmap (\x -> s{T.projectConfigOnlyConstrained = x}) (f (T.projectConfigOnlyConstrained s)) +{-# INLINEABLE projectConfigOnlyConstrained #-} + +projectConfigPreferOldest :: Lens' ProjectConfigShared (Flag PreferOldest) +projectConfigPreferOldest f s = fmap (\x -> s{T.projectConfigPreferOldest = x}) (f (T.projectConfigPreferOldest s)) +{-# INLINEABLE projectConfigPreferOldest #-} + +projectConfigProgPathExtra :: Lens' ProjectConfigShared (NubList FilePath) +projectConfigProgPathExtra f s = fmap (\x -> s{T.projectConfigProgPathExtra = x}) (f (T.projectConfigProgPathExtra s)) +{-# INLINEABLE projectConfigProgPathExtra #-} + +projectConfigMultiRepl :: Lens' ProjectConfigShared (Flag Bool) +projectConfigMultiRepl f s = fmap (\x -> s{T.projectConfigMultiRepl = x}) (f (T.projectConfigMultiRepl s)) +{-# INLINEABLE projectConfigMultiRepl #-} + +packageConfigProgramPaths :: Lens' PackageConfig (MapLast String FilePath) +packageConfigProgramPaths f s = fmap (\x -> s{T.packageConfigProgramPaths = x}) (f (T.packageConfigProgramPaths s)) +{-# INLINEABLE packageConfigProgramPaths #-} + +packageConfigProgramArgs :: Lens' PackageConfig (MapMappend String [String]) +packageConfigProgramArgs f s = fmap (\x -> s{T.packageConfigProgramArgs = x}) (f (T.packageConfigProgramArgs s)) +{-# INLINEABLE packageConfigProgramArgs #-} + +packageConfigProgramPathExtra :: Lens' PackageConfig (NubList FilePath) +packageConfigProgramPathExtra f s = fmap (\x -> s{T.packageConfigProgramPathExtra = x}) (f (T.packageConfigProgramPathExtra s)) +{-# INLINEABLE packageConfigProgramPathExtra #-} + +packageConfigFlagAssignment :: Lens' PackageConfig (FlagAssignment) +packageConfigFlagAssignment f s = fmap (\x -> s{T.packageConfigFlagAssignment = x}) (f (T.packageConfigFlagAssignment s)) +{-# INLINEABLE packageConfigFlagAssignment #-} + +packageConfigVanillaLib :: Lens' PackageConfig (Flag Bool) +packageConfigVanillaLib f s = fmap (\x -> s{T.packageConfigVanillaLib = x}) (f (T.packageConfigVanillaLib s)) +{-# INLINEABLE packageConfigVanillaLib #-} + +packageConfigSharedLib :: Lens' PackageConfig (Flag Bool) +packageConfigSharedLib f s = fmap (\x -> s{T.packageConfigSharedLib = x}) (f (T.packageConfigSharedLib s)) +{-# INLINEABLE packageConfigSharedLib #-} + +packageConfigStaticLib :: Lens' PackageConfig (Flag Bool) +packageConfigStaticLib f s = fmap (\x -> s{T.packageConfigStaticLib = x}) (f (T.packageConfigStaticLib s)) +{-# INLINEABLE packageConfigStaticLib #-} + +packageConfigDynExe :: Lens' PackageConfig (Flag Bool) +packageConfigDynExe f s = fmap (\x -> s{T.packageConfigDynExe = x}) (f (T.packageConfigDynExe s)) +{-# INLINEABLE packageConfigDynExe #-} + +packageConfigFullyStaticExe :: Lens' PackageConfig (Flag Bool) +packageConfigFullyStaticExe f s = fmap (\x -> s{T.packageConfigFullyStaticExe = x}) (f (T.packageConfigFullyStaticExe s)) +{-# INLINEABLE packageConfigFullyStaticExe #-} + +packageConfigProf :: Lens' PackageConfig (Flag Bool) +packageConfigProf f s = fmap (\x -> s{T.packageConfigProf = x}) (f (T.packageConfigProf s)) +{-# INLINEABLE packageConfigProf #-} + +packageConfigProfLib :: Lens' PackageConfig (Flag Bool) +packageConfigProfLib f s = fmap (\x -> s{T.packageConfigProfLib = x}) (f (T.packageConfigProfLib s)) +{-# INLINEABLE packageConfigProfLib #-} + +packageConfigProfShared :: Lens' PackageConfig (Flag Bool) +packageConfigProfShared f s = fmap (\x -> s{T.packageConfigProfShared = x}) (f (T.packageConfigProfShared s)) +{-# INLINEABLE packageConfigProfShared #-} + +packageConfigProfExe :: Lens' PackageConfig (Flag Bool) +packageConfigProfExe f s = fmap (\x -> s{T.packageConfigProfExe = x}) (f (T.packageConfigProfExe s)) +{-# INLINEABLE packageConfigProfExe #-} + +packageConfigProfDetail :: Lens' PackageConfig (Flag ProfDetailLevel) +packageConfigProfDetail f s = fmap (\x -> s{T.packageConfigProfDetail = x}) (f (T.packageConfigProfDetail s)) +{-# INLINEABLE packageConfigProfDetail #-} + +packageConfigProfLibDetail :: Lens' PackageConfig (Flag ProfDetailLevel) +packageConfigProfLibDetail f s = fmap (\x -> s{T.packageConfigProfLibDetail = x}) (f (T.packageConfigProfLibDetail s)) +{-# INLINEABLE packageConfigProfLibDetail #-} + +packageConfigConfigureArgs :: Lens' PackageConfig [String] +packageConfigConfigureArgs f s = fmap (\x -> s{T.packageConfigConfigureArgs = x}) (f (T.packageConfigConfigureArgs s)) +{-# INLINEABLE packageConfigConfigureArgs #-} + +packageConfigOptimization :: Lens' PackageConfig (Flag OptimisationLevel) +packageConfigOptimization f s = fmap (\x -> s{T.packageConfigOptimization = x}) (f (T.packageConfigOptimization s)) +{-# INLINEABLE packageConfigOptimization #-} + +packageConfigProgPrefix :: Lens' PackageConfig (Flag PathTemplate) +packageConfigProgPrefix f s = fmap (\x -> s{T.packageConfigProgPrefix = x}) (f (T.packageConfigProgPrefix s)) +{-# INLINEABLE packageConfigProgPrefix #-} + +packageConfigProgSuffix :: Lens' PackageConfig (Flag PathTemplate) +packageConfigProgSuffix f s = fmap (\x -> s{T.packageConfigProgSuffix = x}) (f (T.packageConfigProgSuffix s)) +{-# INLINEABLE packageConfigProgSuffix #-} + +packageConfigExtraLibDirs :: Lens' PackageConfig [FilePath] +packageConfigExtraLibDirs f s = fmap (\x -> s{T.packageConfigExtraLibDirs = x}) (f (T.packageConfigExtraLibDirs s)) +{-# INLINEABLE packageConfigExtraLibDirs #-} + +packageConfigExtraLibDirsStatic :: Lens' PackageConfig [FilePath] +packageConfigExtraLibDirsStatic f s = fmap (\x -> s{T.packageConfigExtraLibDirsStatic = x}) (f (T.packageConfigExtraLibDirsStatic s)) +{-# INLINEABLE packageConfigExtraLibDirsStatic #-} + +packageConfigExtraFrameworkDirs :: Lens' PackageConfig [FilePath] +packageConfigExtraFrameworkDirs f s = fmap (\x -> s{T.packageConfigExtraFrameworkDirs = x}) (f (T.packageConfigExtraFrameworkDirs s)) +{-# INLINEABLE packageConfigExtraFrameworkDirs #-} + +packageConfigExtraIncludeDirs :: Lens' PackageConfig [FilePath] +packageConfigExtraIncludeDirs f s = fmap (\x -> s{T.packageConfigExtraIncludeDirs = x}) (f (T.packageConfigExtraIncludeDirs s)) +{-# INLINEABLE packageConfigExtraIncludeDirs #-} + +packageConfigGHCiLib :: Lens' PackageConfig (Flag Bool) +packageConfigGHCiLib f s = fmap (\x -> s{T.packageConfigGHCiLib = x}) (f (T.packageConfigGHCiLib s)) +{-# INLINEABLE packageConfigGHCiLib #-} + +packageConfigSplitSections :: Lens' PackageConfig (Flag Bool) +packageConfigSplitSections f s = fmap (\x -> s{T.packageConfigSplitSections = x}) (f (T.packageConfigSplitSections s)) +{-# INLINEABLE packageConfigSplitSections #-} + +packageConfigSplitObjs :: Lens' PackageConfig (Flag Bool) +packageConfigSplitObjs f s = fmap (\x -> s{T.packageConfigSplitObjs = x}) (f (T.packageConfigSplitObjs s)) +{-# INLINEABLE packageConfigSplitObjs #-} + +packageConfigStripExes :: Lens' PackageConfig (Flag Bool) +packageConfigStripExes f s = fmap (\x -> s{T.packageConfigStripExes = x}) (f (T.packageConfigStripExes s)) +{-# INLINEABLE packageConfigStripExes #-} + +packageConfigStripLibs :: Lens' PackageConfig (Flag Bool) +packageConfigStripLibs f s = fmap (\x -> s{T.packageConfigStripLibs = x}) (f (T.packageConfigStripLibs s)) +{-# INLINEABLE packageConfigStripLibs #-} + +packageConfigTests :: Lens' PackageConfig (Flag Bool) +packageConfigTests f s = fmap (\x -> s{T.packageConfigTests = x}) (f (T.packageConfigTests s)) +{-# INLINEABLE packageConfigTests #-} + +packageConfigBenchmarks :: Lens' PackageConfig (Flag Bool) +packageConfigBenchmarks f s = fmap (\x -> s{T.packageConfigBenchmarks = x}) (f (T.packageConfigBenchmarks s)) +{-# INLINEABLE packageConfigBenchmarks #-} + +packageConfigCoverage :: Lens' PackageConfig (Flag Bool) +packageConfigCoverage f s = fmap (\x -> s{T.packageConfigCoverage = x}) (f (T.packageConfigCoverage s)) +{-# INLINEABLE packageConfigCoverage #-} + +packageConfigRelocatable :: Lens' PackageConfig (Flag Bool) +packageConfigRelocatable f s = fmap (\x -> s{T.packageConfigRelocatable = x}) (f (T.packageConfigRelocatable s)) +{-# INLINEABLE packageConfigRelocatable #-} + +packageConfigDebugInfo :: Lens' PackageConfig (Flag DebugInfoLevel) +packageConfigDebugInfo f s = fmap (\x -> s{T.packageConfigDebugInfo = x}) (f (T.packageConfigDebugInfo s)) +{-# INLINEABLE packageConfigDebugInfo #-} + +packageConfigDumpBuildInfo :: Lens' PackageConfig (Flag DumpBuildInfo) +packageConfigDumpBuildInfo f s = fmap (\x -> s{T.packageConfigDumpBuildInfo = x}) (f (T.packageConfigDumpBuildInfo s)) +{-# INLINEABLE packageConfigDumpBuildInfo #-} + +packageConfigRunTests :: Lens' PackageConfig (Flag Bool) +packageConfigRunTests f s = fmap (\x -> s{T.packageConfigRunTests = x}) (f (T.packageConfigRunTests s)) +{-# INLINEABLE packageConfigRunTests #-} + +packageConfigDocumentation :: Lens' PackageConfig (Flag Bool) +packageConfigDocumentation f s = fmap (\x -> s{T.packageConfigDocumentation = x}) (f (T.packageConfigDocumentation s)) +{-# INLINEABLE packageConfigDocumentation #-} + +packageConfigHaddockHoogle :: Lens' PackageConfig (Flag Bool) +packageConfigHaddockHoogle f s = fmap (\x -> s{T.packageConfigHaddockHoogle = x}) (f (T.packageConfigHaddockHoogle s)) +{-# INLINEABLE packageConfigHaddockHoogle #-} + +packageConfigHaddockHtml :: Lens' PackageConfig (Flag Bool) +packageConfigHaddockHtml f s = fmap (\x -> s{T.packageConfigHaddockHtml = x}) (f (T.packageConfigHaddockHtml s)) +{-# INLINEABLE packageConfigHaddockHtml #-} + +packageConfigHaddockHtmlLocation :: Lens' PackageConfig (Flag String) +packageConfigHaddockHtmlLocation f s = fmap (\x -> s{T.packageConfigHaddockHtmlLocation = x}) (f (T.packageConfigHaddockHtmlLocation s)) +{-# INLINEABLE packageConfigHaddockHtmlLocation #-} + +packageConfigHaddockForeignLibs :: Lens' PackageConfig (Flag Bool) +packageConfigHaddockForeignLibs f s = fmap (\x -> s{T.packageConfigHaddockForeignLibs = x}) (f (T.packageConfigHaddockForeignLibs s)) +{-# INLINEABLE packageConfigHaddockForeignLibs #-} + +packageConfigHaddockExecutables :: Lens' PackageConfig (Flag Bool) +packageConfigHaddockExecutables f s = fmap (\x -> s{T.packageConfigHaddockExecutables = x}) (f (T.packageConfigHaddockExecutables s)) +{-# INLINEABLE packageConfigHaddockExecutables #-} + +packageConfigHaddockTestSuites :: Lens' PackageConfig (Flag Bool) +packageConfigHaddockTestSuites f s = fmap (\x -> s{T.packageConfigHaddockTestSuites = x}) (f (T.packageConfigHaddockTestSuites s)) +{-# INLINEABLE packageConfigHaddockTestSuites #-} + +packageConfigHaddockBenchmarks :: Lens' PackageConfig (Flag Bool) +packageConfigHaddockBenchmarks f s = fmap (\x -> s{T.packageConfigHaddockBenchmarks = x}) (f (T.packageConfigHaddockBenchmarks s)) +{-# INLINEABLE packageConfigHaddockBenchmarks #-} + +packageConfigHaddockInternal :: Lens' PackageConfig (Flag Bool) +packageConfigHaddockInternal f s = fmap (\x -> s{T.packageConfigHaddockInternal = x}) (f (T.packageConfigHaddockInternal s)) +{-# INLINEABLE packageConfigHaddockInternal #-} + +packageConfigHaddockCss :: Lens' PackageConfig (Flag FilePath) +packageConfigHaddockCss f s = fmap (\x -> s{T.packageConfigHaddockCss = x}) (f (T.packageConfigHaddockCss s)) +{-# INLINEABLE packageConfigHaddockCss #-} + +packageConfigHaddockLinkedSource :: Lens' PackageConfig (Flag Bool) +packageConfigHaddockLinkedSource f s = fmap (\x -> s{T.packageConfigHaddockLinkedSource = x}) (f (T.packageConfigHaddockLinkedSource s)) +{-# INLINEABLE packageConfigHaddockLinkedSource #-} + +packageConfigHaddockQuickJump :: Lens' PackageConfig (Flag Bool) +packageConfigHaddockQuickJump f s = fmap (\x -> s{T.packageConfigHaddockQuickJump = x}) (f (T.packageConfigHaddockQuickJump s)) +{-# INLINEABLE packageConfigHaddockQuickJump #-} + +packageConfigHaddockHscolourCss :: Lens' PackageConfig (Flag FilePath) +packageConfigHaddockHscolourCss f s = fmap (\x -> s{T.packageConfigHaddockHscolourCss = x}) (f (T.packageConfigHaddockHscolourCss s)) +{-# INLINEABLE packageConfigHaddockHscolourCss #-} + +packageConfigHaddockContents :: Lens' PackageConfig (Flag PathTemplate) +packageConfigHaddockContents f s = fmap (\x -> s{T.packageConfigHaddockContents = x}) (f (T.packageConfigHaddockContents s)) +{-# INLINEABLE packageConfigHaddockContents #-} + +packageConfigHaddockIndex :: Lens' PackageConfig (Flag PathTemplate) +packageConfigHaddockIndex f s = fmap (\x -> s{T.packageConfigHaddockIndex = x}) (f (T.packageConfigHaddockIndex s)) +{-# INLINEABLE packageConfigHaddockIndex #-} + +packageConfigHaddockBaseUrl :: Lens' PackageConfig (Flag String) +packageConfigHaddockBaseUrl f s = fmap (\x -> s{T.packageConfigHaddockBaseUrl = x}) (f (T.packageConfigHaddockBaseUrl s)) +{-# INLINEABLE packageConfigHaddockBaseUrl #-} + +packageConfigHaddockResourcesDir :: Lens' PackageConfig (Flag String) +packageConfigHaddockResourcesDir f s = fmap (\x -> s{T.packageConfigHaddockResourcesDir = x}) (f (T.packageConfigHaddockResourcesDir s)) +{-# INLINEABLE packageConfigHaddockResourcesDir #-} + +packageConfigHaddockOutputDir :: Lens' PackageConfig (Flag FilePath) +packageConfigHaddockOutputDir f s = fmap (\x -> s{T.packageConfigHaddockOutputDir = x}) (f (T.packageConfigHaddockOutputDir s)) +{-# INLINEABLE packageConfigHaddockOutputDir #-} + +packageConfigHaddockUseUnicode :: Lens' PackageConfig (Flag Bool) +packageConfigHaddockUseUnicode f s = fmap (\x -> s{T.packageConfigHaddockUseUnicode = x}) (f (T.packageConfigHaddockUseUnicode s)) +{-# INLINEABLE packageConfigHaddockUseUnicode #-} + +packageConfigHaddockForHackage :: Lens' PackageConfig (Flag HaddockTarget) +packageConfigHaddockForHackage f s = fmap (\x -> s{T.packageConfigHaddockForHackage = x}) (f (T.packageConfigHaddockForHackage s)) +{-# INLINEABLE packageConfigHaddockForHackage #-} + +packageConfigTestHumanLog :: Lens' PackageConfig (Flag PathTemplate) +packageConfigTestHumanLog f s = fmap (\x -> s{T.packageConfigTestHumanLog = x}) (f (T.packageConfigTestHumanLog s)) +{-# INLINEABLE packageConfigTestHumanLog #-} + +packageConfigTestMachineLog :: Lens' PackageConfig (Flag PathTemplate) +packageConfigTestMachineLog f s = fmap (\x -> s{T.packageConfigTestMachineLog = x}) (f (T.packageConfigTestMachineLog s)) +{-# INLINEABLE packageConfigTestMachineLog #-} + +packageConfigTestShowDetails :: Lens' PackageConfig (Flag TestShowDetails) +packageConfigTestShowDetails f s = fmap (\x -> s{T.packageConfigTestShowDetails = x}) (f (T.packageConfigTestShowDetails s)) +{-# INLINEABLE packageConfigTestShowDetails #-} + +packageConfigTestKeepTix :: Lens' PackageConfig (Flag Bool) +packageConfigTestKeepTix f s = fmap (\x -> s{T.packageConfigTestKeepTix = x}) (f (T.packageConfigTestKeepTix s)) +{-# INLINEABLE packageConfigTestKeepTix #-} + +packageConfigTestWrapper :: Lens' PackageConfig (Flag FilePath) +packageConfigTestWrapper f s = fmap (\x -> s{T.packageConfigTestWrapper = x}) (f (T.packageConfigTestWrapper s)) +{-# INLINEABLE packageConfigTestWrapper #-} + +packageConfigTestFailWhenNoTestSuites :: Lens' PackageConfig (Flag Bool) +packageConfigTestFailWhenNoTestSuites f s = fmap (\x -> s{T.packageConfigTestFailWhenNoTestSuites = x}) (f (T.packageConfigTestFailWhenNoTestSuites s)) +{-# INLINEABLE packageConfigTestFailWhenNoTestSuites #-} + +packageConfigTestTestOptions :: Lens' PackageConfig [PathTemplate] +packageConfigTestTestOptions f s = fmap (\x -> s{T.packageConfigTestTestOptions = x}) (f (T.packageConfigTestTestOptions s)) +{-# INLINEABLE packageConfigTestTestOptions #-} + +packageConfigBenchmarkOptions :: Lens' PackageConfig [PathTemplate] +packageConfigBenchmarkOptions f s = fmap (\x -> s{T.packageConfigBenchmarkOptions = x}) (f (T.packageConfigBenchmarkOptions s)) +{-# INLINEABLE packageConfigBenchmarkOptions #-} diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Parsec.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Parsec.hs new file mode 100644 index 00000000000..f4d638c0d6b --- /dev/null +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Parsec.hs @@ -0,0 +1,427 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Parsing project configuration. +module Distribution.Client.ProjectConfig.Parsec + ( -- * Package configuration + parseProjectSkeleton + , parseProject + , ProjectConfigSkeleton + , ProjectConfig (..) + + -- ** Parsing + , ParseResult + , runParseResult + ) where + +import Distribution.CabalSpecVersion +import Distribution.Client.HttpUtils +import Distribution.Client.ProjectConfig.FieldGrammar (packageConfigFieldGrammar, projectConfigFieldGrammar) +import Distribution.Client.ProjectConfig.Legacy (ProjectConfigSkeleton) +import qualified Distribution.Client.ProjectConfig.Lens as L +import Distribution.Client.ProjectConfig.Types +import Distribution.Client.Types.Repo hiding (repoName) +import Distribution.Client.Types.RepoName (RepoName (..)) +import Distribution.Client.Types.SourceRepo (sourceRepositoryPackageGrammar) +import Distribution.Client.Utils.Parsec +import Distribution.Compat.Lens +import Distribution.Compat.Prelude +import Distribution.FieldGrammar +import Distribution.FieldGrammar.Parsec (NamelessField (..), namelessFieldAnn) +import Distribution.Fields (Field (..), FieldLine (..), FieldName, Name (..), SectionArg (..), readFields') +import Distribution.Fields.ConfVar (parseConditionConfVar) +import Distribution.Fields.Field (fieldLinesToString, sectionArgAnn) +import Distribution.Fields.LexerMonad (toPWarnings) +import Distribution.Fields.ParseResult +import Distribution.Parsec (ParsecParser, eitherParsec, parsec, parsecFilePath, runParsecParser) +import Distribution.Parsec.FieldLineStream (fieldLineStreamFromBS) +import Distribution.Parsec.Position (Position (..), incPos, zeroPos) +import Distribution.Parsec.Warning (PWarnType (..)) +import Distribution.Simple.Program.Db (ProgramDb, defaultProgramDb, knownPrograms, lookupKnownProgram) +import Distribution.Simple.Program.Types (programName) +import Distribution.Simple.Setup +import Distribution.Simple.Utils (debug, noticeDoc) +import Distribution.Solver.Types.ProjectConfigPath +import Distribution.System (buildOS) +import Distribution.Types.CondTree (CondBranch (..), CondTree (..)) +import Distribution.Types.ConfVar (ConfVar (..)) +import Distribution.Types.PackageName (PackageName) +import Distribution.Utils.Generic (fromUTF8BS, toUTF8BS, validateUTF8) +import Distribution.Utils.NubList (toNubList) +import Distribution.Utils.String (trim) +import Distribution.Verbosity + +import Control.Monad.State.Strict (StateT, execStateT, lift) +import qualified Data.ByteString as BS +import Data.Coerce (coerce) +import qualified Data.Map.Strict as Map +import qualified Data.Set as Set +import Distribution.Client.Errors.Parser (ProjectFileSource (..)) +import qualified Distribution.Compat.CharParsing as P +import Network.URI (parseURI, uriFragment, uriPath, uriScheme) +import System.Directory (createDirectoryIfMissing, makeAbsolute) +import System.FilePath (isAbsolute, isPathSeparator, makeValid, splitFileName, ()) +import qualified Text.Parsec +import Text.PrettyPrint (render) +import qualified Text.PrettyPrint as Disp + +singletonProjectConfigSkeleton :: ProjectConfig -> ProjectConfigSkeleton +singletonProjectConfigSkeleton x = CondNode x mempty mempty + +readPreprocessFields :: BS.ByteString -> ParseResult src [Field Position] +readPreprocessFields bs = do + case readFields' bs' of + Right (fs, lexWarnings) -> do + parseWarnings (toPWarnings lexWarnings) + for_ invalidUtf8 $ \pos -> + parseWarning zeroPos PWTUTF $ "UTF8 encoding problem at byte offset " ++ show pos + return fs + Left perr -> parseFatalFailure pos (show perr) + where + ppos = Text.Parsec.errorPos perr + pos = Position (Text.Parsec.sourceLine ppos) (Text.Parsec.sourceColumn ppos) + where + invalidUtf8 = validateUTF8 bs + bs' = case invalidUtf8 of + Nothing -> bs + Just _ -> toUTF8BS (fromUTF8BS bs) + +-- | Parses a project from its root config file, typically cabal.project. +parseProject + :: FilePath + -- ^ The root of the project configuration, typically cabal.project + -> FilePath + -> HttpTransport + -> Verbosity + -> ProjectConfigToParse + -- ^ The contents of the file to parse + -> IO (ParseResult ProjectFileSource 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 + +parseProjectSkeleton + :: FilePath + -> HttpTransport + -> Verbosity + -> FilePath + -- ^ The directory of the project configuration, typically the directory of cabal.project + -> ProjectConfigPath + -- ^ The path of the file being parsed, either the root or an import + -> ProjectConfigToParse + -- ^ The contents of the file to parse + -> IO (ParseResult ProjectFileSource ProjectConfigSkeleton) +parseProjectSkeleton cacheDir httpTransport verbosity projectDir source (ProjectConfigToParse bs) = do + normSource <- canonicalizeConfigPath projectDir source + res <- (sanityWalkPCS False =<<) <$> liftParseResult (go []) (readPreprocessFields bs) + pure $ withSource (ProjectFileSource (normSource, bs)) res + where + go :: [Field Position] -> [Field Position] -> IO (ParseResult ProjectFileSource ProjectConfigSkeleton) + go acc (x : xs) = case x of + (Field (Name pos name) importLines) | name == "import" -> do + liftParseResult + ( \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 $ parseFatalFailure pos (render $ cyclicalImportMsg normLocPath) + else do + when + (isUntrimmedUriConfigPath importLocPath) + (noticeDoc verbosity $ untrimmedUriImportMsg (Disp.text "Warning:") importLocPath) + let fs = (\z -> CondNode z [normLocPath] mempty) <$> fieldsToConfig normSource (reverse acc) + importParseResult <- parseProjectSkeleton cacheDir httpTransport verbosity projectDir importLocPath . ProjectConfigToParse =<< fetchImportConfig normLocPath + + rest <- go [] xs + pure . fmap mconcat . sequence $ [fs, importParseResult, rest] + ) + (parseImport pos importLines) + (Section (Name pos "if") args xs') -> do + subpcs <- go [] xs' + let fs = fmap singletonProjectConfigSkeleton $ fieldsToConfig source (reverse acc) + (elseClauses, rest) <- parseElseClauses xs + let condNode = + (\c pcs e -> CondNode mempty mempty [CondBranch c pcs e]) + <$> parseConditionConfVar (startOfSection (incPos 2 pos) args) args + <*> subpcs + <*> elseClauses + pure . fmap mconcat . sequence $ [fs, condNode, rest] + _ -> go (x : acc) xs + go acc [] = do + normSource <- canonicalizeConfigPath projectDir source + pure . fmap singletonProjectConfigSkeleton . fieldsToConfig normSource $ reverse acc + + parseElseClauses :: [Field Position] -> IO (ParseResult ProjectFileSource (Maybe ProjectConfigSkeleton), ParseResult ProjectFileSource ProjectConfigSkeleton) + parseElseClauses x = case x of + (Section (Name _pos "else") _args xs' : xs) -> do + subpcs <- go [] xs' + rest <- go [] xs + pure (Just <$> subpcs, rest) + (Section (Name pos "elif") args xs' : xs) -> do + subpcs <- go [] xs' + (elseClauses, rest) <- parseElseClauses xs + let condNode = + (\c pcs e -> CondNode mempty mempty [CondBranch c pcs e]) + <$> parseConditionConfVar (startOfSection (incPos 4 pos) args) args + <*> subpcs + <*> elseClauses + pure (Just <$> condNode, rest) + _ -> (\r -> (pure Nothing, r)) <$> go [] x + + parseImport :: Position -> [FieldLine Position] -> ParseResult ProjectFileSource FilePath + parseImport pos lines' = runFieldParser pos (P.many P.anyChar) cabalSpec lines' + + -- We want a normalized path for @fieldsToConfig@. This eventually surfaces + -- in solver rejection messages and build messages "this build was affected + -- by the following (project) config files" so we want all paths shown there + -- to be relative to the directory of the project, not relative to the file + -- they were imported from. + fieldsToConfig :: ProjectConfigPath -> [Field Position] -> ParseResult ProjectFileSource ProjectConfig + fieldsToConfig sourceConfigPath xs = do + let (fs, sectionGroups) = partitionFields xs + sections = concat sectionGroups + config <- parseFieldGrammarCheckingStanzas cabalSpec fs (projectConfigFieldGrammar sourceConfigPath (knownProgramNames programDb)) stanzas + config' <- view stateConfig <$> execStateT (goSections programDb sections) (SectionS config) + return config' + + fetchImportConfig :: ProjectConfigPath -> IO BS.ByteString + fetchImportConfig (ProjectConfigPath (pci :| _)) = do + debug verbosity $ "fetching import: " ++ pci + fetch pci + + fetch :: FilePath -> IO BS.ByteString + fetch pci = case parseURI (trim pci) of + Just uri -> do + let fp = cacheDir map (\x -> if isPathSeparator x then '_' else x) (makeValid $ show uri) + createDirectoryIfMissing True cacheDir + _ <- downloadURI httpTransport verbosity uri fp + BS.readFile fp + Nothing -> + BS.readFile $ + if isAbsolute pci then pci else coerce projectDir pci + + modifiesCompiler :: ProjectConfig -> Bool + modifiesCompiler pc = isSet projectConfigHcFlavor || isSet projectConfigHcPath || isSet projectConfigHcPkg + where + isSet f = f (projectConfigShared pc) /= NoFlag + + sanityWalkPCS :: Bool -> ProjectConfigSkeleton -> ParseResult ProjectFileSource ProjectConfigSkeleton + sanityWalkPCS underConditional t@(CondNode d _c comps) + | underConditional && modifiesCompiler d = parseFatalFailure zeroPos "Cannot set compiler in a conditional clause of a cabal project file" + | otherwise = mapM_ sanityWalkBranch comps >> pure t + + sanityWalkBranch :: CondBranch ConfVar [ProjectConfigPath] ProjectConfig -> ParseResult ProjectFileSource () + sanityWalkBranch (CondBranch _c t f) = traverse_ (sanityWalkPCS True) f >> sanityWalkPCS True t >> pure () + + programDb = defaultProgramDb + +startOfSection :: Position -> [SectionArg Position] -> Position +-- The case where we have no args is the start of the section +startOfSection defaultPos [] = defaultPos +-- Otherwise the start of the section is the position of the first argument. +startOfSection _ (cond : _) = sectionArgAnn cond + +knownProgramNames :: ProgramDb -> [String] +knownProgramNames programDb = (programName . fst) <$> knownPrograms programDb + +-- | Monad in which sections are parsed +type SectionParser src = StateT SectionS (ParseResult src) + +-- | State of 'SectionParser' +newtype SectionS = SectionS + { _stateConfig :: ProjectConfig + } + +stateConfig :: Lens' SectionS ProjectConfig +stateConfig f (SectionS cfg) = SectionS <$> f cfg +{-# INLINEABLE stateConfig #-} + +goSections :: ProgramDb -> [Section Position] -> SectionParser src () +goSections programDb = traverse_ (parseSection programDb) + +parseSection :: ProgramDb -> Section Position -> SectionParser src () +parseSection programDb (MkSection (Name pos name) args secFields) + | name == "source-repository-package" = do + verifyNullSubsections + verifyNullSectionArgs + srp <- lift $ parseFieldGrammar cabalSpec fields sourceRepositoryPackageGrammar + stateConfig . L.projectPackagesRepo %= (<> [srp]) + | name == "program-options" = do + verifyNullSubsections + verifyNullSectionArgs + opts' <- lift $ parseProgramArgs programDb fields + stateConfig . L.projectConfigLocalPackages . L.packageConfigProgramArgs %= (opts' <>) + | name == "program-locations" = do + verifyNullSubsections + verifyNullSectionArgs + paths' <- lift $ parseProgramPaths programDb fields + stateConfig . L.projectConfigLocalPackages . L.packageConfigProgramPaths %= (paths' <>) + | name == "repository" = do + verifyNullSubsections + mRepoName <- lift $ parseRepoName pos args + case mRepoName of + Just repoName -> do + remoteRepo <- lift $ parseFieldGrammar cabalSpec fields (remoteRepoGrammar repoName) + remoteOrLocalRepo <- lift $ postProcessRemoteRepo pos remoteRepo + case remoteOrLocalRepo of + Left local -> stateConfig . L.projectConfigShared . L.projectConfigLocalNoIndexRepos %= (<> toNubList [local]) + Right remote -> stateConfig . L.projectConfigShared . L.projectConfigRemoteRepos %= (<> toNubList [remote]) + Nothing -> lift $ parseFailure pos "a 'repository' section requires the repository name as an argument" + | name == "package" = do + verifyNullSubsections + package <- lift $ parsePackageName pos args + case package of + Just AllPackages -> do + packageCfg' <- parsePackageConfig + stateConfig . L.projectConfigAllPackages %= (packageCfg' <>) + Just (SpecificPackage packageName) -> do + packageCfg <- parsePackageConfig + stateConfig . L.projectConfigSpecificPackage %= (<> MapMappend (Map.singleton packageName packageCfg)) + Nothing -> do + lift $ parseWarning pos PWTUnknownSection "target package name or * required" + return () + | otherwise = do + warnInvalidSubsection pos name + where + (fields, sections) = partitionFields secFields + warnInvalidSubsection pos' name' = lift $ parseWarning pos' PWTInvalidSubsection $ "Invalid subsection " ++ show name' + programNames = knownProgramNames programDb + verifyNullSubsections = unless (null sections) (warnInvalidSubsection pos name) + verifyNullSectionArgs = unless (null args) (lift $ parseFailure pos $ "The section '" <> (show name) <> "' takes no arguments") + parsePackageConfig = do + packageCfg <- lift $ parseFieldGrammar cabalSpec fields (packageConfigFieldGrammar programNames) + args' <- lift $ parseProgramArgs programDb fields + paths <- lift $ parseProgramPaths programDb fields + return packageCfg{packageConfigProgramPaths = paths, packageConfigProgramArgs = args'} + +stanzas :: Set BS.ByteString +stanzas = Set.fromList ["source-repository-package", "program-options", "program-locations", "repository", "package"] + +-- | Currently a duplicate of 'Distribution.Client.Config.postProcessRepo' but migrated to Parsec ParseResult. +postProcessRemoteRepo :: Position -> RemoteRepo -> ParseResult src (Either LocalRepo RemoteRepo) +postProcessRemoteRepo pos repo = case uriScheme (remoteRepoURI repo) of + -- TODO: check that there are no authority, query or fragment + -- Note: the trailing colon is important + "file+noindex:" -> do + let uri = normaliseFileNoIndexURI buildOS $ remoteRepoURI repo + return $ Left $ LocalRepo (remoteRepoName repo) (uriPath uri) (uriFragment uri == "#shared-cache") + _ -> do + when (remoteRepoKeyThreshold repo > length (remoteRepoRootKeys repo)) $ + warning $ + "'key-threshold' for repository " + ++ show (remoteRepoName repo) + ++ " higher than number of keys" + + when (not (null (remoteRepoRootKeys repo)) && remoteRepoSecure repo /= Just True) $ + warning $ + "'root-keys' for repository " + ++ show (remoteRepoName repo) + ++ " non-empty, but 'secure' not set to True." + + return $ Right repo + where + warning msg = parseWarning pos PWTOther msg + +parseRepoName :: Position -> [SectionArg Position] -> ParseResult src (Maybe RepoName) +parseRepoName pos args = case args of + [SecArgName _ secName] -> parseName secName + [SecArgStr _ secName] -> parseName secName + [SecArgOther _ secName] -> parseName secName + _ -> return Nothing + where + parseName :: BS.ByteString -> ParseResult src (Maybe RepoName) + parseName str = + let repoNameStr = fromUTF8BS str + in case eitherParsec repoNameStr of + Left _ -> do + parseFailure pos ("Invalid repository name" ++ repoNameStr) + return Nothing + Right name -> return $ Just name + +data PackageConfigTarget = AllPackages | SpecificPackage !PackageName + +parsePackageName :: Position -> [SectionArg Position] -> ParseResult src (Maybe PackageConfigTarget) +parsePackageName pos args = case args of + [SecArgName _ secName] -> parseName secName + [SecArgStr _ secName] -> parseName secName + [SecArgOther _ secName] -> parseName secName + _ -> return Nothing + where + parseName secName = case runParsecParser parser "" (fieldLineStreamFromBS secName) of + Left _ -> do + parseFailure pos ("Invalid package name" ++ fromUTF8BS secName) + return Nothing + Right cfgTarget -> return $ pure cfgTarget + parser :: ParsecParser PackageConfigTarget + parser = + P.choice [P.try (P.char '*' >> return AllPackages), SpecificPackage <$> parsec] + +-- | Parse fields of a program-options stanza. +parseProgramArgs :: ProgramDb -> Fields Position -> ParseResult src (MapMappend String [String]) +parseProgramArgs programDb fields = foldM parseField mempty (filter hasOptionsSuffix $ Map.toList fields) + where + parseField programArgs (fieldName, fieldLines) = do + case readProgramName "-options" programDb fieldName of + Nothing -> warnUnknownFields fieldName fieldLines >> return programArgs + Just program -> do + args <- parseProgramArgsField $ reverse fieldLines + return $ programArgs <> MapMappend (Map.singleton program args) + hasOptionsSuffix (fieldName, _) = BS.isSuffixOf "-options" fieldName + +-- | Parse fields of a program-locations stanza. +parseProgramPaths :: ProgramDb -> Fields Position -> ParseResult src (MapLast String FilePath) +parseProgramPaths programDb fields = foldM parseField mempty (filter hasLocationSuffix $ Map.toList fields) + where + parseField paths (fieldName, fieldLines) = do + case readProgramName "-location" programDb fieldName of + Nothing -> warnUnknownFields fieldName fieldLines >> return paths + Just program -> do + case fieldLines of + (MkNamelessField pos lines') : _ -> do + fp <- runFieldParser pos parsecFilePath cabalSpec lines' + return $ paths <> MapLast (Map.singleton program fp) + [] -> return mempty + hasLocationSuffix (fieldName, _) = BS.isSuffixOf "-location" fieldName + +-- | Parse all arguments to a single program in program-options stanza. +-- By processing '[NamelessField Position]', we support multiple occurrences of the field, concatenating the arguments. +parseProgramArgsField :: [NamelessField Position] -> ParseResult src ([String]) +parseProgramArgsField fieldLines = + concat <$> mapM (\(MkNamelessField _ lines') -> parseProgramArgsFieldLines lines') fieldLines + +-- | Parse all fieldLines of a single field occurrence in a program-options stanza. +parseProgramArgsFieldLines :: [FieldLine Position] -> ParseResult src [String] +parseProgramArgsFieldLines lines' = return $ splitArgs strLines + where + strLines = fieldLinesToString lines' + +type FieldSuffix = String + +-- | Extract the program name of a field, allow it to have a suffix such as '-options' and check whether the 'ProgramDB' contains it. +readProgramName :: FieldSuffix -> ProgramDb -> FieldName -> Maybe String +readProgramName suffix programDb fieldName = + parseProgramName suffix fieldName >>= ((flip lookupKnownProgram) programDb) >>= pure . programName + +parseProgramName :: FieldSuffix -> FieldName -> Maybe String +parseProgramName suffix fieldName = case runParsecParser parser "" fieldNameStream of + Left _ -> Nothing + Right str -> Just str + where + parser = P.manyTill P.anyChar (P.try ((P.string suffix)) <* P.eof) + fieldNameStream = fieldLineStreamFromBS fieldName + +-- | Issue a 'PWTUnknownField' warning at all occurrences of a field. +warnUnknownFields :: FieldName -> [NamelessField Position] -> ParseResult src () +warnUnknownFields fieldName fieldLines = for_ fieldLines (\field -> parseWarning (pos field) PWTUnknownField message) + where + message = "Unknown field: " ++ show fieldName + pos = namelessFieldAnn + +cabalSpec :: CabalSpecVersion +cabalSpec = cabalSpecLatest diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs index 1a2b6ae2fa6..220834a331c 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -10,6 +11,8 @@ module Distribution.Client.ProjectConfig.Types , ProjectConfigShared (..) , ProjectConfigProvenance (..) , PackageConfig (..) + , ProjectFileParser (..) + , defaultProjectFileParser -- * Resolving configuration , SolverSettings (..) @@ -168,6 +171,7 @@ data ProjectConfigBuildOnly = ProjectConfigBuildOnly , projectConfigReportPlanningFailure :: Flag Bool , projectConfigSymlinkBinDir :: Flag FilePath , projectConfigNumJobs :: Flag (Maybe Int) + -- ^ Use 'Just n' for number of jobs, 'Nothing' for number of jobs equal to the number of CPUs and 'NoFlag' if flag is not given. , projectConfigUseSemaphore :: Flag Bool , projectConfigKeepGoing :: Flag Bool , projectConfigOfflineMode :: Flag Bool @@ -187,6 +191,7 @@ data ProjectConfigShared = ProjectConfigShared , projectConfigConfigFile :: Flag FilePath , projectConfigProjectDir :: Flag FilePath , projectConfigProjectFile :: Flag FilePath + , projectConfigProjectFileParser :: Flag ProjectFileParser , projectConfigIgnoreProject :: Flag Bool , projectConfigHcFlavor :: Flag CompilerFlavor , projectConfigHcPath :: Flag FilePath @@ -237,6 +242,20 @@ data ProjectConfigShared = ProjectConfigShared } deriving (Eq, Show, Generic) +data ProjectFileParser + = LegacyParser + | ParsecParser + | FallbackParser + | CompareParser + deriving (Eq, Show, Generic) + +defaultProjectFileParser :: ProjectFileParser +#ifdef LEGACY_COMPARISON +defaultProjectFileParser = CompareParser +#else +defaultProjectFileParser = FallbackParser +#endif + -- | Specifies the provenance of project configuration, whether defaults were -- used or if the configuration was read from an explicit file path. data ProjectConfigProvenance @@ -327,12 +346,14 @@ instance Binary ProjectConfigBuildOnly instance Binary ProjectConfigShared instance Binary ProjectConfigProvenance instance Binary PackageConfig +instance Binary ProjectFileParser instance Structured ProjectConfig instance Structured ProjectConfigBuildOnly instance Structured ProjectConfigShared instance Structured ProjectConfigProvenance instance Structured PackageConfig +instance Structured ProjectFileParser -- | Newtype wrapper for 'Map' that provides a 'Monoid' instance that takes -- the last value rather than the first value for overlapping keys. diff --git a/cabal-install/src/Distribution/Client/ProjectFlags.hs b/cabal-install/src/Distribution/Client/ProjectFlags.hs index 29b964bb99b..9214b6a37cf 100644 --- a/cabal-install/src/Distribution/Client/ProjectFlags.hs +++ b/cabal-install/src/Distribution/Client/ProjectFlags.hs @@ -10,9 +10,10 @@ module Distribution.Client.ProjectFlags ) where import Distribution.Client.Compat.Prelude +import Distribution.Client.ProjectConfig.Types (ProjectFileParser (..), defaultProjectFileParser) import Prelude () -import Distribution.ReadE (succeedReadE) +import Distribution.ReadE (ReadE (..), succeedReadE) import Distribution.Simple.Command ( MkOptDescr , OptionField (optionName) @@ -47,6 +48,8 @@ data ProjectFlags = ProjectFlags , flagIgnoreProject :: Flag Bool -- ^ Whether to ignore the local project (i.e. don't search for cabal.project) -- The exact interpretation might be slightly different per command. + , flagProjectFileParser :: Flag ProjectFileParser + -- ^ The parser to use for the project file. } deriving (Show, Generic) @@ -56,7 +59,8 @@ defaultProjectFlags = { flagProjectDir = mempty , flagProjectFile = mempty , flagIgnoreProject = toFlag False - -- Should we use 'Last' here? + , -- Should we use 'Last' here? + flagProjectFileParser = mempty } projectFlagsOptions :: ShowOrParseArgs -> [OptionField ProjectFlags] @@ -88,8 +92,32 @@ projectFlagsOptions showOrParseArgs = } ) (yesNoOpt showOrParseArgs) + , option + [] + ["project-file-parser"] + "Set the parser to use for the project file" + flagProjectFileParser + (\pf flags -> flags{flagProjectFileParser = pf}) + (reqArg "PARSER" (fmap Flag $ ReadE parseProjectFileParser) projectFileParserPrinter) ] +parseProjectFileParser :: String -> Either String ProjectFileParser +parseProjectFileParser "legacy" = pure LegacyParser +parseProjectFileParser "fallback" = pure FallbackParser +parseProjectFileParser "default" = pure defaultProjectFileParser +parseProjectFileParser "parsec" = pure ParsecParser +parseProjectFileParser "compare" = pure CompareParser +parseProjectFileParser _ = Left "Invalid project file parser" + +projectFileParserPrinter :: Flag ProjectFileParser -> [String] +projectFileParserPrinter (Flag parser) = + case parser of + LegacyParser -> ["legacy"] + FallbackParser -> ["fallback"] + ParsecParser -> ["parsec"] + CompareParser -> ["compare"] +projectFileParserPrinter NoFlag = [] + -- | As almost all commands use 'ProjectFlags' but not all can honour -- "ignore-project" flag, provide this utility to remove the flag -- parsing from the help message. diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index fbd4f758d67..d30a553a4bb 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -122,6 +122,7 @@ import Distribution.Client.JobControl import Distribution.Client.PackageHash import Distribution.Client.ProjectConfig import Distribution.Client.ProjectConfig.Legacy +import Distribution.Client.ProjectConfig.Types (defaultProjectFileParser) import Distribution.Client.ProjectPlanOutput import Distribution.Client.ProjectPlanning.SetupPolicy ( NonSetupLibDepSolverPlanPackage (..) @@ -380,6 +381,7 @@ rebuildProjectConfig ( configPath , distProjectFile "" , (projectConfigHcFlavor, projectConfigHcPath, projectConfigHcPkg) + , projectConfigProjectFileParser , progsearchpath , packageConfigProgramPaths , packageConfigProgramPathExtra @@ -412,7 +414,7 @@ rebuildProjectConfig return (projectConfig <> cliConfig, localPackages) where - ProjectConfigShared{projectConfigHcFlavor, projectConfigHcPath, projectConfigHcPkg, projectConfigIgnoreProject, projectConfigConfigFile} = + ProjectConfigShared{projectConfigHcFlavor, projectConfigHcPath, projectConfigHcPkg, projectConfigProjectFileParser, projectConfigIgnoreProject, projectConfigConfigFile} = projectConfigShared cliConfig PackageConfig{packageConfigProgramPaths, packageConfigProgramPathExtra} = @@ -420,10 +422,12 @@ rebuildProjectConfig -- Read the cabal.project (or implicit config) and combine it with -- arguments from the command line + + configFileParser = fromFlagOrDefault defaultProjectFileParser projectConfigProjectFileParser -- phaseReadProjectConfig :: Rebuild ProjectConfigSkeleton phaseReadProjectConfig = do - readProjectConfig verbosity httpTransport projectConfigIgnoreProject projectConfigConfigFile distDirLayout + readProjectConfig verbosity configFileParser httpTransport projectConfigIgnoreProject projectConfigConfigFile distDirLayout -- Look for all the cabal packages in the project -- some of which may be local src dirs, tarballs etc diff --git a/cabal-install/src/Distribution/Client/ScriptUtils.hs b/cabal-install/src/Distribution/Client/ScriptUtils.hs index 87c36280503..1c78d537c19 100644 --- a/cabal-install/src/Distribution/Client/ScriptUtils.hs +++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs @@ -477,7 +477,7 @@ updateContextAndWriteProjectFile ctx scriptPath scriptExecutable = do updateContextAndWriteProjectFile' ctx sourcePackage -parseScriptBlock :: BS.ByteString -> ParseResult Executable +parseScriptBlock :: BS.ByteString -> ParseResult src Executable parseScriptBlock str = case readFields str of Right fs -> do diff --git a/cabal-install/src/Distribution/Client/Types/AllowNewer.hs b/cabal-install/src/Distribution/Client/Types/AllowNewer.hs index 0a5700174b8..53c55ef08b6 100644 --- a/cabal-install/src/Distribution/Client/Types/AllowNewer.hs +++ b/cabal-install/src/Distribution/Client/Types/AllowNewer.hs @@ -101,6 +101,12 @@ instance Pretty RelaxedDep where instance Parsec RelaxedDep where parsec = P.char '*' *> relaxedDepStarP <|> (parsec >>= relaxedDepPkgidP) +instance Parsec AllowOlder where + parsec = AllowOlder <$> parsec + +instance Parsec AllowNewer where + parsec = AllowNewer <$> parsec + -- continuation after * relaxedDepStarP :: CabalParsing m => m RelaxedDep relaxedDepStarP = diff --git a/cabal-install/src/Distribution/Client/Types/Repo.hs b/cabal-install/src/Distribution/Client/Types/Repo.hs index 83ecc454863..d3caac872db 100644 --- a/cabal-install/src/Distribution/Client/Types/Repo.hs +++ b/cabal-install/src/Distribution/Client/Types/Repo.hs @@ -4,6 +4,10 @@ module Distribution.Client.Types.Repo ( -- * Remote repository RemoteRepo (..) , emptyRemoteRepo + , remoteRepoKeyThresholdLens + , remoteRepoRootKeysLens + , remoteRepoSecureLens + , remoteRepoURILens -- * Local repository (no-index) , LocalRepo (..) @@ -17,6 +21,7 @@ module Distribution.Client.Types.Repo , maybeRepoRemote -- * Windows + , asPosixPath , normaliseFileNoIndexURI ) where @@ -29,6 +34,7 @@ import Distribution.Simple.Utils (toUTF8BS) import Distribution.System (OS (Windows)) import Distribution.Client.HashValue (hashValue, showHashValue, truncateHash) +import Distribution.Compat.Lens import qualified Data.ByteString.Lazy.Char8 as LBS import qualified Distribution.Compat.CharParsing as P @@ -97,6 +103,22 @@ instance Parsec RemoteRepo where emptyRemoteRepo :: RepoName -> RemoteRepo emptyRemoteRepo name = RemoteRepo name nullURI Nothing [] 0 False +remoteRepoURILens :: Lens' RemoteRepo URI +remoteRepoURILens f s = fmap (\x -> s{remoteRepoURI = x}) (f (remoteRepoURI s)) +{-# INLINE remoteRepoURILens #-} + +remoteRepoSecureLens :: Lens' RemoteRepo (Maybe Bool) +remoteRepoSecureLens f s = fmap (\x -> s{remoteRepoSecure = x}) (f (remoteRepoSecure s)) +{-# INLINE remoteRepoSecureLens #-} + +remoteRepoRootKeysLens :: Lens' RemoteRepo [String] +remoteRepoRootKeysLens f s = fmap (\x -> s{remoteRepoRootKeys = x}) (f (remoteRepoRootKeys s)) +{-# INLINE remoteRepoRootKeysLens #-} + +remoteRepoKeyThresholdLens :: Lens' RemoteRepo Int +remoteRepoKeyThresholdLens f s = fmap (\x -> s{remoteRepoKeyThreshold = x}) (f (remoteRepoKeyThreshold s)) +{-# INLINE remoteRepoKeyThresholdLens #-} + ------------------------------------------------------------------------------- -- Local repository ------------------------------------------------------------------------------- @@ -230,8 +252,10 @@ normaliseFileNoIndexURI os uri@(URI scheme _auth path query fragment) , Windows <- os = URI scheme Nothing (asPosixPath path) query fragment | otherwise = uri - where - asPosixPath p = - -- We don't use 'isPathSeparator' because @Windows.isPathSeparator - -- Posix.pathSeparator == True@. - [if x == Windows.pathSeparator then Posix.pathSeparator else x | x <- p] + +-- | Convert a path to POSIX-style. +asPosixPath :: FilePath -> FilePath +asPosixPath p = + -- We don't use 'isPathSeparator' because @Windows.isPathSeparator + -- Posix.pathSeparator == True@. + [if x == Windows.pathSeparator then Posix.pathSeparator else x | x <- p] diff --git a/cabal-install/src/Distribution/Client/Types/WriteGhcEnvironmentFilesPolicy.hs b/cabal-install/src/Distribution/Client/Types/WriteGhcEnvironmentFilesPolicy.hs index 042b62d997a..6db210025ee 100644 --- a/cabal-install/src/Distribution/Client/Types/WriteGhcEnvironmentFilesPolicy.hs +++ b/cabal-install/src/Distribution/Client/Types/WriteGhcEnvironmentFilesPolicy.hs @@ -5,6 +5,8 @@ module Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy ) where import Distribution.Client.Compat.Prelude +import qualified Distribution.Compat.CharParsing as P +import Distribution.Parsec import Prelude () -- | Whether 'v2-build' should write a .ghc.environment file after @@ -19,3 +21,16 @@ data WriteGhcEnvironmentFilesPolicy instance Binary WriteGhcEnvironmentFilesPolicy instance Structured WriteGhcEnvironmentFilesPolicy + +instance Parsec WriteGhcEnvironmentFilesPolicy where + parsec = do + token <- parsecToken + case token of + "always" -> return AlwaysWriteGhcEnvironmentFiles + "never" -> return NeverWriteGhcEnvironmentFiles + "ghc8.4.4+" -> return WriteGhcEnvironmentFilesOnlyForGhc844AndNewer + policy -> + P.unexpected $ + "Cannot parse the GHC environment file write policy '" + <> policy + <> "'" diff --git a/cabal-install/src/Distribution/Client/Utils/Newtypes.hs b/cabal-install/src/Distribution/Client/Utils/Newtypes.hs new file mode 100644 index 00000000000..aa60eea697c --- /dev/null +++ b/cabal-install/src/Distribution/Client/Utils/Newtypes.hs @@ -0,0 +1,120 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +-- | This module provides @newtype@ wrappers to be used with "Distribution.FieldGrammar". +-- Whenever we can not provide a Parsec instance for a type, we need to wrap it in a newtype and define the instance. +module Distribution.Client.Utils.Newtypes + ( NumJobs (..) + , PackageDBNT (..) + , AllowNewerNT (..) + , AllowOlderNT (..) + , ProjectConstraints (..) + , MaxBackjumps (..) + , URI_NT (..) + , KeyThreshold (..) + ) +where + +import Distribution.Client.Compat.Prelude +import Distribution.Client.Targets (UserConstraint) +import Distribution.Client.Types.AllowNewer (AllowNewer (..), AllowOlder (..)) +import Distribution.Compat.CharParsing +import Distribution.Compat.Newtype +import Distribution.Parsec +import Distribution.Simple.Compiler (PackageDBCWD, interpretPackageDB, readPackageDb) +import Distribution.Solver.Types.ConstraintSource (ConstraintSource (..)) +import Network.URI (URI, parseURI) + +newtype PackageDBNT = PackageDBNT {getPackageDBNT :: Maybe PackageDBCWD} + +instance Newtype (Maybe PackageDBCWD) PackageDBNT + +instance Parsec PackageDBNT where + parsec = parsecPackageDB + +parsecPackageDB :: CabalParsing m => m PackageDBNT +parsecPackageDB = PackageDBNT . fmap (interpretPackageDB Nothing) . readPackageDb <$> parsecToken + +newtype NumJobs = NumJobs {getNumJobs :: Maybe Int} + +instance Newtype (Maybe Int) NumJobs + +instance Parsec NumJobs where + parsec = parsecNumJobs + +parsecNumJobs :: CabalParsing m => m NumJobs +parsecNumJobs = ncpus <|> numJobs + where + ncpus = string "$ncpus" >> return (NumJobs Nothing) + numJobs = do + num <- integral + if num < (1 :: Int) + then do + parsecWarning PWTOther "The number of jobs should be 1 or more." + return (NumJobs Nothing) + else return (NumJobs $ Just num) + +newtype URI_NT = URI_NT {getURI_NT :: URI} + +instance Newtype (URI) URI_NT + +instance Parsec URI_NT where + parsec = parsecURI_NT + +parsecURI_NT :: CabalParsing m => m URI_NT +parsecURI_NT = do + token <- parsecToken' + case parseURI token of + Nothing -> fail $ "failed to parse URI " <> token + Just uri -> return $ URI_NT uri + +newtype KeyThreshold = KeyThreshold {getKeyThreshold :: Int} + +instance Newtype Int KeyThreshold + +instance Parsec KeyThreshold where + parsec = KeyThreshold <$> integral + +newtype ProjectConstraints = ProjectConstraints {getProjectConstraints :: (UserConstraint, ConstraintSource)} + +instance Newtype (UserConstraint, ConstraintSource) ProjectConstraints + +instance Parsec ProjectConstraints where + parsec = parsecProjectConstraints + +-- | Parse 'ProjectConstraints'. As the 'CabalParsing' class does not have access to the file we parse, +-- ConstraintSource is first unknown and we set it afterwards +parsecProjectConstraints :: CabalParsing m => m ProjectConstraints +parsecProjectConstraints = do + userConstraint <- parsec + return $ ProjectConstraints (userConstraint, ConstraintSourceUnknown) + +newtype MaxBackjumps = MaxBackjumps {getMaxBackjumps :: Int} + +instance Newtype Int MaxBackjumps + +instance Parsec MaxBackjumps where + parsec = parseMaxBackjumps + +parseMaxBackjumps :: CabalParsing m => m MaxBackjumps +parseMaxBackjumps = MaxBackjumps <$> integral + +newtype AllowNewerNT = AllowNewerNT {getAllowNewerNT :: Maybe AllowNewer} + +instance Newtype (Maybe AllowNewer) AllowNewerNT + +instance Parsec AllowNewerNT where + parsec = parsecAllowNewer + +parsecAllowNewer :: CabalParsing m => m AllowNewerNT +parsecAllowNewer = AllowNewerNT . Just <$> parsec + +newtype AllowOlderNT = AllowOlderNT {getAllowOlderNT :: Maybe AllowOlder} + +instance Newtype (Maybe AllowOlder) AllowOlderNT + +instance Parsec AllowOlderNT where + parsec = parsecAllowOlder + +parsecAllowOlder :: CabalParsing m => m AllowOlderNT +parsecAllowOlder = AllowOlderNT . Just <$> parsec diff --git a/cabal-install/src/Distribution/Client/Utils/Parsec.hs b/cabal-install/src/Distribution/Client/Utils/Parsec.hs index abc9ddd1321..d7fcbf4778d 100644 --- a/cabal-install/src/Distribution/Client/Utils/Parsec.hs +++ b/cabal-install/src/Distribution/Client/Utils/Parsec.hs @@ -1,105 +1,90 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + module Distribution.Client.Utils.Parsec - ( renderParseError + ( remoteRepoGrammar + + -- ** Flag + , alaFlag + , Flag' + + -- ** NubList + , alaNubList + , alaNubList' + , NubList' + + -- ** Newtype wrappers + , module Distribution.Client.Utils.Newtypes ) where import Distribution.Client.Compat.Prelude -import System.FilePath (normalise) +import Distribution.Compat.Newtype import Prelude () -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BS8 - -import Distribution.Parsec (PError (..), PWarning (..), Position (..), showPos, zeroPos) -import Distribution.Simple.Utils (fromUTF8BS) - --- | Render parse error highlighting the part of the input file. -renderParseError - :: FilePath - -> BS.ByteString - -> NonEmpty PError - -> [PWarning] - -> String -renderParseError filepath contents errors warnings = - unlines $ - [ "Errors encountered when parsing cabal file " <> filepath <> ":" - ] - ++ renderedErrors - ++ renderedWarnings - where - filepath' = normalise filepath - - -- lines of the input file. 'lines' is taken, so they are called rows - -- contents, line number, whether it's empty line - rows :: [(String, Int, Bool)] - rows = zipWith f (BS8.lines contents) [1 ..] - where - f bs i = let s = fromUTF8BS bs in (s, i, isEmptyOrComment s) - - rowsZipper = listToZipper rows - - isEmptyOrComment :: String -> Bool - isEmptyOrComment s = case dropWhile (== ' ') s of - "" -> True -- empty - ('-' : '-' : _) -> True -- comment - _ -> False - - renderedErrors = concatMap renderError errors - renderedWarnings = concatMap renderWarning warnings - - renderError :: PError -> [String] - renderError (PError pos@(Position row col) msg) - -- if position is 0:0, then it doesn't make sense to show input - -- looks like, Parsec errors have line-feed in them - | pos == zeroPos = msgs - | otherwise = msgs ++ formatInput row col - where - msgs = ["", filepath' ++ ":" ++ showPos pos ++ ": error:", trimLF msg, ""] - - renderWarning :: PWarning -> [String] - renderWarning (PWarning _ pos@(Position row col) msg) - | pos == zeroPos = msgs - | otherwise = msgs ++ formatInput row col - where - msgs = ["", filepath' ++ ":" ++ showPos pos ++ ": warning:", trimLF msg, ""] - - -- sometimes there are (especially trailing) newlines. - trimLF :: String -> String - trimLF = dropWhile (== '\n') . reverse . dropWhile (== '\n') . reverse - - -- format line: prepend the given line number - formatInput :: Int -> Int -> [String] - formatInput row col = case advance (row - 1) rowsZipper of - Zipper xs ys -> before ++ after - where - before = case span (\(_, _, b) -> b) xs of - (_, []) -> [] - (zs, z : _) -> map formatInputLine $ z : reverse zs - - after = case ys of - [] -> [] - (z : _zs) -> - [ formatInputLine z -- error line - , " | " ++ replicate (col - 1) ' ' ++ "^" -- pointer: ^ - ] - -- do we need rows after? - -- ++ map formatInputLine (take 1 zs) -- one row after - - formatInputLine :: (String, Int, Bool) -> String - formatInputLine (str, row, _) = leftPadShow row ++ " | " ++ str - - -- hopefully we don't need to work with over 99999 lines .cabal files - -- at that point small glitches in error messages are hopefully fine. - leftPadShow :: Int -> String - leftPadShow n = let s = show n in replicate (5 - length s) ' ' ++ s - -data Zipper a = Zipper [a] [a] - -listToZipper :: [a] -> Zipper a -listToZipper = Zipper [] - -advance :: Int -> Zipper a -> Zipper a -advance n z@(Zipper xs ys) - | n <= 0 = z - | otherwise = case ys of - [] -> z - (y : ys') -> advance (n - 1) $ Zipper (y : xs) ys' +import Distribution.Client.Types.Repo +import Distribution.Client.Types.RepoName +import Distribution.Client.Utils.Newtypes +import Distribution.FieldGrammar +import Distribution.Simple.Flag +import Distribution.Utils.NubList (NubList (..)) +import qualified Distribution.Utils.NubList as NubList + +-- | Like 'List' for usage with a 'FieldGrammar', but for 'Flag'. +-- This enables to parse type aliases such as 'FilePath' that do not have 'Parsec' instances +-- by using newtype variants such as 'FilePathNT'. +-- For example, if you need to parse a 'Flag FilePath', you can use 'alaFlag' FilePathNT'. +newtype Flag' b a = Flag' {_getFlag :: Flag a} + +-- | 'Flag'' constructor, with additional phantom argument to constrain the resulting type +alaFlag :: (a -> b) -> Flag a -> Flag' b a +alaFlag _ = Flag' + +instance Newtype (Flag a) (Flag' wrapper a) + +instance (Newtype a b, Parsec b) => Parsec (Flag' b a) where + parsec = pack . toFlag . (unpack :: b -> a) <$> parsec + +instance (Newtype a b, Pretty b) => Pretty (Flag' b a) where + pretty = pretty . (pack :: a -> b) . fromFlag . unpack + +-- | Like 'List' for usage with a 'FieldGrammar', but for 'NubList'. +newtype NubList' sep b a = NubList' {_getNubList :: NubList a} + +-- | 'alaNubList' and 'alaNubList'' are simply 'NubList'' constructor, with additional phantom +-- arguments to constrain the resulting type +-- +-- >>> :t alaNubList VCat +-- alaNubList VCat :: NubList a -> NubList' VCat (Identity a) a +-- +-- >>> :t alaNubList' FSep Token +-- alaNubList' FSep Token +-- :: NubList String -> NubList' FSep Token String +-- +-- >>> unpack' (alaNubList' FSep Token) <$> eitherParsec "foo bar foo" +-- Right ["foo","bar"] +alaNubList :: sep -> NubList a -> NubList' sep (Identity a) a +alaNubList _ = NubList' + +-- | More general version of 'alaNubList'. +alaNubList' :: sep -> (a -> b) -> NubList a -> NubList' sep b a +alaNubList' _ _ = NubList' + +instance Newtype (NubList a) (NubList' sep wrapper a) + +instance (Newtype a b, Ord a, Sep sep, Parsec b) => Parsec (NubList' sep b a) where + parsec = pack . NubList.toNubList . map (unpack :: b -> a) <$> parseSep (Proxy :: Proxy sep) parsec + +instance (Newtype a b, Sep sep, Pretty b) => Pretty (NubList' sep b a) where + pretty = prettySep (Proxy :: Proxy sep) . map (pretty . (pack :: a -> b)) . NubList.fromNubList . unpack + +remoteRepoGrammar :: RepoName -> ParsecFieldGrammar RemoteRepo RemoteRepo +remoteRepoGrammar name = + RemoteRepo + <$> pure name + <*> uniqueFieldAla "url" URI_NT remoteRepoURILens + <*> optionalField "secure" remoteRepoSecureLens + <*> monoidalFieldAla "root-keys" (alaList' FSep Token) remoteRepoRootKeysLens + <*> optionalFieldDefAla "key-threshold" KeyThreshold remoteRepoKeyThresholdLens 0 + <*> pure False -- we don't parse remoteRepoShouldTryHttps diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs index bf69b20ee04..caee779671b 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs @@ -606,6 +606,7 @@ instance Arbitrary ProjectConfigShared where projectConfigConfigFile <- arbitraryFlag arbitraryShortToken projectConfigProjectDir <- arbitraryFlag arbitraryShortToken projectConfigProjectFile <- arbitraryFlag arbitraryShortToken + projectConfigProjectFileParser <- arbitraryFlag arbitrary projectConfigIgnoreProject <- arbitrary projectConfigHcFlavor <- arbitrary projectConfigHcPath <- arbitraryFlag arbitraryShortToken @@ -652,6 +653,7 @@ instance Arbitrary ProjectConfigShared where <*> shrinker projectConfigConfigFile <*> shrinker projectConfigProjectDir <*> shrinker projectConfigProjectFile + <*> shrinker projectConfigProjectFileParser <*> shrinker projectConfigIgnoreProject <*> shrinker projectConfigHcFlavor <*> shrinkerAla (fmap NonEmpty) projectConfigHcPath @@ -691,6 +693,9 @@ instance Arbitrary ProjectConfigShared where projectConfigConstraintSource :: ConstraintSource projectConfigConstraintSource = ConstraintSourceProjectConfig nullProjectConfigPath +instance Arbitrary ProjectFileParser where + arbitrary = elements [ParsecParser, LegacyParser, FallbackParser, CompareParser] + instance Arbitrary ProjectConfigProvenance where arbitrary = elements [Implicit, Explicit (ProjectConfigPath $ "cabal.project" :| [])] diff --git a/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs b/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs index 179fef5688a..ef4f9fb7c9f 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs @@ -63,6 +63,7 @@ instance ToExpr ProjectConfig instance ToExpr ProjectConfigBuildOnly instance ToExpr ProjectConfigProvenance instance ToExpr ProjectConfigShared +instance ToExpr ProjectFileParser instance ToExpr RelaxDepMod instance ToExpr RelaxDeps instance ToExpr RelaxDepScope diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoName/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoName/cabal.out index 95a718c5798..32c0ffc2a2f 100644 --- a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoName/cabal.out +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoName/cabal.out @@ -1,4 +1,8 @@ # cabal check -Warning: pkg.cabal:0:0: "name" field missing Error: [Cabal-7035] -parse error +Error encountered when parsing cabal file pkg.cabal: + +pkg.cabal:0:0: error: +"name" field missing + + diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoVersion/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoVersion/cabal.out index e2b3c055434..4e01a9cfc38 100644 --- a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoVersion/cabal.out +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoVersion/cabal.out @@ -1,4 +1,8 @@ # cabal check -Warning: pkg.cabal:0:0: "version" field missing Error: [Cabal-7035] -parse error +Error encountered when parsing cabal file pkg.cabal: + +pkg.cabal:0:0: error: +"version" field missing + + diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.out b/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.out index 73d7d091749..a31f6fa12fb 100644 --- a/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.out +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.out @@ -12,54 +12,100 @@ Installing executable some-exe in Warning: The directory /cabal.dist/home/.cabal/store/ghc-/incoming/new-/cabal.dist/home/.cabal/store/ghc-/-/bin is not in the system search path. # 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: [Cabal-7167] +Error encountered when parsing project file cyclical-0-self.project: + +cyclical-0-self.project:3:1: error: +cyclical import of cyclical-0-self.project; + cyclical-0-self.project + imported by: cyclical-0-self.project + + 1 | packages: . + 2 | + 3 | import: 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.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 +Error: [Cabal-7167] +Error encountered when parsing project file cyclical-1-out-back.config: + imported by: cyclical-1-out-back.project + +cyclical-1-out-back.config:1:1: error: +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 + + 1 | import: 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.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 +Error: [Cabal-7167] +Error encountered when parsing project file cyclical-1-out-self.config: + imported by: cyclical-1-out-self.project + +cyclical-1-out-self.config:1:1: error: +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 + + 1 | import: cyclical-1-out-self.config + | ^ + # checking cyclical with hops; out, out, twice back # cabal v2-build -Error: [Cabal-7090] -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 +Error: [Cabal-7167] +Error encountered when parsing project file cyclical-2-out-out-backback-b.config: + imported by: cyclical-2-out-out-backback-a.config + imported by: cyclical-2-out-out-backback.project + +cyclical-2-out-out-backback-b.config:1:1: error: +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 + + 1 | import: 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-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 +Error: [Cabal-7167] +Error encountered when parsing project file cyclical-2-out-out-back-b.config: + imported by: cyclical-2-out-out-back-a.config + imported by: cyclical-2-out-out-back.project + +cyclical-2-out-out-back-b.config:1:1: error: +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 + + 1 | import: cyclical-2-out-out-back-a.config + | ^ + # 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-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 +Error: [Cabal-7167] +Error encountered when parsing project file cyclical-2-out-out-self-b.config: + imported by: cyclical-2-out-out-self-a.config + imported by: cyclical-2-out-out-self.project + +cyclical-2-out-out-self-b.config:1:1: error: +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 + + 1 | import: cyclical-2-out-out-self-b.config + | ^ + # 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 Resolving dependencies... @@ -74,31 +120,55 @@ Building library for my-0.1... 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 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 +Error: [Cabal-7167] +Error encountered when parsing project file 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 + +same-filename/cyclical-same-filename-out-out-self.config:1:1: error: +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 + + 1 | import: cyclical-same-filename-out-out-self.config + | ^ + # checking that cyclical check catches importing its importer (with the same file name) # cabal v2-build -Error: [Cabal-7090] -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 +Error: [Cabal-7167] +Error encountered when parsing project file 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 + +same-filename/cyclical-same-filename-out-out-backback.config:1:1: error: +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 + + 1 | import: ../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 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 +Error: [Cabal-7167] +Error encountered when parsing project file 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 + +same-filename/cyclical-same-filename-out-out-back.config:1:1: error: +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 + + 1 | import: ../cyclical-same-filename-out-out-back.config + | ^ + # checking that imports work skipping into a subfolder and then back out again and again # cabal v2-build Up to date @@ -129,8 +199,12 @@ After searching the rest of the dependency tree exhaustively, these were the goa Up to date # checking bad conditional # 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 +Error: [Cabal-7167] +Error encountered when parsing project file bad-conditional.project: + +bad-conditional.project:0:0: error: +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/IndexCabalFileParseError/cabal.out b/cabal-testsuite/PackageTests/IndexCabalFileParseError/cabal.out index 8d891bd421e..8f2609456ba 100644 --- a/cabal-testsuite/PackageTests/IndexCabalFileParseError/cabal.out +++ b/cabal-testsuite/PackageTests/IndexCabalFileParseError/cabal.out @@ -1,6 +1,6 @@ # cabal v2-update Downloading the latest package list from test-local-repo -Warning: In /cabal.dist/repo/my-lib-1.0.tar.gz: Errors encountered when parsing cabal file my-lib-1.0/my-lib.cabal: +Warning: In /cabal.dist/repo/my-lib-1.0.tar.gz: Error encountered when parsing cabal file my-lib-1.0/my-lib.cabal: my-lib-1.0/my-lib.cabal:4:22: error: unexpected Unknown SPDX license identifier: 'puppy' @@ -15,5 +15,6 @@ Unknown field: "puppy" 4 | license: puppy license :) 5 | puppy: teehee! | ^ + Error: [Cabal-7046] Failed to read my-lib-1.0/my-lib.cabal from archive /cabal.dist/repo/my-lib-1.0.tar.gz diff --git a/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.out b/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.out index b94b99a9a08..17e4efd7a0e 100644 --- a/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.out +++ b/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.out @@ -1,4 +1,13 @@ # 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: [Cabal-7167] +Error encountered when parsing project file cabal.project: + +cabal.project:4:1: error: +'source-repository-package' is a stanza, not a field. Remove the trailing ':' to parse a stanza. + + 1 | packages: . + 2 | + 3 | -- This is an error; a trailing `:` is syntax for a field, not a stanza! + 4 | source-repository-package: + | ^ + diff --git a/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.test.hs b/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.test.hs index 39636819157..07abb78a40c 100644 --- a/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.test.hs +++ b/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.test.hs @@ -2,5 +2,5 @@ import Test.Cabal.Prelude main = cabalTest $ do result <- fails $ cabal' "build" [] - assertOutputContains "Error parsing project file" result + assertOutputContains "Error encountered when parsing project file" result assertOutputContains "'source-repository-package' is a stanza, not a field." result diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.out b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.out index d3c6ddb66c6..3949eaa47d6 100644 --- a/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.out +++ b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.out @@ -1,25 +1,39 @@ # cabal v2-build Warnings found while parsing the project file, else.project: - - dir-else/else.config: Unrecognized section '_' on line 3 + - dir-else/else.config:3:5: Invalid subsection "_" # 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) "_" +Error: [Cabal-7167] +Error encountered when parsing project file cabal.project: + +cabal.project:3:4: error: +unexpected SecArgName (Position 3 4) "_" + + 3 | if _ + | ^ + # 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) "_" +Error: [Cabal-7167] +Error encountered when parsing project file dir-if/if.config: + imported by: if.project + +dir-if/if.config:3:4: error: +unexpected SecArgName (Position 3 4) "_" + + 3 | if _ + | ^ + # 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) "_" +Error: [Cabal-7167] +Error encountered when parsing project file dir-elif/elif.config: + imported by: elif.project + +dir-elif/elif.config:4:6: error: +unexpected SecArgName (Position 4 6) "_" + + 3 | if false + 4 | elif _ + | ^ + # cabal v2-build Warnings found while parsing the project file, else.project: - - dir-else/else.config: Unrecognized section '_' on line 3 + - dir-else/else.config:3:5: Invalid subsection "_" diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.test.hs b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.test.hs index ca3bce1c59d..34d06d8f93a 100644 --- a/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.test.hs +++ b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.test.hs @@ -9,20 +9,20 @@ main = cabalTest . recordMode RecordMarked $ do outDefault <- fails $ cabal' "v2-build" [ "all", "--dry-run", "--project-file=cabal.project" ] - assertOutputContains "Error parsing project file cabal.project:3" outDefault + assertOutputContains "cabal.project:3:4: error:" 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 (normalizeWindowsOutput "dir-if/if.config:3:4: error:") 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 (normalizeWindowsOutput "dir-elif/elif.config:4:6: error:") 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 (normalizeWindowsOutput "- dir-else/else.config:3:5: Invalid subsection \"_\"") outElse assertOutputContains "When using configuration from:" outElse return () diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/cabal.out b/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/cabal.out index 90265370e7a..6fb7a1906b3 100644 --- a/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/cabal.out +++ b/cabal-testsuite/PackageTests/ProjectImport/ParseWarningProvenance/cabal.out @@ -1,10 +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 + - dir-x/a.config:1:1: Invalid subsection "-" + - dir-x/a.config:2:1: Invalid subsection "-" + - dir-x/a.config:3:1: Invalid subsection "-" + - dir-y/a.config:123:1: Invalid subsection "-" + - x.config:1:1: Invalid subsection "-" + - x.config:2:1: Invalid subsection "-" + - x.config:3:1: Invalid subsection "-" + - y.config:123:1: Invalid subsection "-" diff --git a/cabal-testsuite/PackageTests/Regression/T5213/cabal.out b/cabal-testsuite/PackageTests/Regression/T5213/cabal.out index fb0e7ad7a9a..bcbb8421e34 100644 --- a/cabal-testsuite/PackageTests/Regression/T5213/cabal.out +++ b/cabal-testsuite/PackageTests/Regression/T5213/cabal.out @@ -1,4 +1,6 @@ # cabal new-test +Warnings found while parsing the project file, cabal.project: + - cabal.project:4:3: The field "library-coverage" is deprecated in the Cabal specification version 1.22. Please use 'coverage' field instead. Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal-testsuite/PackageTests/Regression/T5213/cabal.project b/cabal-testsuite/PackageTests/Regression/T5213/cabal.project index e1c33e00303..45f18c1f5cb 100644 --- a/cabal-testsuite/PackageTests/Regression/T5213/cabal.project +++ b/cabal-testsuite/PackageTests/Regression/T5213/cabal.project @@ -1,4 +1,4 @@ packages: . package cabal-gh5213 - library-coverage: true + library-coverage: True diff --git a/cabal-validate/src/Main.hs b/cabal-validate/src/Main.hs index bf5e30a26c2..a9ab2bc8db4 100644 --- a/cabal-validate/src/Main.hs +++ b/cabal-validate/src/Main.hs @@ -359,6 +359,14 @@ cliTests opts = do ++ tastyArgs opts ) + timedCabalBin + opts + "cabal-install" + "test:parser-tests" + ( jobsArgs opts + ++ tastyArgs opts + ) + timedCabalBin opts "cabal-install" diff --git a/cabal.validate.project b/cabal.validate.project index 5075458c1b8..2fbc461042b 100644 --- a/cabal.validate.project +++ b/cabal.validate.project @@ -9,6 +9,8 @@ program-options ghc-options: -Werror -- if you are developing on a system without TH, use a `cabal.validate.project.local` --- to disable this +-- to disable the git-rev flag. +-- The +legacy-comparision flag is to set the default project file parser to compare +-- the result of the legacy and parsec parser and fail if they are not equal. package cabal-install - flags: +git-rev + flags: +git-rev +legacy-comparison diff --git a/changelog.d/pr-8889 b/changelog.d/pr-8889 new file mode 100644 index 00000000000..0c3ec7ce79d --- /dev/null +++ b/changelog.d/pr-8889 @@ -0,0 +1,27 @@ +synopsis: Replace cabal project parsing with parsec parser +packages: cabal-install Cabal Cabal-syntax +prs: #8889 +issues: #6101 #7748 +significance: significant + +description: { + +Replaced the legacy cabal.project parser with a new implementation based on the same +parsing infrastructure as cabal files. + +The new parser replicates the grammar of the legacy parser, ensuring that it generates identical `ProjectConfig` values. +The implementation leverages existing Parsec infrastructure, including FieldGrammar and other utilities from the .cabal file parser. +The error messages are now more accurate and include the line and column of the error. + +There is a new flag `--project-file-parser=` which can be used to select the parser to use. + +* `legacy` - the old parser +* `default` - the default, by default the `fallback` strategy is used unless you have compiled `cabal-install` with `-f+legacy-comparison`. +* `parsec` - the new parser using parsec +* `fallback` - the new parser using parsec, but falling back to the old parser if it fails +* `compare` - the new parser using parsec, but comparing the results with the old parser + +In the next release we plan to remove the legacy parser. + + +} diff --git a/doc/cabal-project-description-file.rst b/doc/cabal-project-description-file.rst index 7b9bd5d5241..adae4514b14 100644 --- a/doc/cabal-project-description-file.rst +++ b/doc/cabal-project-description-file.rst @@ -413,6 +413,22 @@ package, and thus apply globally: This option can only be specified from the command line. +.. _cmdoption-project-file-parser: +.. option:: --project-file-parser=PARSER + + :since: 3.18 + + Specifies the parser to use for reading the project file. The available + parsers are: + + * ``legacy`` - the old parser (will be removed in a future release) + * ``default`` - the default parser (uses ``fallback`` unless compiled with ``-f+legacy-comparison``) + * ``parsec`` - the new parser using Parsec + * ``fallback`` - the new parser using Parsec, but falling back to the old parser if it fails + * ``compare`` - the new parser using Parsec, but comparing the results with the old parser + + This option can only be specified from the command line. + .. option:: -z, --ignore-project Ignores the local ``cabal.project`` file and uses the default @@ -1824,7 +1840,7 @@ Advanced global configuration options ``--build-summary=TEMPLATE``. Undocumented fields: ``root-cmd``, ``symlink-bindir``, ``build-log``, -``remote-build-reporting``, ``report-planned-failure``, ``offline``. +``remote-build-reporting``, ``report-planning-failure``, ``offline``. Advanced solver options ^^^^^^^^^^^^^^^^^^^^^^^ From f548cef9cd79b3edd5d0e91c8e7e77261b82e6a1 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Tue, 22 Jul 2025 11:07:04 +0100 Subject: [PATCH 2/2] Error messages: Tweak how parse errors from parsec parser are displayed * Error messages are indented by 2 spaces * 0:0 positions are never shown * More attempts are made to remove extra newlines. --- .../src/Distribution/Client/Errors/Parser.hs | 57 ++++--- .../src/Distribution/Client/ProjectFlags.hs | 3 +- .../ConfiguredPackage/Sanity/NoName/cabal.out | 6 +- .../Sanity/NoVersion/cabal.out | 6 +- .../ConditionalAndImport/cabal.out | 146 +++++++++--------- .../IndexCabalFileParseError/cabal.out | 22 +-- .../FieldStanzaConfusion/cabal.out | 14 +- .../FieldStanzaConfusion/cabal.test.hs | 2 +- .../ParseErrorProvenance/cabal.out | 26 ++-- 9 files changed, 149 insertions(+), 133 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Errors/Parser.hs b/cabal-install/src/Distribution/Client/Errors/Parser.hs index b2e19397925..9b917db9886 100644 --- a/cabal-install/src/Distribution/Client/Errors/Parser.hs +++ b/cabal-install/src/Distribution/Client/Errors/Parser.hs @@ -154,7 +154,7 @@ renderInstalledPackageInfoSourceMsgs PInstalledPackageInfo (errors, warnings) = renderParseErrorNoFile :: String -> [PError] -> [PWarning] -> String renderParseErrorNoFile herald errors warnings = - renderParseErrorGeneral herald "" Nothing (const []) errors warnings + renderParseErrorGeneral herald Nothing Nothing (const []) errors warnings -- | Render a parse error which resulted from a file on disk renderParseErrorFile @@ -169,7 +169,7 @@ renderParseErrorFile -> ([PError], [PWarning]) -> String renderParseErrorFile herald filepath provenance contents (errors, warnings) = - renderParseErrorGeneral (herald <> " file " <> filepath) (filepath' <> ":") provenance formatInput errors warnings + renderParseErrorGeneral (herald <> " file " <> filepath) (Just (filepath' <> ":")) provenance formatInput errors warnings where filepath' = normalise filepath @@ -217,8 +217,12 @@ renderParseErrorFile herald filepath provenance contents (errors, warnings) = -- | A generic rendering function which can render from many sources. renderParseErrorGeneral :: String - -> String + -- ^ What we were parsing when the error occurred. + -> Maybe String + -- ^ A simpler/shorter header to display when displaying each error (normally a filepath) -> Maybe String + -- ^ Provenance, used to print additional context about what file failed (used to print the import path of a project + -- file which failed to parse) -> (Position -> [String]) -- ^ Extra information to render based on the position -> [PError] @@ -226,11 +230,12 @@ renderParseErrorGeneral -> String renderParseErrorGeneral header err_header provenance extra_info errors warnings = unlines $ - [ warningsOrErrors <> " encountered when parsing" <> header' <> ":" + [ warningsOrErrors <> " parsing" <> header' <> ":" ] ++ [p | Just p <- [provenance]] - ++ renderedErrors - ++ renderedWarnings + ++ [""] -- Place a newline between the header and the errors/warnings + -- Place a newline between each error and warning + ++ intersperse "" (renderedWarnings ++ renderedErrors) where warningsOrErrors = case errors of [] -> case warnings of @@ -241,24 +246,36 @@ renderParseErrorGeneral header err_header provenance extra_info errors warnings header' = if null header then "" else (" " <> header) - renderedErrors = concatMap renderError (sortBy (comparing perrorPosition) errors) - renderedWarnings = concatMap renderWarning (sortBy (comparing pwarningPosition) warnings) + renderedErrors = map renderError (sortBy (comparing perrorPosition) errors) + renderedWarnings = map renderWarning (sortBy (comparing pwarningPosition) warnings) - renderError :: PError -> [String] - renderError (PError pos msg) + renderErrorOrWarning :: String -> Position -> String -> String + renderErrorOrWarning err_type pos msg -- if position is 0:0, then it doesn't make sense to show input -- looks like, Parsec errors have line-feed in them - | pos == zeroPos = msgs - | otherwise = msgs ++ extra_info pos - where - msgs = ["", err_header ++ showPos pos ++ ": error:", trimLF msg, ""] - - renderWarning :: PWarning -> [String] - renderWarning (PWarning _ pos msg) - | pos == zeroPos = msgs - | otherwise = msgs ++ extra_info pos + | pos == zeroPos = unlines (herald : map indent user_msg) + | otherwise = unlines (herald : map indent (user_msg ++ extra_info pos)) where - msgs = ["", err_header ++ showPos pos ++ ": warning:", trimLF msg, ""] + herald = renderErrorHerald pos ++ err_type ++ ":" + user_msg = lines (trimLF msg) + + indent :: String -> String + indent s = replicate 2 ' ' ++ s + + -- Don't render the 0:0 position + renderErrorHerald :: Position -> String + renderErrorHerald pos = + case (err_header, pos == zeroPos) of + (Nothing, True) -> "" + (Nothing, False) -> showPos pos ++ ": " + (Just herald, True) -> herald ++ " " + (Just herald, False) -> herald ++ showPos pos ++ ": " + + renderError :: PError -> String + renderError (PError pos msg) = renderErrorOrWarning "error" pos msg + + renderWarning :: PWarning -> String + renderWarning (PWarning _ pos msg) = renderErrorOrWarning "warning" pos msg -- sometimes there are (especially trailing) newlines. trimLF :: String -> String diff --git a/cabal-install/src/Distribution/Client/ProjectFlags.hs b/cabal-install/src/Distribution/Client/ProjectFlags.hs index 9214b6a37cf..9060f3b863b 100644 --- a/cabal-install/src/Distribution/Client/ProjectFlags.hs +++ b/cabal-install/src/Distribution/Client/ProjectFlags.hs @@ -59,8 +59,7 @@ defaultProjectFlags = { flagProjectDir = mempty , flagProjectFile = mempty , flagIgnoreProject = toFlag False - , -- Should we use 'Last' here? - flagProjectFileParser = mempty + , flagProjectFileParser = mempty } projectFlagsOptions :: ShowOrParseArgs -> [OptionField ProjectFlags] diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoName/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoName/cabal.out index 32c0ffc2a2f..decf3cfcca4 100644 --- a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoName/cabal.out +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoName/cabal.out @@ -1,8 +1,8 @@ # cabal check Error: [Cabal-7035] -Error encountered when parsing cabal file pkg.cabal: +Error parsing cabal file pkg.cabal: -pkg.cabal:0:0: error: -"name" field missing +pkg.cabal: error: + "name" field missing diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoVersion/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoVersion/cabal.out index 4e01a9cfc38..a539f19dbd2 100644 --- a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoVersion/cabal.out +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoVersion/cabal.out @@ -1,8 +1,8 @@ # cabal check Error: [Cabal-7035] -Error encountered when parsing cabal file pkg.cabal: +Error parsing cabal file pkg.cabal: -pkg.cabal:0:0: error: -"version" field missing +pkg.cabal: error: + "version" field missing diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.out b/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.out index a31f6fa12fb..4e2cfe368c3 100644 --- a/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.out +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.out @@ -13,98 +13,98 @@ Warning: The directory /cabal.dist/home/.cabal/store/ghc-/incoming # checking cyclical loopback of a project importing itself # cabal v2-build Error: [Cabal-7167] -Error encountered when parsing project file cyclical-0-self.project: +Error parsing project file cyclical-0-self.project: cyclical-0-self.project:3:1: error: -cyclical import of cyclical-0-self.project; - cyclical-0-self.project - imported by: cyclical-0-self.project + cyclical import of cyclical-0-self.project; + cyclical-0-self.project + imported by: cyclical-0-self.project + 1 | packages: . + 2 | + 3 | import: cyclical-0-self.project + | ^ - 1 | packages: . - 2 | - 3 | import: cyclical-0-self.project - | ^ # checking cyclical with hops; out and back # cabal v2-build Error: [Cabal-7167] -Error encountered when parsing project file cyclical-1-out-back.config: +Error parsing project file cyclical-1-out-back.config: imported by: cyclical-1-out-back.project cyclical-1-out-back.config:1:1: error: -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 + 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 + 1 | import: cyclical-1-out-back.project + | ^ - 1 | import: cyclical-1-out-back.project - | ^ # checking cyclical with hops; out to a config that imports itself # cabal v2-build Error: [Cabal-7167] -Error encountered when parsing project file cyclical-1-out-self.config: +Error parsing project file cyclical-1-out-self.config: imported by: cyclical-1-out-self.project cyclical-1-out-self.config:1:1: error: -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 + 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 + 1 | import: cyclical-1-out-self.config + | ^ - 1 | import: cyclical-1-out-self.config - | ^ # checking cyclical with hops; out, out, twice back # cabal v2-build Error: [Cabal-7167] -Error encountered when parsing project file cyclical-2-out-out-backback-b.config: +Error parsing project file cyclical-2-out-out-backback-b.config: imported by: cyclical-2-out-out-backback-a.config imported by: cyclical-2-out-out-backback.project cyclical-2-out-out-backback-b.config:1:1: error: -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 + 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 + 1 | import: cyclical-2-out-out-backback.project + | ^ - 1 | import: cyclical-2-out-out-backback.project - | ^ # checking cyclical with hops; out, out, once back # cabal v2-build Error: [Cabal-7167] -Error encountered when parsing project file cyclical-2-out-out-back-b.config: +Error parsing project file cyclical-2-out-out-back-b.config: imported by: cyclical-2-out-out-back-a.config imported by: cyclical-2-out-out-back.project cyclical-2-out-out-back-b.config:1:1: error: -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 + 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 + 1 | import: cyclical-2-out-out-back-a.config + | ^ - 1 | import: cyclical-2-out-out-back-a.config - | ^ # checking cyclical with hops; out, out to a config that imports itself # cabal v2-build Error: [Cabal-7167] -Error encountered when parsing project file cyclical-2-out-out-self-b.config: +Error parsing project file cyclical-2-out-out-self-b.config: imported by: cyclical-2-out-out-self-a.config imported by: cyclical-2-out-out-self.project cyclical-2-out-out-self-b.config:1:1: error: -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 + 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 + 1 | import: cyclical-2-out-out-self-b.config + | ^ - 1 | import: cyclical-2-out-out-self-b.config - | ^ # 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 @@ -121,53 +121,53 @@ Up to date # checking that cyclical check catches a same file name that imports itself # cabal v2-build Error: [Cabal-7167] -Error encountered when parsing project file same-filename/cyclical-same-filename-out-out-self.config: +Error parsing project file 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 same-filename/cyclical-same-filename-out-out-self.config:1:1: error: -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 + 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 + 1 | import: cyclical-same-filename-out-out-self.config + | ^ - 1 | import: cyclical-same-filename-out-out-self.config - | ^ # checking that cyclical check catches importing its importer (with the same file name) # cabal v2-build Error: [Cabal-7167] -Error encountered when parsing project file same-filename/cyclical-same-filename-out-out-backback.config: +Error parsing project file 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 same-filename/cyclical-same-filename-out-out-backback.config:1:1: error: -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 + 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 + 1 | import: ../cyclical-same-filename-out-out-backback.project + | ^ - 1 | import: ../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-7167] -Error encountered when parsing project file same-filename/cyclical-same-filename-out-out-back.config: +Error parsing project file 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 same-filename/cyclical-same-filename-out-out-back.config:1:1: error: -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 + 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 + 1 | import: ../cyclical-same-filename-out-out-back.config + | ^ - 1 | import: ../cyclical-same-filename-out-out-back.config - | ^ # checking that imports work skipping into a subfolder and then back out again and again # cabal v2-build @@ -200,10 +200,10 @@ Up to date # checking bad conditional # cabal v2-build Error: [Cabal-7167] -Error encountered when parsing project file bad-conditional.project: +Error parsing project file bad-conditional.project: -bad-conditional.project:0:0: error: -Cannot set compiler in a conditional clause of a cabal project file +bad-conditional.project: error: + Cannot set compiler in a conditional clause of a cabal project file # checking that missing package message lists configuration provenance diff --git a/cabal-testsuite/PackageTests/IndexCabalFileParseError/cabal.out b/cabal-testsuite/PackageTests/IndexCabalFileParseError/cabal.out index 8f2609456ba..485ef98565a 100644 --- a/cabal-testsuite/PackageTests/IndexCabalFileParseError/cabal.out +++ b/cabal-testsuite/PackageTests/IndexCabalFileParseError/cabal.out @@ -1,20 +1,20 @@ # cabal v2-update Downloading the latest package list from test-local-repo -Warning: In /cabal.dist/repo/my-lib-1.0.tar.gz: Error encountered when parsing cabal file my-lib-1.0/my-lib.cabal: +Warning: In /cabal.dist/repo/my-lib-1.0.tar.gz: Error parsing cabal file my-lib-1.0/my-lib.cabal: -my-lib-1.0/my-lib.cabal:4:22: error: -unexpected Unknown SPDX license identifier: 'puppy' +my-lib-1.0/my-lib.cabal:5:1: warning: + Unknown field: "puppy" + 4 | license: puppy license :) + 5 | puppy: teehee! + | ^ - 3 | version: 1.0 - 4 | license: puppy license :) - | ^ -my-lib-1.0/my-lib.cabal:5:1: warning: -Unknown field: "puppy" +my-lib-1.0/my-lib.cabal:4:22: error: + unexpected Unknown SPDX license identifier: 'puppy' + 3 | version: 1.0 + 4 | license: puppy license :) + | ^ - 4 | license: puppy license :) - 5 | puppy: teehee! - | ^ Error: [Cabal-7046] Failed to read my-lib-1.0/my-lib.cabal from archive /cabal.dist/repo/my-lib-1.0.tar.gz diff --git a/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.out b/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.out index 17e4efd7a0e..5423e2454ec 100644 --- a/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.out +++ b/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.out @@ -1,13 +1,13 @@ # cabal build Error: [Cabal-7167] -Error encountered when parsing project file cabal.project: +Error parsing project file cabal.project: cabal.project:4:1: error: -'source-repository-package' is a stanza, not a field. Remove the trailing ':' to parse a stanza. + 'source-repository-package' is a stanza, not a field. Remove the trailing ':' to parse a stanza. + 1 | packages: . + 2 | + 3 | -- This is an error; a trailing `:` is syntax for a field, not a stanza! + 4 | source-repository-package: + | ^ - 1 | packages: . - 2 | - 3 | -- This is an error; a trailing `:` is syntax for a field, not a stanza! - 4 | source-repository-package: - | ^ diff --git a/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.test.hs b/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.test.hs index 07abb78a40c..39636819157 100644 --- a/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.test.hs +++ b/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.test.hs @@ -2,5 +2,5 @@ import Test.Cabal.Prelude main = cabalTest $ do result <- fails $ cabal' "build" [] - assertOutputContains "Error encountered when parsing project file" result + assertOutputContains "Error parsing project file" result assertOutputContains "'source-repository-package' is a stanza, not a field." result diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.out b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.out index 3949eaa47d6..b2d1fd35fc7 100644 --- a/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.out +++ b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.out @@ -3,36 +3,36 @@ Warnings found while parsing the project file, else.project: - dir-else/else.config:3:5: Invalid subsection "_" # cabal v2-build Error: [Cabal-7167] -Error encountered when parsing project file cabal.project: +Error parsing project file cabal.project: cabal.project:3:4: error: -unexpected SecArgName (Position 3 4) "_" + unexpected SecArgName (Position 3 4) "_" + 3 | if _ + | ^ - 3 | if _ - | ^ # cabal v2-build Error: [Cabal-7167] -Error encountered when parsing project file dir-if/if.config: +Error parsing project file dir-if/if.config: imported by: if.project dir-if/if.config:3:4: error: -unexpected SecArgName (Position 3 4) "_" + unexpected SecArgName (Position 3 4) "_" + 3 | if _ + | ^ - 3 | if _ - | ^ # cabal v2-build Error: [Cabal-7167] -Error encountered when parsing project file dir-elif/elif.config: +Error parsing project file dir-elif/elif.config: imported by: elif.project dir-elif/elif.config:4:6: error: -unexpected SecArgName (Position 4 6) "_" + unexpected SecArgName (Position 4 6) "_" + 3 | if false + 4 | elif _ + | ^ - 3 | if false - 4 | elif _ - | ^ # cabal v2-build Warnings found while parsing the project file, else.project: