Add checkUnusedFlags

(cherry picked from commit 571a9dc)

Author: phadej

Cabal/Distribution/PackageDescription/Check.hs

@@ -58,8 +58,10 @@ import Distribution.Text
 import Distribution.Utils.Generic (isAscii)
 import Language.Haskell.Extension
 
+import Control.Applicative (Const (..))
 import Control.Monad (mapM)
 import Data.List  (group)
+import Data.Monoid (Endo (..))
 import qualified System.Directory as System
          ( doesFileExist, doesDirectoryExist )
 import qualified Data.Map as Map
@@ -74,6 +76,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.
 --
@@ -147,6 +150,7 @@ checkPackage gpkg mpkg =
   ++ checkPackageVersions gpkg
   ++ checkDevelopmentOnlyFlags gpkg
   ++ checkFlagNames gpkg
+  ++ checkUnusedFlags gpkg
   where
     pkg = fromMaybe (flattenPackageDescription gpkg) mpkg
 
@@ -1585,7 +1589,7 @@ checkConditionals pkg =
       COr  c1 c2 -> condfv c1 ++ condfv c2
       CAnd c1 c2 -> condfv c1 ++ condfv c2
 
-checkFlagNames ::GenericPackageDescription -> [PackageCheck]
+checkFlagNames :: GenericPackageDescription -> [PackageCheck]
 checkFlagNames gpd
     | null invalidFlagNames = []
     | otherwise             = [ PackageDistInexcusable
@@ -1606,6 +1610,36 @@ checkFlagNames gpd
     -- 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 [

Cabal/Distribution/Types/CondTree.hs

@@ -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.
 --