Commit f8960667 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Add newtype FlagName and FlagAssignment type alias

and use them in the appropriate places.
parent 0ed8b4e5
......@@ -73,7 +73,8 @@ module Distribution.PackageDescription (
-- * package configuration
GenericPackageDescription(..),
Flag(..), CondTree(..), ConfVar(..), ConfFlag(..), Condition(..),
Flag(..), FlagName(..), FlagAssignment,
CondTree(..), ConfVar(..), Condition(..),
) where
import Data.List (nub)
......@@ -471,20 +472,27 @@ instance Show GenericPackageDescription where
-- | A flag can represent a feature to be included, or a way of linking
-- a target against its dependencies, or in fact whatever you can think of.
data Flag = MkFlag
{ flagName :: String
{ flagName :: FlagName
, flagDescription :: String
, flagDefault :: Bool
}
deriving Show
-- | A @ConfFlag@ represents an user-defined flag
newtype ConfFlag = ConfFlag String
deriving (Eq, Show)
-- | A 'FlagName' is the name of a user-defined configuration flag
newtype FlagName = FlagName String
deriving (Eq, Ord, Show)
-- | A 'FlagAssignment' is a total or partial mapping of 'FlagName's to
-- 'Bool' flag values. It represents the flags chosen by the user or
-- discovered during configuration. For example @--flags=foo --flags=-bar@
-- becomes @[("foo", True), ("bar", False)]@
--
type FlagAssignment = [(FlagName, Bool)]
-- | A @ConfVar@ represents the variable type used.
data ConfVar = OS OS
| Arch Arch
| Flag ConfFlag
| Flag FlagName
| Impl CompilerFlavor VersionRange
deriving (Eq, Show)
......
......@@ -52,7 +52,8 @@ import Distribution.Package (Package, Dependency(..))
import Distribution.PackageDescription
( GenericPackageDescription(..), PackageDescription(..)
, Library(..), Executable(..), BuildInfo(..)
, Flag(..), CondTree(..), ConfVar(..), ConfFlag(..), Condition(..) )
, Flag(..), FlagName(..), FlagAssignment
, CondTree(..), ConfVar(..), Condition(..) )
import Distribution.Simple.PackageIndex (PackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Version
......@@ -114,16 +115,15 @@ simplifyCondition cond i = fv . walk $ cond
-- | Simplify a configuration condition using the os and arch names. Returns
-- the names of all the flags occurring in the condition.
simplifyWithSysParams :: OS -> Arch -> CompilerId -> Condition ConfVar
-> (Condition ConfFlag, [String])
-> (Condition FlagName, [FlagName])
simplifyWithSysParams os arch (CompilerId comp compVer) cond = (cond', flags)
where
(cond', fvs) = simplifyCondition cond interp
(cond', flags) = simplifyCondition cond interp
interp (OS os') = Right $ os' == os
interp (Arch arch') = Right $ arch' == arch
interp (Impl comp' vr) = Right $ comp' == comp
&& compVer `withinRange` vr
interp (Flag f) = Left f
flags = [ fname | ConfFlag fname <- fvs ]
-- XXX: Add instances and check
--
......@@ -159,7 +159,7 @@ parseCondition = condOr
boolLiteral = fmap Lit parse
archIdent = fmap Arch parse
osIdent = fmap OS parse
flagIdent = fmap (Flag . ConfFlag . lowercase) (munch1 isIdentChar)
flagIdent = fmap (Flag . FlagName . lowercase) (munch1 isIdentChar)
isIdentChar c = isAlphaNum c || c == '_' || c == '-'
oper s = sp >> string s >> sp
sp = skipSpaces
......@@ -221,7 +221,7 @@ data BT a = BTN a | BTB (BT a) (BT a) -- very simple binary tree
-- implemented unless we really need it.
--
resolveWithFlags :: Monoid a =>
[(String,[Bool])]
[(FlagName,[Bool])]
-- ^ Domain for each flag name, will be tested in order.
-> OS -- ^ OS as returned by Distribution.System.buildOS
-> Arch -- ^ Arch as returned by Distribution.System.buildArch
......@@ -229,8 +229,8 @@ resolveWithFlags :: Monoid a =>
-> [Dependency] -- ^ Additional constraints
-> [CondTree ConfVar [Dependency] a]
-> ([Dependency] -> DepTestRslt [Dependency]) -- ^ Dependency test function.
-> (Either [Dependency] -- missing dependencies
([a], [Dependency], [(String, Bool)]))
-> Either [Dependency] -- missing dependencies
([a], [Dependency], FlagAssignment)
-- ^ In the returned dependencies, there will be no duplicates by name
resolveWithFlags dom os arch impl constrs trees checkDeps =
case try dom [] of
......@@ -283,7 +283,7 @@ resolveWithFlags dom os arch impl constrs trees checkDeps =
-- `mzero'
mz = Left (BTN [])
env flags flag@(ConfFlag n) = maybe (Left flag) Right . lookup n $ flags
env flags flag = (maybe (Left flag) Right . lookup flag) flags
-- for the error case we inspect our lazy tree of missing dependencies and
-- pick the shortest list of missing dependencies
......@@ -330,8 +330,8 @@ ignoreConditions (CondNode a c ifs) = (a, c) `mappend` mconcat (concatMap f ifs)
where f (_, t, me) = ignoreConditions t
: maybeToList (fmap ignoreConditions me)
freeVars :: CondTree ConfVar c a -> [String]
freeVars t = [ s | Flag (ConfFlag s) <- freeVars' t ]
freeVars :: CondTree ConfVar c a -> [FlagName]
freeVars t = [ f | Flag f <- freeVars' t ]
where
freeVars' (CondNode _ _ ifs) = concatMap compfv ifs
compfv (c, ct, mct) = condfv c ++ freeVars' ct ++ maybe [] freeVars' mct
......@@ -379,7 +379,7 @@ instance Monoid PDTagged where
--
finalizePackageDescription ::
Package pkg
=> [(String,Bool)] -- ^ Explicitly specified flag assignments
=> FlagAssignment -- ^ Explicitly specified flag assignments
-> Maybe (PackageIndex pkg) -- ^ Available dependencies. Pass 'Nothing' if
-- this is unknown.
-> OS -- ^ OS-name
......@@ -388,7 +388,7 @@ finalizePackageDescription ::
-> [Dependency] -- ^ Additional constraints
-> GenericPackageDescription
-> Either [Dependency]
(PackageDescription, [(String,Bool)])
(PackageDescription, FlagAssignment)
-- ^ Either missing dependencies or the resolved package
-- description along with the flag assignments chosen.
finalizePackageDescription userflags mpkgs os arch impl constraints
......
......@@ -58,7 +58,7 @@ module Distribution.PackageDescription.Parse (
showHookedBuildInfo,
) where
import Data.Char (isSpace, toLower)
import Data.Char (isSpace)
import Data.Maybe (listToMaybe)
import Data.List (nub, unfoldr, partition, (\\))
import Control.Monad (liftM, foldM, when, unless)
......@@ -80,7 +80,7 @@ import Distribution.Verbosity (Verbosity)
import Distribution.Compiler (CompilerFlavor(..))
import Distribution.PackageDescription.Configuration (parseCondition, freeVars)
import Distribution.Simple.Utils
( die, dieWithLocation, warn, intercalate, cabalVersion
( die, dieWithLocation, warn, intercalate, lowercase, cabalVersion
, readUTF8File, writeUTF8File )
......@@ -562,7 +562,7 @@ parsePackageDescription file = do
fl <- lift $ parseFields
flagFieldDescrs
warnUnrec
(MkFlag (map toLower sl) "" True)
(MkFlag (FlagName (lowercase sl)) "" True)
fs
skipField >> getFlags (fl : acc)
_ -> return (reverse acc)
......@@ -636,12 +636,12 @@ parsePackageDescription file = do
maybe (return ()) (checkCondTreeFlags definedFlags) mlib
mapM_ (checkCondTreeFlags definedFlags . snd) exes
checkCondTreeFlags :: [String] -> CondTree ConfVar c a -> PM ()
checkCondTreeFlags :: [FlagName] -> CondTree ConfVar c a -> PM ()
checkCondTreeFlags definedFlags ct = do
let fv = nub $ freeVars ct
when (not . all (`elem` definedFlags) $ fv) $
fail $ "These flags are used without having been defined: " ++
(intercalate " " (fv \\ definedFlags))
fail $ "These flags are used without having been defined: "
++ intercalate ", " [ n | FlagName n <- fv \\ definedFlags ]
-- | Parse a list of fields, given a list of field descriptions,
......@@ -716,12 +716,12 @@ parseHookedBuildInfo inp = do
where
parseLib :: [Field] -> ParseResult (Maybe BuildInfo)
parseLib (bi@((F _ inFieldName _):_))
| map toLower inFieldName /= "executable" = liftM Just (parseBI bi)
| lowercase inFieldName /= "executable" = liftM Just (parseBI bi)
parseLib _ = return Nothing
parseExe :: [Field] -> ParseResult (String, BuildInfo)
parseExe ((F line inFieldName mName):bi)
| map toLower inFieldName == "executable"
| lowercase inFieldName == "executable"
= do bis <- parseBI bi
return (mName, bis)
| otherwise = syntaxError line "expecting 'executable' at top of stanza"
......
......@@ -70,7 +70,8 @@ import Distribution.Simple.PackageIndex (PackageIndex)
import Distribution.PackageDescription as PD
( PackageDescription(..), GenericPackageDescription(..)
, Library(..), hasLibs, Executable(..), BuildInfo(..)
, HookedBuildInfo, updatePackageDescription, allBuildInfo)
, HookedBuildInfo, updatePackageDescription, allBuildInfo
, FlagName(..) )
import Distribution.PackageDescription.Configuration
( finalizePackageDescription )
import Distribution.PackageDescription.Check
......@@ -310,8 +311,9 @@ configure (pkg_descr0, pbi) cfg
let pkg_descr = addExtraIncludeLibDirs pkg_descr0'
when (not (null flags)) $
info verbosity $ "Flags chosen: " ++ (intercalate ", " .
map (\(n,b) -> n ++ "=" ++ show b) $ flags)
info verbosity $ "Flags chosen: "
++ intercalate ", " [ name ++ "=" ++ display value
| (FlagName name, value) <- flags ]
checkPackageProblems verbosity (updatePackageDescription pbi pkg_descr)
......
......@@ -70,19 +70,22 @@ import Distribution.Compiler ()
import Distribution.ReadE
import Distribution.Text (display, parse)
import Distribution.Package ( Dependency(..) )
import Distribution.PackageDescription
( FlagName(..), FlagAssignment )
import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import qualified Distribution.Simple.Command as Command
import Distribution.Simple.Compiler
( CompilerFlavor(..), defaultCompilerFlavor, PackageDB(..)
, OptimisationLevel(..), flagToOptimisationLevel )
import Distribution.Simple.Utils (wrapLine)
import Distribution.Simple.Utils
( wrapLine, lowercase )
import Distribution.Simple.Program (Program(..), ProgramConfiguration,
knownPrograms)
import Distribution.Simple.InstallDirs
( InstallDirs(..), CopyDest(..),
PathTemplate, toPathTemplate, fromPathTemplate )
import Data.List (sort)
import Data.Char( toLower, isSpace )
import Data.Char (isSpace)
import Data.Monoid (Monoid(..))
import Distribution.Verbosity
......@@ -251,7 +254,7 @@ data ConfigFlags = ConfigFlags {
configStripExes :: Flag Bool, -- ^Enable executable stripping
configConstraints :: [Dependency], -- ^Additional constraints for
-- dependencies
configConfigurationsFlags :: [(String, Bool)]
configConfigurationsFlags :: FlagAssignment
}
deriving Show
......@@ -468,13 +471,14 @@ configureOptions showOrParseArgs =
(map (\x -> display x)))
]
where
readFlagList :: String -> [(String, Bool)]
readFlagList :: String -> FlagAssignment
readFlagList = map tagWithValue . words
where tagWithValue ('-':fname) = (map toLower fname, False)
tagWithValue fname = (map toLower fname, True)
where tagWithValue ('-':fname) = (FlagName (lowercase fname), False)
tagWithValue fname = (FlagName (lowercase fname), True)
showFlagList :: [(String, Bool)] -> [String]
showFlagList fs = [ if not set then '-':fname else fname | (fname, set) <- fs]
showFlagList :: FlagAssignment -> [String]
showFlagList fs = [ if not set then '-':fname else fname
| (FlagName fname, set) <- fs]
installDirArg _sf _lf d get set = reqArgFlag "DIR" _sf _lf d
(fmap fromPathTemplate.get.configInstallDirs)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment