Commit 571a9dc1 authored by Oleg Grenrus's avatar Oleg Grenrus
Browse files

Add checkUnusedFlags

parent f8dc46a0
......@@ -58,9 +58,11 @@ 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
......@@ -75,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.
--
......@@ -148,6 +151,7 @@ checkPackage gpkg mpkg =
++ checkPackageVersions gpkg
++ checkDevelopmentOnlyFlags gpkg
++ checkFlagNames gpkg
++ checkUnusedFlags gpkg
where
pkg = fromMaybe (flattenPackageDescription gpkg) mpkg
......@@ -1586,7 +1590,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
......@@ -1607,6 +1611,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 [
......
......@@ -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.
--
......
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