Commit a78ce90e authored by Oleg Grenrus's avatar Oleg Grenrus Committed by GitHub
Browse files

Merge pull request #4687 from phadej/cabal-check-flags

cabal check flag names
parents 267efc85 9d507076
......@@ -55,11 +55,14 @@ import Distribution.Simple.Utils hiding (findPackageDesc, notice)
import Distribution.Version
import Distribution.Package
import Distribution.Text
import Distribution.Utils.Generic (isAscii)
import Language.Haskell.Extension
import Control.Applicative (Const (..))
import Control.Monad (mapM)
import qualified Data.ByteString.Lazy as BS
import Data.List (group)
import Data.Monoid (Endo (..))
import qualified System.Directory as System
( doesFileExist, doesDirectoryExist )
import qualified Data.Map as Map
......@@ -74,6 +77,7 @@ import System.FilePath
import System.FilePath.Windows as FilePath.Windows
( isValid )
import qualified Data.Set as Set
-- | Results of some kind of failed package check.
--
......@@ -146,6 +150,8 @@ checkPackage gpkg mpkg =
++ checkConditionals gpkg
++ checkPackageVersions gpkg
++ checkDevelopmentOnlyFlags gpkg
++ checkFlagNames gpkg
++ checkUnusedFlags gpkg
where
pkg = fromMaybe (flattenPackageDescription gpkg) mpkg
......@@ -1584,6 +1590,57 @@ checkConditionals pkg =
COr c1 c2 -> condfv c1 ++ condfv c2
CAnd c1 c2 -> condfv c1 ++ condfv c2
checkFlagNames :: GenericPackageDescription -> [PackageCheck]
checkFlagNames gpd
| null invalidFlagNames = []
| otherwise = [ PackageDistInexcusable
$ "Suspicious flag names: " ++ unwords invalidFlagNames ++ ". "
++ "To avoid ambiguity in command line interfaces, flag shouldn't "
++ "start with a dash. Also for better compatibility, flag names "
++ "shouldn't contain non-ascii characters."
]
where
invalidFlagNames =
[ fn
| flag <- genPackageFlags gpd
, let fn = unFlagName (flagName flag)
, invalidFlagName fn
]
-- starts with dash
invalidFlagName ('-':_) = True
-- mon ascii letter
invalidFlagName cs = any (not . isAscii) cs
checkUnusedFlags :: GenericPackageDescription -> [PackageCheck]
checkUnusedFlags gpd
| declared == used = []
| otherwise = [ PackageDistSuspicious
$ "Declared and used flag sets differ: "
++ s declared ++ " /= " ++ s used ++ ". "
]
where
s :: Set.Set FlagName -> String
s = commaSep . map unFlagName . Set.toList
declared :: Set.Set FlagName
declared = Set.fromList $ map flagName $ genPackageFlags gpd
used :: Set.Set FlagName
used = Set.fromList $ ($[]) $ appEndo $ getConst $
(traverse . traverseCondTreeV) tellFlag (condLibrary gpd) *>
(traverse . _2 . traverseCondTreeV) tellFlag (condSubLibraries gpd) *>
(traverse . _2 . traverseCondTreeV) tellFlag (condForeignLibs gpd) *>
(traverse . _2 . traverseCondTreeV) tellFlag (condExecutables gpd) *>
(traverse . _2 . traverseCondTreeV) tellFlag (condTestSuites gpd) *>
(traverse . _2 . traverseCondTreeV) tellFlag (condBenchmarks gpd)
_2 :: Functor f => (a -> f b) -> (c, a) -> f (c, b)
_2 f (c, a) = (,) c <$> f a
tellFlag :: ConfVar -> Const (Endo [FlagName]) ConfVar
tellFlag (Flag fn) = Const (Endo (fn :))
tellFlag _ = Const mempty
checkDevelopmentOnlyFlagsBuildInfo :: BuildInfo -> [PackageCheck]
checkDevelopmentOnlyFlagsBuildInfo bi =
catMaybes [
......
......@@ -672,7 +672,9 @@ configureOptions showOrParseArgs =
,option "f" ["flags"]
"Force values for the given flags in Cabal conditionals in the .cabal file. E.g., --flags=\"debug -usebytestrings\" forces the flag \"debug\" to true and \"usebytestrings\" to false."
configConfigurationsFlags (\v flags -> flags { configConfigurationsFlags = v })
(reqArg' "FLAGS" readFlagList showFlagList)
(reqArg "FLAGS"
(readP_to_E (\err -> "Invalid flag assignment: " ++ err) parseFlagAssignment)
(map showFlagValue))
,option "" ["extra-include-dirs"]
"A list of directories to search for header files"
......@@ -769,15 +771,6 @@ configureOptions showOrParseArgs =
(boolOpt' ([], ["disable-response-files"]) ([], []))
]
where
readFlagList :: String -> FlagAssignment
readFlagList = map tagWithValue . words
where tagWithValue ('-':fname) = (mkFlagName (lowercase fname), False)
tagWithValue fname = (mkFlagName (lowercase fname), True)
showFlagList :: FlagAssignment -> [String]
showFlagList fs = [ if not set then '-':unFlagName fname else unFlagName fname
| (fname, set) <- fs]
liftInstallDirs =
liftOption configInstallDirs (\v flags -> flags { configInstallDirs = v })
......
......@@ -13,6 +13,8 @@ module Distribution.Types.CondTree (
mapTreeConstrs,
mapTreeConds,
mapTreeData,
traverseCondTreeV,
traverseCondBranchV,
extractCondition,
simplifyCondTree,
ignoreConditions,
......@@ -102,6 +104,17 @@ mapTreeConds f = mapCondTree id id f
mapTreeData :: (a -> b) -> CondTree v c a -> CondTree v c b
mapTreeData f = mapCondTree f id id
-- | @Traversal (CondTree v c a) (CondTree w c a) v w@
traverseCondTreeV :: Applicative f => (v -> f w) -> CondTree v c a -> f (CondTree w c a)
traverseCondTreeV f (CondNode a c ifs) =
CondNode a c <$> traverse (traverseCondBranchV f) ifs
-- | @Traversal (CondBranch v c a) (CondBranch w c a) v w@
traverseCondBranchV :: Applicative f => (v -> f w) -> CondBranch v c a -> f (CondBranch w c a)
traverseCondBranchV f (CondBranch cnd t me) = CondBranch
<$> traverse f cnd
<*> traverseCondTreeV f t
<*> traverse (traverseCondTreeV f) me
-- | Extract the condition matched by the given predicate from a cond tree.
--
......
......@@ -54,6 +54,9 @@ module Distribution.Utils.Generic (
isInfixOf,
intercalate,
lowercase,
isAscii,
isAsciiAlpha,
isAsciiAlphaNum,
listUnion,
listUnionRight,
ordNub,
......@@ -307,6 +310,18 @@ equating p x y = p x == p y
lowercase :: String -> String
lowercase = map toLower
isAscii :: Char -> Bool
isAscii c = fromEnum c < 0x80
-- | Ascii letters.
isAsciiAlpha :: Char -> Bool
isAsciiAlpha c = ('a' <= c && c <= 'z')
|| ('A' <= c && c <= 'Z')
-- | Ascii letters and digits.
isAsciiAlphaNum :: Char -> Bool
isAsciiAlphaNum c = isAscii c || isDigit c
unintersperse :: Char -> String -> [String]
unintersperse mark = unfoldr unintersperse1 where
unintersperse1 str
......
......@@ -12,6 +12,9 @@
* By default 'ar' program receives arguments via '@file' format.
Old behavior can be restored with '--ar-does-not-support-at-arguments'
argument to 'configure' or 'install'. (#4596)
* Check warns about unused, undeclared or non-unicode flags.
Also it warns about leading dash, which is unusable but accepted if
it's unused in conditionals.(#4687)
* TODO
2.0.0.2 Mikhail Glushenkov <mikhail.glushenkov@gmail.com> July 2017
......
......@@ -2162,7 +2162,12 @@ Configuration Flags
Flag section declares a flag which can be used in `conditional blocks`_.
A flag section may contain the following fields:
Flag names are case-insensitive and must match ``[[:alnum:]_][[:alnum:]_-]*``
regular expression.
.. note::
Hackage accepts ASCII-only flags, ``[a-zA-Z0-9_][a-zA-Z0-9_-]*`` regexp.
.. pkg-field:: description: freeform
......
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