Skip to content

Makes flags overridable on the command line. #4940

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
wants to merge 1 commit into from
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions Cabal/Distribution/PackageDescription.hs
Original file line number Diff line number Diff line change
Expand Up @@ -99,6 +99,7 @@ module Distribution.PackageDescription (
nullFlagAssignment, showFlagValue,
diffFlagAssignment, lookupFlagAssignment, insertFlagAssignment,
dispFlagAssignment, parseFlagAssignment, parsecFlagAssignment,
findDuplicateFlagAssignments,
CondTree(..), ConfVar(..), Condition(..),
cNot, cAnd, cOr,

Expand Down
72 changes: 52 additions & 20 deletions Cabal/Distribution/Types/GenericPackageDescription.hs
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,7 @@ module Distribution.Types.GenericPackageDescription (
lookupFlagAssignment,
insertFlagAssignment,
diffFlagAssignment,
findDuplicateFlagAssignments,
nullFlagAssignment,
showFlagValue,
dispFlagAssignment,
Expand All @@ -25,11 +26,11 @@ module Distribution.Types.GenericPackageDescription (
) where

import Prelude ()
import Data.List ((\\))
import Distribution.Compat.Prelude
import Distribution.Utils.ShortText
import Distribution.Utils.Generic (lowercase)
import qualified Text.PrettyPrint as Disp
import qualified Data.Map as Map
import qualified Distribution.Compat.ReadP as Parse
import qualified Distribution.Compat.Parsec as P
import Distribution.Compat.ReadP ((+++))
Expand Down Expand Up @@ -154,55 +155,80 @@ instance Text FlagName where
-- discovered during configuration. For example @--flags=foo --flags=-bar@
-- becomes @[("foo", True), ("bar", False)]@
--
newtype FlagAssignment = FlagAssignment [(FlagName, Bool)]
deriving (Binary,Eq,Ord,Semigroup,Monoid)
newtype FlagAssignment = FlagAssignment { getFlagAssignment :: Map.Map FlagName (Int, Bool) }
deriving (Binary)

-- TODO: the Semigroup/Monoid/Ord/Eq instances would benefit from
-- [(FlagName,Bool)] being in a normal form, i.e. sorted. We could
-- e.g. switch to a `Data.Map.Map` representation, but see duplicates
-- check in `configuredPackageProblems`.
instance Eq FlagAssignment where
(==) (FlagAssignment m1) (FlagAssignment m2) = fmap snd m1 == fmap snd m2

instance Ord FlagAssignment where
compare (FlagAssignment m1) (FlagAssignment m2) = fmap snd m1 `compare` fmap snd m2

-- | Combines pairs of values contained in the 'FlagAssignment' Map.
--
-- The last flag specified takes precedence, and we record the number
-- of times we have seen the flag.
--
-- Also, the 'Semigroup' instance currently is left-biased as entries
-- in the left-hand 'FlagAssignment' shadow those occuring in the
-- right-hand side 'FlagAssignment' for the same flagnames.
combineFlagValues :: (Int, Bool) -> (Int, Bool) -> (Int, Bool)
combineFlagValues (c1, _) (c2, b2) = (c1 + c2, b2)

-- The 'Semigroup' instance currently is right-biased.
--
-- If duplicate flags are specified, we want the last flag specified to
-- take precedence and we want to know how many times the flag has been
-- specified so that we have the option of warning the user about
-- supplying duplicate flags.
instance Semigroup FlagAssignment where
(<>) (FlagAssignment m1) (FlagAssignment m2) = FlagAssignment (Map.unionWith combineFlagValues m1 m2)

instance Monoid FlagAssignment where
mempty = FlagAssignment Map.empty
mappend = (<>)

-- | Construct a 'FlagAssignment' from a list of flag/value pairs.
--
-- If duplicate flags occur in the input list, the later entries
-- in the list will take precedence.
--
-- @since 2.2.0
mkFlagAssignment :: [(FlagName, Bool)] -> FlagAssignment
mkFlagAssignment = FlagAssignment
mkFlagAssignment = FlagAssignment . Map.fromListWith (flip combineFlagValues) . fmap (fmap (\b -> (1, b)))

-- | Deconstruct a 'FlagAssignment' into a list of flag/value pairs.
--
-- @ ('mkFlagAssignment' . 'unFlagAssignment') fa == fa @
-- @ 'null' ('findDuplicateFlagAssignments' fa) ==> ('mkFlagAssignment' . 'unFlagAssignment') fa == fa @
--
-- @since 2.2.0
unFlagAssignment :: FlagAssignment -> [(FlagName, Bool)]
unFlagAssignment (FlagAssignment xs) = xs
unFlagAssignment = fmap (fmap snd) . Map.toList . getFlagAssignment

-- | Test whether 'FlagAssignment' is empty.
--
-- @since 2.2.0
nullFlagAssignment :: FlagAssignment -> Bool
nullFlagAssignment (FlagAssignment []) = True
nullFlagAssignment _ = False
nullFlagAssignment = Map.null . getFlagAssignment

-- | Lookup the value for a flag
--
-- Returns 'Nothing' if the flag isn't contained in the 'FlagAssignment'.
--
-- @since 2.2.0
lookupFlagAssignment :: FlagName -> FlagAssignment -> Maybe Bool
lookupFlagAssignment fn = lookup fn . unFlagAssignment
lookupFlagAssignment fn = fmap snd . Map.lookup fn . getFlagAssignment

-- | Insert or update the boolean value of a flag.
--
-- If the flag is already present in the 'FlagAssigment', the
-- value will be updated and the fact that multiple values have
-- been provided for that flag will be recorded so that a
-- warning can be generated later on.
--
-- @since 2.2.0
insertFlagAssignment :: FlagName -> Bool -> FlagAssignment -> FlagAssignment
-- TODO: this currently just shadows prior values for an existing flag;
-- rather than enforcing uniqueness at construction, it's verified lateron via
-- `D.C.Dependency.configuredPackageProblems`
insertFlagAssignment flag val = mkFlagAssignment . ((flag,val):) . unFlagAssignment
insertFlagAssignment flag val = FlagAssignment . Map.insertWith (flip combineFlagValues) flag (1, val) . getFlagAssignment

-- | Remove all flag-assignments from the first 'FlagAssignment' that
-- are contained in the second 'FlagAssignment'
Expand All @@ -214,7 +240,13 @@ insertFlagAssignment flag val = mkFlagAssignment . ((flag,val):) . unFlagAssignm
--
-- @since 2.2.0
diffFlagAssignment :: FlagAssignment -> FlagAssignment -> FlagAssignment
diffFlagAssignment fa1 fa2 = mkFlagAssignment (unFlagAssignment fa1 \\ unFlagAssignment fa2)
diffFlagAssignment fa1 fa2 = FlagAssignment (Map.difference (getFlagAssignment fa1) (getFlagAssignment fa2))

-- | Find the 'FlagName's that have been listed more than once.
--
-- @since 2.2.0
findDuplicateFlagAssignments :: FlagAssignment -> [FlagName]
findDuplicateFlagAssignments = Map.keys . Map.filter ((> 1) . fst) . getFlagAssignment

-- | @since 2.2.0
instance Read FlagAssignment where
Expand All @@ -235,7 +267,7 @@ dispFlagAssignment = Disp.hsep . map (Disp.text . showFlagValue) . unFlagAssignm

-- | Parses a flag assignment.
parsecFlagAssignment :: ParsecParser FlagAssignment
parsecFlagAssignment = FlagAssignment <$> P.sepBy (onFlag <|> offFlag) P.skipSpaces1
parsecFlagAssignment = mkFlagAssignment <$> P.sepBy (onFlag <|> offFlag) P.skipSpaces1
where
onFlag = do
P.optional (P.char '+')
Expand All @@ -248,7 +280,7 @@ parsecFlagAssignment = FlagAssignment <$> P.sepBy (onFlag <|> offFlag) P.skipSpa

-- | Parses a flag assignment.
parseFlagAssignment :: Parse.ReadP r FlagAssignment
parseFlagAssignment = FlagAssignment <$> Parse.sepBy parseFlagValue Parse.skipSpaces1
parseFlagAssignment = mkFlagAssignment <$> Parse.sepBy parseFlagValue Parse.skipSpaces1
where
parseFlagValue =
(do Parse.optional (Parse.char '+')
Expand Down
5 changes: 2 additions & 3 deletions cabal-install/Distribution/Client/Dependency.hs
Original file line number Diff line number Diff line change
Expand Up @@ -96,7 +96,7 @@ import Distribution.Compiler
import Distribution.System
( Platform )
import Distribution.Client.Utils
( duplicates, duplicatesBy, mergeBy, MergeResult(..) )
( duplicatesBy, mergeBy, MergeResult(..) )
import Distribution.Simple.Utils
( comparing )
import Distribution.Simple.Setup
Expand Down Expand Up @@ -891,8 +891,7 @@ configuredPackageProblems :: Platform -> CompilerInfo
-> SolverPackage UnresolvedPkgLoc -> [PackageProblem]
configuredPackageProblems platform cinfo
(SolverPackage pkg specifiedFlags stanzas specifiedDeps' _specifiedExeDeps') =
-- FIXME/TODO: FlagAssignment ought to be duplicate-free as internal invariant
[ DuplicateFlag flag | ((flag,_):_) <- duplicates (PD.unFlagAssignment specifiedFlags) ]
[ DuplicateFlag flag | flag <- PD.findDuplicateFlagAssignments specifiedFlags ]
++ [ MissingFlag flag | OnlyInLeft flag <- mergedFlags ]
++ [ ExtraFlag flag | OnlyInRight flag <- mergedFlags ]
++ [ DuplicateDeps pkgs
Expand Down
2 changes: 1 addition & 1 deletion cabal-testsuite/PackageTests/Regression/T3436/sandbox.out
Original file line number Diff line number Diff line change
Expand Up @@ -18,5 +18,5 @@ Installing library in <PATH>
Installed Cabal-2.0
Failed to install custom-setup-1.0
cabal: Error: some packages failed to install:
custom-setup-1.0-92JpsxIMpiQHysxYdDtEVq failed during the configure step. The exception was:
custom-setup-1.0-KL06TzJxSBkDtcPp9Xd2v1 failed during the configure step. The exception was:
ExitFailure 1