{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      :  Distribution.PackageDescription.Check
-- Copyright   :  Lennart Kolmodin 2008, Francesco Ariis 2022
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This has code for checking for various problems in packages. There is one
-- set of checks that just looks at a 'PackageDescription' in isolation and
-- another set of checks that also looks at files in the package. Some of the
-- checks are basic sanity checks, others are portability standards that we'd
-- like to encourage. There is a 'PackageCheck' type that distinguishes the
-- different kinds of checks so we can see which ones are appropriate to report
-- in different situations. This code gets used when configuring a package when
-- we consider only basic problems. The higher standard is used when
-- preparing a source tarball and by Hackage when uploading new packages. The
-- reason for this is that we want to hold packages that are expected to be
-- distributed to a higher standard than packages that are only ever expected
-- to be used on the author's own environment.
module Distribution.PackageDescription.Check
  ( -- * Package Checking
    CheckExplanation (..)
  , CheckExplanationID
  , CheckExplanationIDString
  , PackageCheck (..)
  , checkPackage
  , checkConfiguredPackage
  , wrapParseWarning
  , ppPackageCheck
  , ppCheckExplanationId
  , isHackageDistError
  , filterPackageChecksById
  , filterPackageChecksByIdString

    -- ** Checking package contents
  , checkPackageFiles
  , checkPackageFilesGPD
  , checkPackageContent
  , CheckPackageContentOps (..)
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Data.List (group)
import Distribution.CabalSpecVersion
import Distribution.Compat.Lens
import Distribution.Compiler
import Distribution.License
import Distribution.Package
import Distribution.PackageDescription
import Distribution.PackageDescription.Check.Common
import Distribution.PackageDescription.Check.Conditional
import Distribution.PackageDescription.Check.Monad
import Distribution.PackageDescription.Check.Paths
import Distribution.PackageDescription.Check.Target
import Distribution.PackageDescription.Check.Warning
import Distribution.Parsec.Warning (PWarning)
import Distribution.Pretty (prettyShow)
import Distribution.Simple.Glob
  ( Glob
  , GlobResult (..)
  , globMatches
  , parseFileGlob
  , runDirFileGlob
  )
import Distribution.Simple.Utils hiding (findPackageDesc, notice)
import Distribution.Utils.Generic (isAscii)
import Distribution.Utils.Path
  ( LicenseFile
  , PackageDir
  , SymbolicPath
  , getSymbolicPath
  )
import Distribution.Verbosity
import Distribution.Version
import System.FilePath (splitExtension, takeFileName, (<.>), (</>))

import qualified Data.ByteString.Lazy as BS
import qualified Distribution.SPDX as SPDX
import qualified System.Directory as System

import qualified System.Directory (getDirectoryContents)
import qualified System.FilePath.Windows as FilePath.Windows (isValid)

import qualified Data.Set as Set
import qualified Distribution.Utils.ShortText as ShortText

import qualified Distribution.Types.GenericPackageDescription.Lens as L

import Control.Monad

-- $setup
-- >>> import Control.Arrow ((&&&))

-- ☞ N.B.
--
-- Part of the tools/scaffold used to perform check is found in
-- Distribution.PackageDescription.Check.Types. Summary of that module (for
-- how we use it here):
-- 1. we work inside a 'CheckM m a' monad (where `m` is an abstraction to
--    run non-pure checks);
-- 2. 'checkP', 'checkPre' functions perform checks (respectively pure and
--    non-pure);
-- 3. 'PackageCheck' and 'CheckExplanation' are types for warning severity
--    and description.

-- ------------------------------------------------------------
-- Checking interface
-- ------------------------------------------------------------

-- | 'checkPackagePrim' is the most general way to invoke package checks.
-- We pass to it two interfaces (one to check contents of packages, the
-- other to inspect working tree for orphan files) and before that a
-- Boolean to indicate whether we want pure checks or not. Based on these
-- parameters, some checks will be performed, some omitted.
-- Generality over @m@ means we could do non pure checks in monads other
-- than IO (e.g. a virtual filesystem, like a zip file, a VCS filesystem,
-- etc).
checkPackagePrim
  :: Monad m
  => Bool -- Perform pure checks?
  -> Maybe (CheckPackageContentOps m) -- Package content interface.
  -> Maybe (CheckPreDistributionOps m) -- Predist checks interface.
  -> GenericPackageDescription -- GPD to check.
  -> m [PackageCheck]
checkPackagePrim :: forall (m :: * -> *).
Monad m =>
Bool
-> Maybe (CheckPackageContentOps m)
-> Maybe (CheckPreDistributionOps m)
-> GenericPackageDescription
-> m [PackageCheck]
checkPackagePrim Bool
b Maybe (CheckPackageContentOps m)
mco Maybe (CheckPreDistributionOps m)
mpdo GenericPackageDescription
gpd = do
  let cm :: CheckM m ()
cm = GenericPackageDescription -> CheckM m ()
forall (m :: * -> *).
Monad m =>
GenericPackageDescription -> CheckM m ()
checkGenericPackageDescription GenericPackageDescription
gpd
      ci :: CheckInterface m
ci = Bool
-> Maybe (CheckPackageContentOps m)
-> Maybe (CheckPreDistributionOps m)
-> CheckInterface m
forall (m :: * -> *).
Bool
-> Maybe (CheckPackageContentOps m)
-> Maybe (CheckPreDistributionOps m)
-> CheckInterface m
CheckInterface Bool
b Maybe (CheckPackageContentOps m)
mco Maybe (CheckPreDistributionOps m)
mpdo
      ctx :: CheckCtx m
ctx = CheckInterface m -> GenericPackageDescription -> CheckCtx m
forall (m :: * -> *).
Monad m =>
CheckInterface m -> GenericPackageDescription -> CheckCtx m
pristineCheckCtx CheckInterface m
ci GenericPackageDescription
gpd
  CheckM m () -> CheckCtx m -> m [PackageCheck]
forall (m :: * -> *).
Monad m =>
CheckM m () -> CheckCtx m -> m [PackageCheck]
execCheckM CheckM m ()
cm CheckCtx m
ctx

-- | Check for common mistakes and problems in package descriptions.
--
-- This is the standard collection of checks covering all aspects except
-- for checks that require looking at files within the package. For those
-- see 'checkPackageFiles'.
checkPackage :: GenericPackageDescription -> [PackageCheck]
checkPackage :: GenericPackageDescription -> [PackageCheck]
checkPackage GenericPackageDescription
gpd = Identity [PackageCheck] -> [PackageCheck]
forall a. Identity a -> a
runIdentity (Identity [PackageCheck] -> [PackageCheck])
-> Identity [PackageCheck] -> [PackageCheck]
forall a b. (a -> b) -> a -> b
$ Bool
-> Maybe (CheckPackageContentOps Identity)
-> Maybe (CheckPreDistributionOps Identity)
-> GenericPackageDescription
-> Identity [PackageCheck]
forall (m :: * -> *).
Monad m =>
Bool
-> Maybe (CheckPackageContentOps m)
-> Maybe (CheckPreDistributionOps m)
-> GenericPackageDescription
-> m [PackageCheck]
checkPackagePrim Bool
True Maybe (CheckPackageContentOps Identity)
forall a. Maybe a
Nothing Maybe (CheckPreDistributionOps Identity)
forall a. Maybe a
Nothing GenericPackageDescription
gpd

-- | This function is an oddity due to the historical
-- GenericPackageDescription/PackageDescription split. It is only maintained
-- not to break interface, use `checkPackage` if possible.
checkConfiguredPackage :: PackageDescription -> [PackageCheck]
checkConfiguredPackage :: PackageDescription -> [PackageCheck]
checkConfiguredPackage PackageDescription
pd = GenericPackageDescription -> [PackageCheck]
checkPackage (PackageDescription -> GenericPackageDescription
pd2gpd PackageDescription
pd)

-- | Sanity check things that requires looking at files in the package.
-- This is a generalised version of 'checkPackageFiles' that can work in any
-- monad for which you can provide 'CheckPackageContentOps' operations.
--
-- The point of this extra generality is to allow doing checks in some virtual
-- file system, for example a tarball in memory.
checkPackageContent
  :: Monad m
  => CheckPackageContentOps m
  -> GenericPackageDescription
  -> m [PackageCheck]
checkPackageContent :: forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m
-> GenericPackageDescription -> m [PackageCheck]
checkPackageContent CheckPackageContentOps m
pops GenericPackageDescription
gpd = Bool
-> Maybe (CheckPackageContentOps m)
-> Maybe (CheckPreDistributionOps m)
-> GenericPackageDescription
-> m [PackageCheck]
forall (m :: * -> *).
Monad m =>
Bool
-> Maybe (CheckPackageContentOps m)
-> Maybe (CheckPreDistributionOps m)
-> GenericPackageDescription
-> m [PackageCheck]
checkPackagePrim Bool
False (CheckPackageContentOps m -> Maybe (CheckPackageContentOps m)
forall a. a -> Maybe a
Just CheckPackageContentOps m
pops) Maybe (CheckPreDistributionOps m)
forall a. Maybe a
Nothing GenericPackageDescription
gpd

-- | Sanity checks that require IO. 'checkPackageFiles' looks at the files
-- in the package and expects to find the package unpacked at the given
-- filepath.
checkPackageFilesGPD
  :: Verbosity -- Glob warn message verbosity.
  -> GenericPackageDescription
  -> FilePath -- Package root.
  -> IO [PackageCheck]
checkPackageFilesGPD :: Verbosity
-> GenericPackageDescription -> String -> IO [PackageCheck]
checkPackageFilesGPD Verbosity
verbosity GenericPackageDescription
gpd String
root =
  Bool
-> Maybe (CheckPackageContentOps IO)
-> Maybe (CheckPreDistributionOps IO)
-> GenericPackageDescription
-> IO [PackageCheck]
forall (m :: * -> *).
Monad m =>
Bool
-> Maybe (CheckPackageContentOps m)
-> Maybe (CheckPreDistributionOps m)
-> GenericPackageDescription
-> m [PackageCheck]
checkPackagePrim Bool
False (CheckPackageContentOps IO -> Maybe (CheckPackageContentOps IO)
forall a. a -> Maybe a
Just CheckPackageContentOps IO
checkFilesIO) (CheckPreDistributionOps IO -> Maybe (CheckPreDistributionOps IO)
forall a. a -> Maybe a
Just CheckPreDistributionOps IO
checkPreIO) GenericPackageDescription
gpd
  where
    checkFilesIO :: CheckPackageContentOps IO
checkFilesIO =
      CheckPackageContentOps
        { doesFileExist :: String -> IO Bool
doesFileExist = String -> IO Bool
System.doesFileExist (String -> IO Bool) -> (String -> String) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
relative
        , doesDirectoryExist :: String -> IO Bool
doesDirectoryExist = String -> IO Bool
System.doesDirectoryExist (String -> IO Bool) -> (String -> String) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
relative
        , getDirectoryContents :: String -> IO [String]
getDirectoryContents = String -> IO [String]
System.Directory.getDirectoryContents (String -> IO [String])
-> (String -> String) -> String -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
relative
        , getFileContents :: String -> IO ByteString
getFileContents = String -> IO ByteString
BS.readFile (String -> IO ByteString)
-> (String -> String) -> String -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
relative
        }

    checkPreIO :: CheckPreDistributionOps IO
checkPreIO =
      CheckPreDistributionOps
        { runDirFileGlobM :: String -> Glob -> IO [GlobResult String]
runDirFileGlobM = \String
fp Glob
g -> Verbosity
-> Maybe CabalSpecVersion
-> String
-> Glob
-> IO [GlobResult String]
runDirFileGlob Verbosity
verbosity (CabalSpecVersion -> Maybe CabalSpecVersion
forall a. a -> Maybe a
Just (CabalSpecVersion -> Maybe CabalSpecVersion)
-> (PackageDescription -> CabalSpecVersion)
-> PackageDescription
-> Maybe CabalSpecVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> CabalSpecVersion
specVersion (PackageDescription -> Maybe CabalSpecVersion)
-> PackageDescription -> Maybe CabalSpecVersion
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
gpd) (String
root String -> String -> String
</> String
fp) Glob
g
        , getDirectoryContentsM :: String -> IO [String]
getDirectoryContentsM = String -> IO [String]
System.Directory.getDirectoryContents (String -> IO [String])
-> (String -> String) -> String -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
relative
        }

    relative :: String -> String
relative String
path = String
root String -> String -> String
</> String
path

-- | Same as  'checkPackageFilesGPD', but working with 'PackageDescription'.
--
-- This function is included for legacy reasons, use 'checkPackageFilesGPD'
-- if you are working with 'GenericPackageDescription'.
checkPackageFiles
  :: Verbosity -- Glob warn message verbosity.
  -> PackageDescription
  -> FilePath -- Package root.
  -> IO [PackageCheck]
checkPackageFiles :: Verbosity -> PackageDescription -> String -> IO [PackageCheck]
checkPackageFiles Verbosity
verbosity PackageDescription
pd String
oot =
  Verbosity
-> GenericPackageDescription -> String -> IO [PackageCheck]
checkPackageFilesGPD Verbosity
verbosity (PackageDescription -> GenericPackageDescription
pd2gpd PackageDescription
pd) String
oot

-- ------------------------------------------------------------
-- Package description
-- ------------------------------------------------------------

-- Here lies the meat of the module. Starting from 'GenericPackageDescription',
-- we walk the data while doing a number of checks.
--
-- Where applicable we do a full pattern match (if the data changes, code will
-- break: a gentle reminder to add more checks).
-- Pattern matching variables convention: matching accessor + underscore.
-- This way it is easier to see which one we are missing if we run into
-- an “GPD should have 20 arguments but has been given only 19” error.

-- | 'GenericPackageDescription' checks. Remember that for historical quirks
-- in the cabal codebase we have both `GenericPackageDescription` and
-- `PackageDescription` and that PD is both a *field* of GPD and a concept
-- of its own (i.e. a fully realised GPD).
-- In this case we are checking (correctly) GPD, so for target info/checks
-- you should walk condLibrary_ etc. and *not* the (empty) target info in
-- PD. See 'pd2gpd' for a convenient hack when you only have
-- 'PackageDescription'.
checkGenericPackageDescription
  :: Monad m
  => GenericPackageDescription
  -> CheckM m ()
checkGenericPackageDescription :: forall (m :: * -> *).
Monad m =>
GenericPackageDescription -> CheckM m ()
checkGenericPackageDescription
  gpd :: GenericPackageDescription
gpd@( GenericPackageDescription
          PackageDescription
packageDescription_
          Maybe Version
_gpdScannedVersion_
          [PackageFlag]
genPackageFlags_
          Maybe (CondTree ConfVar [Dependency] Library)
condLibrary_
          [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries_
          [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
condForeignLibs_
          [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
condExecutables_
          [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites_
          [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks_
        ) =
    do
      -- § Description and names.
      PackageDescription -> CheckM m ()
forall (m :: * -> *). Monad m => PackageDescription -> CheckM m ()
checkPackageDescription PackageDescription
packageDescription_
      -- Targets should be present...
      let condAllLibraries :: [CondTree ConfVar [Dependency] Library]
condAllLibraries =
            Maybe (CondTree ConfVar [Dependency] Library)
-> [CondTree ConfVar [Dependency] Library]
forall a. Maybe a -> [a]
maybeToList Maybe (CondTree ConfVar [Dependency] Library)
condLibrary_
              [CondTree ConfVar [Dependency] Library]
-> [CondTree ConfVar [Dependency] Library]
-> [CondTree ConfVar [Dependency] Library]
forall a. [a] -> [a] -> [a]
++ (((UnqualComponentName, CondTree ConfVar [Dependency] Library)
 -> CondTree ConfVar [Dependency] Library)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [CondTree ConfVar [Dependency] Library]
forall a b. (a -> b) -> [a] -> [b]
map (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> CondTree ConfVar [Dependency] Library
forall a b. (a, b) -> b
snd [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries_)
      Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
        ( [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
            [ [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
condExecutables_
            , [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites_
            , [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks_
            , [CondTree ConfVar [Dependency] Library] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CondTree ConfVar [Dependency] Library]
condAllLibraries
            , [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
condForeignLibs_
            ]
        )
        (CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
NoTarget)
      -- ... and have unique names (names are not under conditional, it is
      -- appropriate to check here.
      (nsubs, nexes, ntests, nbenchs) <-
        (CheckCtx m
 -> ([UnqualComponentName], [UnqualComponentName],
     [UnqualComponentName], [UnqualComponentName]))
-> CheckM
     m
     ([UnqualComponentName], [UnqualComponentName],
      [UnqualComponentName], [UnqualComponentName])
forall (m :: * -> *) a. Monad m => (CheckCtx m -> a) -> CheckM m a
asksCM
          ( ( \PNames
n ->
                ( PNames -> [UnqualComponentName]
pnSubLibs PNames
n
                , PNames -> [UnqualComponentName]
pnExecs PNames
n
                , PNames -> [UnqualComponentName]
pnTests PNames
n
                , PNames -> [UnqualComponentName]
pnBenchs PNames
n
                )
            )
              (PNames
 -> ([UnqualComponentName], [UnqualComponentName],
     [UnqualComponentName], [UnqualComponentName]))
-> (CheckCtx m -> PNames)
-> CheckCtx m
-> ([UnqualComponentName], [UnqualComponentName],
    [UnqualComponentName], [UnqualComponentName])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckCtx m -> PNames
forall (m :: * -> *). CheckCtx m -> PNames
ccNames
          )
      let names = [[UnqualComponentName]] -> [UnqualComponentName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[UnqualComponentName]
nsubs, [UnqualComponentName]
nexes, [UnqualComponentName]
ntests, [UnqualComponentName]
nbenchs]
          dupes = [UnqualComponentName] -> [UnqualComponentName]
forall a. Ord a => [a] -> [a]
dups [UnqualComponentName]
names
      checkP
        (not . null $ dups names)
        (PackageBuildImpossible $ DuplicateSections dupes)
      -- PackageDescription checks.
      checkPackageDescription packageDescription_
      -- Flag names.
      mapM_ checkFlagName genPackageFlags_

      -- § Feature checks.
      checkSpecVer
        CabalSpecV2_0
        (not . null $ condSubLibraries_)
        (PackageDistInexcusable CVMultiLib)
      checkSpecVer
        CabalSpecV1_8
        (not . null $ condTestSuites_)
        (PackageDistInexcusable CVTestSuite)

      -- § Conditional targets

      -- Extract dependencies from libraries, to be passed along for
      -- PVP checks purposes.
      pName <-
        asksCM
          ( packageNameToUnqualComponentName
              . pkgName
              . pnPackageId
              . ccNames
          )
      let ads =
            [AssocDep]
-> (CondTree ConfVar [Dependency] Library -> [AssocDep])
-> Maybe (CondTree ConfVar [Dependency] Library)
-> [AssocDep]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((AssocDep -> [AssocDep] -> [AssocDep]
forall a. a -> [a] -> [a]
: []) (AssocDep -> [AssocDep])
-> (CondTree ConfVar [Dependency] Library -> AssocDep)
-> CondTree ConfVar [Dependency] Library
-> [AssocDep]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName
-> CondTree ConfVar [Dependency] Library -> AssocDep
extractAssocDeps UnqualComponentName
pName) Maybe (CondTree ConfVar [Dependency] Library)
condLibrary_
              [AssocDep] -> [AssocDep] -> [AssocDep]
forall a. [a] -> [a] -> [a]
++ ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
 -> AssocDep)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [AssocDep]
forall a b. (a -> b) -> [a] -> [b]
map ((UnqualComponentName
 -> CondTree ConfVar [Dependency] Library -> AssocDep)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> AssocDep
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry UnqualComponentName
-> CondTree ConfVar [Dependency] Library -> AssocDep
extractAssocDeps) [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries_

      case condLibrary_ of
        Just CondTree ConfVar [Dependency] Library
cl ->
          [PackageFlag]
-> (Library -> CheckM m ())
-> (UnqualComponentName -> Library -> Library)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> CheckM m ()
forall (m :: * -> *) a.
(Monad m, Eq a, Monoid a) =>
[PackageFlag]
-> (a -> CheckM m ())
-> (UnqualComponentName -> a -> a)
-> (UnqualComponentName, CondTree ConfVar [Dependency] a)
-> CheckM m ()
checkCondTarget
            [PackageFlag]
genPackageFlags_
            (Bool -> [AssocDep] -> Library -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> [AssocDep] -> Library -> CheckM m ()
checkLibrary Bool
False [AssocDep]
ads)
            ((Library -> Library) -> UnqualComponentName -> Library -> Library
forall a b. a -> b -> a
const Library -> Library
forall a. a -> a
id)
            (UnqualComponentName
forall a. Monoid a => a
mempty, CondTree ConfVar [Dependency] Library
cl)
        Maybe (CondTree ConfVar [Dependency] Library)
Nothing -> () -> CheckM m ()
forall a. a -> CheckM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      mapM_
        ( checkCondTarget
            genPackageFlags_
            (checkLibrary False ads)
            (\UnqualComponentName
u Library
l -> Library
l{libName = maybeToLibraryName (Just u)})
        )
        condSubLibraries_
      mapM_
        ( checkCondTarget
            genPackageFlags_
            checkForeignLib
            (const id)
        )
        condForeignLibs_
      mapM_
        ( checkCondTarget
            genPackageFlags_
            (checkExecutable ads)
            (const id)
        )
        condExecutables_
      mapM_
        ( checkCondTarget
            genPackageFlags_
            (checkTestSuite ads)
            (\UnqualComponentName
u TestSuite
l -> TestSuite
l{testName = u})
        )
        condTestSuites_
      mapM_
        ( checkCondTarget
            genPackageFlags_
            (checkBenchmark ads)
            (\UnqualComponentName
u Benchmark
l -> Benchmark
l{benchmarkName = u})
        )
        condBenchmarks_

      -- For unused flags it is clearer and more convenient to fold the
      -- data rather than walk it, an exception to the rule.
      checkP
        (decFlags /= usedFlags)
        (PackageDistSuspicious $ DeclaredUsedFlags decFlags usedFlags)

      -- Duplicate modules.
      mapM_ tellP (checkDuplicateModules gpd)
    where
      -- todo is this caught at parse time?
      checkFlagName :: Monad m => PackageFlag -> CheckM m ()
      checkFlagName :: forall (m :: * -> *). Monad m => PackageFlag -> CheckM m ()
checkFlagName PackageFlag
pf =
        let fn :: String
fn = FlagName -> String
unFlagName (FlagName -> String)
-> (PackageFlag -> FlagName) -> PackageFlag -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageFlag -> FlagName
flagName (PackageFlag -> String) -> PackageFlag -> String
forall a b. (a -> b) -> a -> b
$ PackageFlag
pf

            invalidFlagName :: String -> Bool
invalidFlagName (Char
'-' : String
_) = Bool
True -- starts with dash
            invalidFlagName String
cs = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAscii) String
cs -- non ASCII
         in Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
              (String -> Bool
invalidFlagName String
fn)
              (CheckExplanation -> PackageCheck
PackageDistInexcusable (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ [String] -> CheckExplanation
SuspiciousFlagName [String
fn])

      decFlags :: Set.Set FlagName
      decFlags :: Set FlagName
decFlags = Getting (Set FlagName) GenericPackageDescription FlagName
-> GenericPackageDescription -> Set FlagName
forall a s. Getting (Set a) s a -> s -> Set a
toSetOf (LensLike
  (Const (Set FlagName))
  GenericPackageDescription
  GenericPackageDescription
  [PackageFlag]
  [PackageFlag]
Lens' GenericPackageDescription [PackageFlag]
L.genPackageFlags LensLike
  (Const (Set FlagName))
  GenericPackageDescription
  GenericPackageDescription
  [PackageFlag]
  [PackageFlag]
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> [PackageFlag] -> Const (Set FlagName) [PackageFlag])
-> Getting (Set FlagName) GenericPackageDescription FlagName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageFlag -> Const (Set FlagName) PackageFlag)
-> [PackageFlag] -> Const (Set FlagName) [PackageFlag]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((PackageFlag -> Const (Set FlagName) PackageFlag)
 -> [PackageFlag] -> Const (Set FlagName) [PackageFlag])
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> PackageFlag -> Const (Set FlagName) PackageFlag)
-> (FlagName -> Const (Set FlagName) FlagName)
-> [PackageFlag]
-> Const (Set FlagName) [PackageFlag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FlagName -> Const (Set FlagName) FlagName)
-> PackageFlag -> Const (Set FlagName) PackageFlag
Lens' PackageFlag FlagName
L.flagName) GenericPackageDescription
gpd

      usedFlags :: Set.Set FlagName
      usedFlags :: Set FlagName
usedFlags =
        [Set FlagName] -> Set FlagName
forall a. Monoid a => [a] -> a
mconcat
          [ Getting (Set FlagName) GenericPackageDescription FlagName
-> GenericPackageDescription -> Set FlagName
forall a s. Getting (Set a) s a -> s -> Set a
toSetOf (LensLike
  (Const (Set FlagName))
  GenericPackageDescription
  GenericPackageDescription
  (Maybe (CondTree ConfVar [Dependency] Library))
  (Maybe (CondTree ConfVar [Dependency] Library))
Lens'
  GenericPackageDescription
  (Maybe (CondTree ConfVar [Dependency] Library))
L.condLibrary LensLike
  (Const (Set FlagName))
  GenericPackageDescription
  GenericPackageDescription
  (Maybe (CondTree ConfVar [Dependency] Library))
  (Maybe (CondTree ConfVar [Dependency] Library))
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> Maybe (CondTree ConfVar [Dependency] Library)
    -> Const
         (Set FlagName) (Maybe (CondTree ConfVar [Dependency] Library)))
-> Getting (Set FlagName) GenericPackageDescription FlagName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CondTree ConfVar [Dependency] Library
 -> Const (Set FlagName) (CondTree ConfVar [Dependency] Library))
-> Maybe (CondTree ConfVar [Dependency] Library)
-> Const
     (Set FlagName) (Maybe (CondTree ConfVar [Dependency] Library))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((CondTree ConfVar [Dependency] Library
  -> Const (Set FlagName) (CondTree ConfVar [Dependency] Library))
 -> Maybe (CondTree ConfVar [Dependency] Library)
 -> Const
      (Set FlagName) (Maybe (CondTree ConfVar [Dependency] Library)))
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> CondTree ConfVar [Dependency] Library
    -> Const (Set FlagName) (CondTree ConfVar [Dependency] Library))
-> (FlagName -> Const (Set FlagName) FlagName)
-> Maybe (CondTree ConfVar [Dependency] Library)
-> Const
     (Set FlagName) (Maybe (CondTree ConfVar [Dependency] Library))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike
  (Const (Set FlagName))
  (CondTree ConfVar [Dependency] Library)
  (CondTree ConfVar [Dependency] Library)
  ConfVar
  ConfVar
forall v c a w (f :: * -> *).
Applicative f =>
LensLike f (CondTree v c a) (CondTree w c a) v w
traverseCondTreeV LensLike
  (Const (Set FlagName))
  (CondTree ConfVar [Dependency] Library)
  (CondTree ConfVar [Dependency] Library)
  ConfVar
  ConfVar
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> ConfVar -> Const (Set FlagName) ConfVar)
-> (FlagName -> Const (Set FlagName) FlagName)
-> CondTree ConfVar [Dependency] Library
-> Const (Set FlagName) (CondTree ConfVar [Dependency] Library)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FlagName -> Const (Set FlagName) FlagName)
-> ConfVar -> Const (Set FlagName) ConfVar
Traversal' ConfVar FlagName
L._PackageFlag) GenericPackageDescription
gpd
          , Getting (Set FlagName) GenericPackageDescription FlagName
-> GenericPackageDescription -> Set FlagName
forall a s. Getting (Set a) s a -> s -> Set a
toSetOf (LensLike
  (Const (Set FlagName))
  GenericPackageDescription
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
L.condSubLibraries LensLike
  (Const (Set FlagName))
  GenericPackageDescription
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
    -> Const
         (Set FlagName)
         [(UnqualComponentName, CondTree ConfVar [Dependency] Library)])
-> Getting (Set FlagName) GenericPackageDescription FlagName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
 -> Const
      (Set FlagName)
      (UnqualComponentName, CondTree ConfVar [Dependency] Library))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> Const
     (Set FlagName)
     [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (((UnqualComponentName, CondTree ConfVar [Dependency] Library)
  -> Const
       (Set FlagName)
       (UnqualComponentName, CondTree ConfVar [Dependency] Library))
 -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
 -> Const
      (Set FlagName)
      [(UnqualComponentName, CondTree ConfVar [Dependency] Library)])
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
    -> Const
         (Set FlagName)
         (UnqualComponentName, CondTree ConfVar [Dependency] Library))
-> (FlagName -> Const (Set FlagName) FlagName)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> Const
     (Set FlagName)
     [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike
  (Const (Set FlagName))
  (UnqualComponentName, CondTree ConfVar [Dependency] Library)
  (UnqualComponentName, CondTree ConfVar [Dependency] Library)
  (CondTree ConfVar [Dependency] Library)
  (CondTree ConfVar [Dependency] Library)
forall c a b (f :: * -> *).
Functor f =>
LensLike f (c, a) (c, b) a b
_2 LensLike
  (Const (Set FlagName))
  (UnqualComponentName, CondTree ConfVar [Dependency] Library)
  (UnqualComponentName, CondTree ConfVar [Dependency] Library)
  (CondTree ConfVar [Dependency] Library)
  (CondTree ConfVar [Dependency] Library)
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> CondTree ConfVar [Dependency] Library
    -> Const (Set FlagName) (CondTree ConfVar [Dependency] Library))
-> (FlagName -> Const (Set FlagName) FlagName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> Const
     (Set FlagName)
     (UnqualComponentName, CondTree ConfVar [Dependency] Library)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike
  (Const (Set FlagName))
  (CondTree ConfVar [Dependency] Library)
  (CondTree ConfVar [Dependency] Library)
  ConfVar
  ConfVar
forall v c a w (f :: * -> *).
Applicative f =>
LensLike f (CondTree v c a) (CondTree w c a) v w
traverseCondTreeV LensLike
  (Const (Set FlagName))
  (CondTree ConfVar [Dependency] Library)
  (CondTree ConfVar [Dependency] Library)
  ConfVar
  ConfVar
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> ConfVar -> Const (Set FlagName) ConfVar)
-> (FlagName -> Const (Set FlagName) FlagName)
-> CondTree ConfVar [Dependency] Library
-> Const (Set FlagName) (CondTree ConfVar [Dependency] Library)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FlagName -> Const (Set FlagName) FlagName)
-> ConfVar -> Const (Set FlagName) ConfVar
Traversal' ConfVar FlagName
L._PackageFlag) GenericPackageDescription
gpd
          , Getting (Set FlagName) GenericPackageDescription FlagName
-> GenericPackageDescription -> Set FlagName
forall a s. Getting (Set a) s a -> s -> Set a
toSetOf (LensLike
  (Const (Set FlagName))
  GenericPackageDescription
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
L.condForeignLibs LensLike
  (Const (Set FlagName))
  GenericPackageDescription
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> [(UnqualComponentName,
         CondTree ConfVar [Dependency] ForeignLib)]
    -> Const
         (Set FlagName)
         [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)])
-> Getting (Set FlagName) GenericPackageDescription FlagName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
 -> Const
      (Set FlagName)
      (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib))
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
-> Const
     (Set FlagName)
     [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (((UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
  -> Const
       (Set FlagName)
       (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib))
 -> [(UnqualComponentName,
      CondTree ConfVar [Dependency] ForeignLib)]
 -> Const
      (Set FlagName)
      [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)])
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
    -> Const
         (Set FlagName)
         (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib))
-> (FlagName -> Const (Set FlagName) FlagName)
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
-> Const
     (Set FlagName)
     [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike
  (Const (Set FlagName))
  (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
  (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
  (CondTree ConfVar [Dependency] ForeignLib)
  (CondTree ConfVar [Dependency] ForeignLib)
forall c a b (f :: * -> *).
Functor f =>
LensLike f (c, a) (c, b) a b
_2 LensLike
  (Const (Set FlagName))
  (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
  (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
  (CondTree ConfVar [Dependency] ForeignLib)
  (CondTree ConfVar [Dependency] ForeignLib)
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> CondTree ConfVar [Dependency] ForeignLib
    -> Const (Set FlagName) (CondTree ConfVar [Dependency] ForeignLib))
-> (FlagName -> Const (Set FlagName) FlagName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> Const
     (Set FlagName)
     (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike
  (Const (Set FlagName))
  (CondTree ConfVar [Dependency] ForeignLib)
  (CondTree ConfVar [Dependency] ForeignLib)
  ConfVar
  ConfVar
forall v c a w (f :: * -> *).
Applicative f =>
LensLike f (CondTree v c a) (CondTree w c a) v w
traverseCondTreeV LensLike
  (Const (Set FlagName))
  (CondTree ConfVar [Dependency] ForeignLib)
  (CondTree ConfVar [Dependency] ForeignLib)
  ConfVar
  ConfVar
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> ConfVar -> Const (Set FlagName) ConfVar)
-> (FlagName -> Const (Set FlagName) FlagName)
-> CondTree ConfVar [Dependency] ForeignLib
-> Const (Set FlagName) (CondTree ConfVar [Dependency] ForeignLib)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FlagName -> Const (Set FlagName) FlagName)
-> ConfVar -> Const (Set FlagName) ConfVar
Traversal' ConfVar FlagName
L._PackageFlag) GenericPackageDescription
gpd
          , Getting (Set FlagName) GenericPackageDescription FlagName
-> GenericPackageDescription -> Set FlagName
forall a s. Getting (Set a) s a -> s -> Set a
toSetOf (LensLike
  (Const (Set FlagName))
  GenericPackageDescription
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
L.condExecutables LensLike
  (Const (Set FlagName))
  GenericPackageDescription
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> [(UnqualComponentName,
         CondTree ConfVar [Dependency] Executable)]
    -> Const
         (Set FlagName)
         [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)])
-> Getting (Set FlagName) GenericPackageDescription FlagName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
 -> Const
      (Set FlagName)
      (UnqualComponentName, CondTree ConfVar [Dependency] Executable))
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> Const
     (Set FlagName)
     [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
  -> Const
       (Set FlagName)
       (UnqualComponentName, CondTree ConfVar [Dependency] Executable))
 -> [(UnqualComponentName,
      CondTree ConfVar [Dependency] Executable)]
 -> Const
      (Set FlagName)
      [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)])
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
    -> Const
         (Set FlagName)
         (UnqualComponentName, CondTree ConfVar [Dependency] Executable))
-> (FlagName -> Const (Set FlagName) FlagName)
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> Const
     (Set FlagName)
     [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike
  (Const (Set FlagName))
  (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
  (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
  (CondTree ConfVar [Dependency] Executable)
  (CondTree ConfVar [Dependency] Executable)
forall c a b (f :: * -> *).
Functor f =>
LensLike f (c, a) (c, b) a b
_2 LensLike
  (Const (Set FlagName))
  (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
  (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
  (CondTree ConfVar [Dependency] Executable)
  (CondTree ConfVar [Dependency] Executable)
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> CondTree ConfVar [Dependency] Executable
    -> Const (Set FlagName) (CondTree ConfVar [Dependency] Executable))
-> (FlagName -> Const (Set FlagName) FlagName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> Const
     (Set FlagName)
     (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike
  (Const (Set FlagName))
  (CondTree ConfVar [Dependency] Executable)
  (CondTree ConfVar [Dependency] Executable)
  ConfVar
  ConfVar
forall v c a w (f :: * -> *).
Applicative f =>
LensLike f (CondTree v c a) (CondTree w c a) v w
traverseCondTreeV LensLike
  (Const (Set FlagName))
  (CondTree ConfVar [Dependency] Executable)
  (CondTree ConfVar [Dependency] Executable)
  ConfVar
  ConfVar
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> ConfVar -> Const (Set FlagName) ConfVar)
-> (FlagName -> Const (Set FlagName) FlagName)
-> CondTree ConfVar [Dependency] Executable
-> Const (Set FlagName) (CondTree ConfVar [Dependency] Executable)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FlagName -> Const (Set FlagName) FlagName)
-> ConfVar -> Const (Set FlagName) ConfVar
Traversal' ConfVar FlagName
L._PackageFlag) GenericPackageDescription
gpd
          , Getting (Set FlagName) GenericPackageDescription FlagName
-> GenericPackageDescription -> Set FlagName
forall a s. Getting (Set a) s a -> s -> Set a
toSetOf (LensLike
  (Const (Set FlagName))
  GenericPackageDescription
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
L.condTestSuites LensLike
  (Const (Set FlagName))
  GenericPackageDescription
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
    -> Const
         (Set FlagName)
         [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)])
-> Getting (Set FlagName) GenericPackageDescription FlagName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
 -> Const
      (Set FlagName)
      (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> Const
     (Set FlagName)
     [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
  -> Const
       (Set FlagName)
       (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite))
 -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
 -> Const
      (Set FlagName)
      [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)])
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
    -> Const
         (Set FlagName)
         (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite))
-> (FlagName -> Const (Set FlagName) FlagName)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> Const
     (Set FlagName)
     [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike
  (Const (Set FlagName))
  (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
  (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
  (CondTree ConfVar [Dependency] TestSuite)
  (CondTree ConfVar [Dependency] TestSuite)
forall c a b (f :: * -> *).
Functor f =>
LensLike f (c, a) (c, b) a b
_2 LensLike
  (Const (Set FlagName))
  (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
  (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
  (CondTree ConfVar [Dependency] TestSuite)
  (CondTree ConfVar [Dependency] TestSuite)
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> CondTree ConfVar [Dependency] TestSuite
    -> Const (Set FlagName) (CondTree ConfVar [Dependency] TestSuite))
-> (FlagName -> Const (Set FlagName) FlagName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> Const
     (Set FlagName)
     (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike
  (Const (Set FlagName))
  (CondTree ConfVar [Dependency] TestSuite)
  (CondTree ConfVar [Dependency] TestSuite)
  ConfVar
  ConfVar
forall v c a w (f :: * -> *).
Applicative f =>
LensLike f (CondTree v c a) (CondTree w c a) v w
traverseCondTreeV LensLike
  (Const (Set FlagName))
  (CondTree ConfVar [Dependency] TestSuite)
  (CondTree ConfVar [Dependency] TestSuite)
  ConfVar
  ConfVar
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> ConfVar -> Const (Set FlagName) ConfVar)
-> (FlagName -> Const (Set FlagName) FlagName)
-> CondTree ConfVar [Dependency] TestSuite
-> Const (Set FlagName) (CondTree ConfVar [Dependency] TestSuite)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FlagName -> Const (Set FlagName) FlagName)
-> ConfVar -> Const (Set FlagName) ConfVar
Traversal' ConfVar FlagName
L._PackageFlag) GenericPackageDescription
gpd
          , Getting (Set FlagName) GenericPackageDescription FlagName
-> GenericPackageDescription -> Set FlagName
forall a s. Getting (Set a) s a -> s -> Set a
toSetOf (LensLike
  (Const (Set FlagName))
  GenericPackageDescription
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
L.condBenchmarks LensLike
  (Const (Set FlagName))
  GenericPackageDescription
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
    -> Const
         (Set FlagName)
         [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)])
-> Getting (Set FlagName) GenericPackageDescription FlagName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
 -> Const
      (Set FlagName)
      (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> Const
     (Set FlagName)
     [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
  -> Const
       (Set FlagName)
       (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark))
 -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
 -> Const
      (Set FlagName)
      [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)])
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
    -> Const
         (Set FlagName)
         (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark))
-> (FlagName -> Const (Set FlagName) FlagName)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> Const
     (Set FlagName)
     [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike
  (Const (Set FlagName))
  (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
  (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
  (CondTree ConfVar [Dependency] Benchmark)
  (CondTree ConfVar [Dependency] Benchmark)
forall c a b (f :: * -> *).
Functor f =>
LensLike f (c, a) (c, b) a b
_2 LensLike
  (Const (Set FlagName))
  (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
  (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
  (CondTree ConfVar [Dependency] Benchmark)
  (CondTree ConfVar [Dependency] Benchmark)
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> CondTree ConfVar [Dependency] Benchmark
    -> Const (Set FlagName) (CondTree ConfVar [Dependency] Benchmark))
-> (FlagName -> Const (Set FlagName) FlagName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> Const
     (Set FlagName)
     (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike
  (Const (Set FlagName))
  (CondTree ConfVar [Dependency] Benchmark)
  (CondTree ConfVar [Dependency] Benchmark)
  ConfVar
  ConfVar
forall v c a w (f :: * -> *).
Applicative f =>
LensLike f (CondTree v c a) (CondTree w c a) v w
traverseCondTreeV LensLike
  (Const (Set FlagName))
  (CondTree ConfVar [Dependency] Benchmark)
  (CondTree ConfVar [Dependency] Benchmark)
  ConfVar
  ConfVar
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> ConfVar -> Const (Set FlagName) ConfVar)
-> (FlagName -> Const (Set FlagName) FlagName)
-> CondTree ConfVar [Dependency] Benchmark
-> Const (Set FlagName) (CondTree ConfVar [Dependency] Benchmark)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FlagName -> Const (Set FlagName) FlagName)
-> ConfVar -> Const (Set FlagName) ConfVar
Traversal' ConfVar FlagName
L._PackageFlag) GenericPackageDescription
gpd
          ]

checkPackageDescription :: Monad m => PackageDescription -> CheckM m ()
checkPackageDescription :: forall (m :: * -> *). Monad m => PackageDescription -> CheckM m ()
checkPackageDescription
  pkg :: PackageDescription
pkg@( PackageDescription
          CabalSpecVersion
specVersion_
          PackageIdentifier
package_
          Either License License
licenseRaw_
          [SymbolicPath PackageDir LicenseFile]
licenseFiles_
          ShortText
_copyright_
          ShortText
maintainer_
          ShortText
_author_
          ShortText
_stability_
          [(CompilerFlavor, VersionRange)]
testedWith_
          ShortText
_homepage_
          ShortText
_pkgUrl_
          ShortText
_bugReports_
          [SourceRepo]
sourceRepos_
          ShortText
synopsis_
          ShortText
description_
          ShortText
category_
          [(String, String)]
customFieldsPD_
          Maybe BuildType
buildTypeRaw_
          Maybe SetupBuildInfo
setupBuildInfo_
          Maybe Library
_library_
          [Library]
_subLibraries_
          [Executable]
_executables_
          [ForeignLib]
_foreignLibs_
          [TestSuite]
_testSuites_
          [Benchmark]
_benchmarks_
          [String]
dataFiles_
          String
dataDir_
          [String]
extraSrcFiles_
          [String]
extraTmpFiles_
          [String]
extraDocFiles_
        ) = do
    -- § Sanity checks.
    PackageIdentifier -> CheckM m ()
forall (m :: * -> *). Monad m => PackageIdentifier -> CheckM m ()
checkPackageId PackageIdentifier
package_
    -- TODO `name` is caught at parse level, remove this test.
    let pn :: PackageName
pn = PackageIdentifier -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageIdentifier
package_
    Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
      (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> (PackageName -> String) -> PackageName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
unPackageName (PackageName -> Bool) -> PackageName -> Bool
forall a b. (a -> b) -> a -> b
$ PackageName
pn)
      (CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
NoNameField)
    -- TODO `version` is caught at parse level, remove this test.
    Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
      (Version
nullVersion Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== PackageIdentifier -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion PackageIdentifier
package_)
      (CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
NoVersionField)
    -- But it is OK for executables to have the same name.
    nsubs <- (CheckCtx m -> [UnqualComponentName])
-> CheckM m [UnqualComponentName]
forall (m :: * -> *) a. Monad m => (CheckCtx m -> a) -> CheckM m a
asksCM (PNames -> [UnqualComponentName]
pnSubLibs (PNames -> [UnqualComponentName])
-> (CheckCtx m -> PNames) -> CheckCtx m -> [UnqualComponentName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckCtx m -> PNames
forall (m :: * -> *). CheckCtx m -> PNames
ccNames)
    checkP
      (any (== prettyShow pn) (prettyShow <$> nsubs))
      (PackageBuildImpossible $ IllegalLibraryName pn)

    -- § Fields check.
    checkNull
      category_
      (PackageDistSuspicious MissingFieldCategory)
    checkNull
      maintainer_
      (PackageDistSuspicious MissingFieldMaintainer)
    checkP
      (ShortText.null synopsis_ && not (ShortText.null description_))
      (PackageDistSuspicious MissingFieldSynopsis)
    checkP
      (ShortText.null description_ && not (ShortText.null synopsis_))
      (PackageDistSuspicious MissingFieldDescription)
    checkP
      (all ShortText.null [synopsis_, description_])
      (PackageDistInexcusable MissingFieldSynOrDesc)
    checkP
      (ShortText.length synopsis_ > 80)
      (PackageDistSuspicious SynopsisTooLong)
    checkP
      ( not (ShortText.null description_)
          && ShortText.length description_ <= ShortText.length synopsis_
      )
      (PackageDistSuspicious ShortDesc)

    -- § Paths.
    mapM_ (checkPath False "extra-source-files" PathKindGlob) extraSrcFiles_
    mapM_ (checkPath False "extra-tmp-files" PathKindFile) extraTmpFiles_
    mapM_ (checkPath False "extra-doc-files" PathKindGlob) extraDocFiles_
    mapM_ (checkPath False "data-files" PathKindGlob) dataFiles_
    checkPath True "data-dir" PathKindDirectory dataDir_
    let licPaths = (SymbolicPath PackageDir LicenseFile -> String)
-> [SymbolicPath PackageDir LicenseFile] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir LicenseFile -> String
forall from to. SymbolicPath from to -> String
getSymbolicPath [SymbolicPath PackageDir LicenseFile]
licenseFiles_
    mapM_ (checkPath False "license-file" PathKindFile) licPaths
    mapM_ checkLicFileExist licenseFiles_

    -- § Globs.
    dataGlobs <- mapM (checkGlob "data-files") dataFiles_
    extraGlobs <- mapM (checkGlob "extra-source-files") extraSrcFiles_
    docGlobs <- mapM (checkGlob "extra-doc-files") extraDocFiles_
    -- We collect globs to feed them to checkMissingDocs.

    -- § Missing documentation.
    checkMissingDocs
      (catMaybes dataGlobs)
      (catMaybes extraGlobs)
      (catMaybes docGlobs)

    -- § Datafield checks.
    checkSetupBuildInfo setupBuildInfo_
    mapM_ checkTestedWith testedWith_
    either
      checkNewLicense
      (checkOldLicense $ null licenseFiles_)
      licenseRaw_
    checkSourceRepos sourceRepos_
    mapM_ checkCustomField customFieldsPD_

    -- Feature checks.
    checkSpecVer
      CabalSpecV1_18
      (not . null $ extraDocFiles_)
      (PackageDistInexcusable CVExtraDocFiles)
    checkSpecVer
      CabalSpecV1_6
      (not . null $ sourceRepos_)
      (PackageDistInexcusable CVSourceRepository)
    checkP
      ( specVersion_ >= CabalSpecV1_24
          && isNothing setupBuildInfo_
          && buildTypeRaw_ == Just Custom
      )
      (PackageBuildWarning CVCustomSetup)
    checkSpecVer
      CabalSpecV1_24
      ( isNothing setupBuildInfo_
          && buildTypeRaw_ == Just Custom
      )
      (PackageDistSuspiciousWarn CVExpliticDepsCustomSetup)
    checkP
      (isNothing buildTypeRaw_ && specVersion_ < CabalSpecV2_2)
      (PackageBuildWarning NoBuildType)
    checkP
      (isJust setupBuildInfo_ && buildType pkg /= Custom)
      (PackageBuildWarning NoCustomSetup)

    -- Contents.
    checkConfigureExists (buildType pkg)
    checkSetupExists (buildType pkg)
    checkCabalFile (packageName pkg)
    mapM_ (checkGlobFile specVersion_ "." "extra-source-files") extraSrcFiles_
    mapM_ (checkGlobFile specVersion_ "." "extra-doc-files") extraDocFiles_
    mapM_ (checkGlobFile specVersion_ dataDir_ "data-files") dataFiles_
    where
      checkNull
        :: Monad m
        => ShortText.ShortText
        -> PackageCheck
        -> CheckM m ()
      checkNull :: forall (m :: * -> *).
Monad m =>
ShortText -> PackageCheck -> CheckM m ()
checkNull ShortText
st PackageCheck
c = Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP (ShortText -> Bool
ShortText.null ShortText
st) PackageCheck
c

      checkTestedWith
        :: Monad m
        => (CompilerFlavor, VersionRange)
        -> CheckM m ()
      checkTestedWith :: forall (m :: * -> *).
Monad m =>
(CompilerFlavor, VersionRange) -> CheckM m ()
checkTestedWith (OtherCompiler String
n, VersionRange
_) =
        PackageCheck -> CheckM m ()
forall (m :: * -> *). Monad m => PackageCheck -> CheckM m ()
tellP (CheckExplanation -> PackageCheck
PackageBuildWarning (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ [String] -> CheckExplanation
UnknownCompilers [String
n])
      checkTestedWith (CompilerFlavor
compiler, VersionRange
versionRange) =
        CompilerFlavor -> VersionRange -> CheckM m ()
forall (m :: * -> *).
Monad m =>
CompilerFlavor -> VersionRange -> CheckM m ()
checkVersionRange CompilerFlavor
compiler VersionRange
versionRange

      checkVersionRange
        :: Monad m
        => CompilerFlavor
        -> VersionRange
        -> CheckM m ()
      checkVersionRange :: forall (m :: * -> *).
Monad m =>
CompilerFlavor -> VersionRange -> CheckM m ()
checkVersionRange CompilerFlavor
cmp VersionRange
vr =
        Bool -> CheckM m () -> CheckM m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
          (VersionRange -> Bool
isNoVersion VersionRange
vr)
          ( let dep :: [Dependency]
dep =
                  [ PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency
                      (String -> PackageName
mkPackageName (CompilerFlavor -> String
forall a. Pretty a => a -> String
prettyShow CompilerFlavor
cmp))
                      VersionRange
vr
                      NonEmptySet LibraryName
mainLibSet
                  ]
             in PackageCheck -> CheckM m ()
forall (m :: * -> *). Monad m => PackageCheck -> CheckM m ()
tellP (CheckExplanation -> PackageCheck
PackageDistInexcusable ([Dependency] -> CheckExplanation
InvalidTestWith [Dependency]
dep))
          )

checkSetupBuildInfo :: Monad m => Maybe SetupBuildInfo -> CheckM m ()
checkSetupBuildInfo :: forall (m :: * -> *).
Monad m =>
Maybe SetupBuildInfo -> CheckM m ()
checkSetupBuildInfo Maybe SetupBuildInfo
Nothing = () -> CheckM m ()
forall a. a -> CheckM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkSetupBuildInfo (Just (SetupBuildInfo [Dependency]
ds Bool
_)) = do
  let uqs :: [UnqualComponentName]
uqs = (String -> UnqualComponentName)
-> [String] -> [UnqualComponentName]
forall a b. (a -> b) -> [a] -> [b]
map String -> UnqualComponentName
mkUnqualComponentName [String
"base", String
"Cabal"]
  (is, rs) <- [AssocDep]
-> [UnqualComponentName]
-> [Dependency]
-> CheckM m ([Dependency], [Dependency])
forall (m :: * -> *).
Monad m =>
[AssocDep]
-> [UnqualComponentName]
-> [Dependency]
-> CheckM m ([Dependency], [Dependency])
partitionDeps [] [UnqualComponentName]
uqs [Dependency]
ds
  let ick = CheckExplanation -> PackageCheck
PackageDistInexcusable (CheckExplanation -> PackageCheck)
-> (String -> CheckExplanation) -> String -> PackageCheck
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CheckExplanation
UpperBoundSetup
      rck =
        CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn
          (CheckExplanation -> PackageCheck)
-> ([String] -> CheckExplanation) -> [String] -> PackageCheck
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CEType -> [String] -> CheckExplanation
MissingUpperBounds CEType
CETSetup
  checkPVP ick is
  checkPVPs rck rs

checkPackageId :: Monad m => PackageIdentifier -> CheckM m ()
checkPackageId :: forall (m :: * -> *). Monad m => PackageIdentifier -> CheckM m ()
checkPackageId (PackageIdentifier PackageName
pkgName_ Version
_pkgVersion_) = do
  Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
    (Bool -> Bool
not (Bool -> Bool) -> (PackageName -> Bool) -> PackageName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
FilePath.Windows.isValid (String -> Bool) -> (PackageName -> String) -> PackageName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
forall a. Pretty a => a -> String
prettyShow (PackageName -> Bool) -> PackageName -> Bool
forall a b. (a -> b) -> a -> b
$ PackageName
pkgName_)
    (CheckExplanation -> PackageCheck
PackageDistInexcusable (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ PackageName -> CheckExplanation
InvalidNameWin PackageName
pkgName_)
  Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"z-" (String -> Bool) -> (PackageName -> String) -> PackageName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
forall a. Pretty a => a -> String
prettyShow (PackageName -> Bool) -> PackageName -> Bool
forall a b. (a -> b) -> a -> b
$ PackageName
pkgName_) (PackageCheck -> CheckM m ()) -> PackageCheck -> CheckM m ()
forall a b. (a -> b) -> a -> b
$
    (CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
ZPrefix)

checkNewLicense :: Monad m => SPDX.License -> CheckM m ()
checkNewLicense :: forall (m :: * -> *). Monad m => License -> CheckM m ()
checkNewLicense License
lic = do
  Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
    (License
lic License -> License -> Bool
forall a. Eq a => a -> a -> Bool
== License
SPDX.NONE)
    (CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
NONELicense)

checkOldLicense
  :: Monad m
  => Bool -- Flag: no license file?
  -> License
  -> CheckM m ()
checkOldLicense :: forall (m :: * -> *). Monad m => Bool -> License -> CheckM m ()
checkOldLicense Bool
nullLicFiles License
lic = do
  Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
    (License
lic License -> License -> Bool
forall a. Eq a => a -> a -> Bool
== License
UnspecifiedLicense)
    (CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
NoLicense)
  Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
    (License
lic License -> License -> Bool
forall a. Eq a => a -> a -> Bool
== License
AllRightsReserved)
    (CheckExplanation -> PackageCheck
PackageDistSuspicious CheckExplanation
AllRightsReservedLicense)
  CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
checkSpecVer
    CabalSpecVersion
CabalSpecV1_4
    (License
lic License -> [License] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [License]
compatLicenses)
    (CheckExplanation -> PackageCheck
PackageDistInexcusable (License -> CheckExplanation
LicenseMessParse License
lic))
  Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
    (License
lic License -> License -> Bool
forall a. Eq a => a -> a -> Bool
== License
BSD4)
    (CheckExplanation -> PackageCheck
PackageDistSuspicious CheckExplanation
UncommonBSD4)
  case License
lic of
    UnknownLicense String
l ->
      PackageCheck -> CheckM m ()
forall (m :: * -> *). Monad m => PackageCheck -> CheckM m ()
tellP (CheckExplanation -> PackageCheck
PackageBuildWarning (String -> CheckExplanation
UnrecognisedLicense String
l))
    License
_ -> () -> CheckM m ()
forall a. a -> CheckM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
    ( License
lic
        License -> [License] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ License
AllRightsReserved
                  , License
UnspecifiedLicense
                  , License
PublicDomain
                  ]
        Bool -> Bool -> Bool
&&
        -- AllRightsReserved and PublicDomain are not strictly
        -- licenses so don't need license files.
        Bool
nullLicFiles
    )
    (PackageCheck -> CheckM m ()) -> PackageCheck -> CheckM m ()
forall a b. (a -> b) -> a -> b
$ (CheckExplanation -> PackageCheck
PackageDistSuspicious CheckExplanation
NoLicenseFile)
  case License -> Maybe [Version]
unknownLicenseVersion License
lic of
    Just [Version]
knownVersions ->
      PackageCheck -> CheckM m ()
forall (m :: * -> *). Monad m => PackageCheck -> CheckM m ()
tellP
        (CheckExplanation -> PackageCheck
PackageDistSuspicious (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ License -> [Version] -> CheckExplanation
UnknownLicenseVersion License
lic [Version]
knownVersions)
    Maybe [Version]
_ -> () -> CheckM m ()
forall a. a -> CheckM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    compatLicenses :: [License]
compatLicenses =
      [ Maybe Version -> License
GPL Maybe Version
forall a. Maybe a
Nothing
      , Maybe Version -> License
LGPL Maybe Version
forall a. Maybe a
Nothing
      , Maybe Version -> License
AGPL Maybe Version
forall a. Maybe a
Nothing
      , License
BSD3
      , License
BSD4
      , License
PublicDomain
      , License
AllRightsReserved
      , License
UnspecifiedLicense
      , License
OtherLicense
      ]

    unknownLicenseVersion :: License -> Maybe [Version]
unknownLicenseVersion (GPL (Just Version
v))
      | Version
v Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Version]
knownVersions = [Version] -> Maybe [Version]
forall a. a -> Maybe a
Just [Version]
knownVersions
      where
        knownVersions :: [Version]
knownVersions = [Version
v' | GPL (Just Version
v') <- [License]
knownLicenses]
    unknownLicenseVersion (LGPL (Just Version
v))
      | Version
v Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Version]
knownVersions = [Version] -> Maybe [Version]
forall a. a -> Maybe a
Just [Version]
knownVersions
      where
        knownVersions :: [Version]
knownVersions = [Version
v' | LGPL (Just Version
v') <- [License]
knownLicenses]
    unknownLicenseVersion (AGPL (Just Version
v))
      | Version
v Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Version]
knownVersions = [Version] -> Maybe [Version]
forall a. a -> Maybe a
Just [Version]
knownVersions
      where
        knownVersions :: [Version]
knownVersions = [Version
v' | AGPL (Just Version
v') <- [License]
knownLicenses]
    unknownLicenseVersion (Apache (Just Version
v))
      | Version
v Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Version]
knownVersions = [Version] -> Maybe [Version]
forall a. a -> Maybe a
Just [Version]
knownVersions
      where
        knownVersions :: [Version]
knownVersions = [Version
v' | Apache (Just Version
v') <- [License]
knownLicenses]
    unknownLicenseVersion License
_ = Maybe [Version]
forall a. Maybe a
Nothing

checkSourceRepos :: Monad m => [SourceRepo] -> CheckM m ()
checkSourceRepos :: forall (m :: * -> *). Monad m => [SourceRepo] -> CheckM m ()
checkSourceRepos [SourceRepo]
rs = do
  (SourceRepo -> CheckM m ()) -> [SourceRepo] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SourceRepo -> CheckM m ()
forall (m :: * -> *). Monad m => SourceRepo -> CheckM m ()
repoCheck [SourceRepo]
rs
  [SourceRepo] -> CheckM m ()
forall (m :: * -> *). Monad m => [SourceRepo] -> CheckM m ()
checkMissingVcsInfo [SourceRepo]
rs
  where
    -- Single repository checks.
    repoCheck :: Monad m => SourceRepo -> CheckM m ()
    repoCheck :: forall (m :: * -> *). Monad m => SourceRepo -> CheckM m ()
repoCheck
      ( SourceRepo
          RepoKind
repoKind_
          Maybe RepoType
repoType_
          Maybe String
repoLocation_
          Maybe String
repoModule_
          Maybe String
_repoBranch_
          Maybe String
repoTag_
          Maybe String
repoSubdir_
        ) = do
        case RepoKind
repoKind_ of
          RepoKindUnknown String
kind ->
            PackageCheck -> CheckM m ()
forall (m :: * -> *). Monad m => PackageCheck -> CheckM m ()
tellP
              (CheckExplanation -> PackageCheck
PackageDistInexcusable (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ String -> CheckExplanation
UnrecognisedSourceRepo String
kind)
          RepoKind
_ -> () -> CheckM m ()
forall a. a -> CheckM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
          (Maybe RepoType -> Bool
forall a. Maybe a -> Bool
isNothing Maybe RepoType
repoType_)
          (CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
MissingType)
        Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
          (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
repoLocation_)
          (CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
MissingLocation)
        Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
          ( Maybe RepoType
repoType_ Maybe RepoType -> Maybe RepoType -> Bool
forall a. Eq a => a -> a -> Bool
== RepoType -> Maybe RepoType
forall a. a -> Maybe a
Just (KnownRepoType -> RepoType
KnownRepoType KnownRepoType
CVS)
              Bool -> Bool -> Bool
&& Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
repoModule_
          )
          (CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
MissingModule)
        Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
          (RepoKind
repoKind_ RepoKind -> RepoKind -> Bool
forall a. Eq a => a -> a -> Bool
== RepoKind
RepoThis Bool -> Bool -> Bool
&& Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
repoTag_)
          (CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
MissingTag)
        Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
          ((String -> Bool) -> Maybe String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any String -> Bool
isAbsoluteOnAnyPlatform Maybe String
repoSubdir_)
          (CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
SubdirRelPath)
        case Maybe (Maybe String) -> Maybe String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe String) -> Maybe String)
-> (Maybe String -> Maybe (Maybe String))
-> Maybe String
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe String) -> Maybe String -> Maybe (Maybe String)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Maybe String
isGoodRelativeDirectoryPath (Maybe String -> Maybe String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Maybe String
repoSubdir_ of
          Just String
err ->
            PackageCheck -> CheckM m ()
forall (m :: * -> *). Monad m => PackageCheck -> CheckM m ()
tellP
              (CheckExplanation -> PackageCheck
PackageDistInexcusable (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ String -> CheckExplanation
SubdirGoodRelPath String
err)
          Maybe String
Nothing -> () -> CheckM m ()
forall a. a -> CheckM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

checkMissingVcsInfo :: Monad m => [SourceRepo] -> CheckM m ()
checkMissingVcsInfo :: forall (m :: * -> *). Monad m => [SourceRepo] -> CheckM m ()
checkMissingVcsInfo [SourceRepo]
rs =
  let rdirs :: [String]
rdirs = (KnownRepoType -> [String]) -> [KnownRepoType] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap KnownRepoType -> [String]
repoTypeDirname [KnownRepoType]
knownRepoTypes
   in (CheckPackageContentOps m -> m Bool) -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
(CheckPackageContentOps m -> m Bool) -> PackageCheck -> CheckM m ()
checkPkg
        ( \CheckPackageContentOps m
ops -> do
            us <- [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> m [Bool] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> m Bool) -> [String] -> m [Bool]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (CheckPackageContentOps m -> String -> m Bool
forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesDirectoryExist CheckPackageContentOps m
ops) [String]
rdirs
            return (null rs && us)
        )
        (CheckExplanation -> PackageCheck
PackageDistSuspicious CheckExplanation
MissingSourceControl)
  where
    repoTypeDirname :: KnownRepoType -> [FilePath]
    repoTypeDirname :: KnownRepoType -> [String]
repoTypeDirname KnownRepoType
Darcs = [String
"_darcs"]
    repoTypeDirname KnownRepoType
Git = [String
".git"]
    repoTypeDirname KnownRepoType
SVN = [String
".svn"]
    repoTypeDirname KnownRepoType
CVS = [String
"CVS"]
    repoTypeDirname KnownRepoType
Mercurial = [String
".hg"]
    repoTypeDirname KnownRepoType
GnuArch = [String
".arch-params"]
    repoTypeDirname KnownRepoType
Bazaar = [String
".bzr"]
    repoTypeDirname KnownRepoType
Monotone = [String
"_MTN"]
    repoTypeDirname KnownRepoType
Pijul = [String
".pijul"]

-- ------------------------------------------------------------
-- Package and distribution checks
-- ------------------------------------------------------------

-- | Find a package description file in the given directory.  Looks for
-- @.cabal@ files.  Like 'Distribution.Simple.Utils.findPackageDesc',
-- but generalized over monads.
findPackageDesc :: Monad m => CheckPackageContentOps m -> m [FilePath]
findPackageDesc :: forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m -> m [String]
findPackageDesc CheckPackageContentOps m
ops = do
  let dir :: String
dir = String
"."
  files <- CheckPackageContentOps m -> String -> m [String]
forall (m :: * -> *).
CheckPackageContentOps m -> String -> m [String]
getDirectoryContents CheckPackageContentOps m
ops String
dir
  -- to make sure we do not mistake a ~/.cabal/ dir for a <name>.cabal
  -- file we filter to exclude dirs and null base file names:
  cabalFiles <-
    filterM
      (doesFileExist ops)
      [ dir </> file
      | file <- files
      , let (name, ext) = splitExtension file
      , not (null name) && ext == ".cabal"
      ]
  return cabalFiles

checkCabalFile :: Monad m => PackageName -> CheckM m ()
checkCabalFile :: forall (m :: * -> *). Monad m => PackageName -> CheckM m ()
checkCabalFile PackageName
pn = do
  -- liftInt is a bit more messy than stricter interface, but since
  -- each of the following check is exclusive, we can simplify the
  -- condition flow.
  (CheckInterface m -> Maybe (CheckPackageContentOps m))
-> (CheckPackageContentOps m -> m [PackageCheck]) -> CheckM m ()
forall (m :: * -> *) (i :: (* -> *) -> *).
Monad m =>
(CheckInterface m -> Maybe (i m))
-> (i m -> m [PackageCheck]) -> CheckM m ()
liftInt
    CheckInterface m -> Maybe (CheckPackageContentOps m)
forall (m :: * -> *).
CheckInterface m -> Maybe (CheckPackageContentOps m)
ciPackageOps
    ( \CheckPackageContentOps m
ops -> do
        -- 1. Get .cabal files.
        ds <- CheckPackageContentOps m -> m [String]
forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m -> m [String]
findPackageDesc CheckPackageContentOps m
ops
        case ds of
          [] -> [PackageCheck] -> m [PackageCheck]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
NoDesc]
          -- No .cabal file.
          [String
d] -> do
            bc <- CheckPackageContentOps m -> String -> m (Maybe PackageCheck)
forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m -> String -> m (Maybe PackageCheck)
bomf CheckPackageContentOps m
ops String
d
            return (catMaybes [bc, noMatch d])
          -- BOM + no matching .cabal checks.
          [String]
_ -> [PackageCheck] -> m [PackageCheck]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [CheckExplanation -> PackageCheck
PackageBuildImpossible (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ [String] -> CheckExplanation
MultiDesc [String]
ds]
    )
  where
    -- Multiple .cabal files.

    bomf
      :: Monad m
      => CheckPackageContentOps m
      -> FilePath
      -> m (Maybe PackageCheck)
    bomf :: forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m -> String -> m (Maybe PackageCheck)
bomf CheckPackageContentOps m
wops String
wfp = do
      b <- ByteString -> ByteString -> Bool
BS.isPrefixOf ByteString
bomUtf8 (ByteString -> Bool) -> m ByteString -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CheckPackageContentOps m -> String -> m ByteString
forall (m :: * -> *).
CheckPackageContentOps m -> String -> m ByteString
getFileContents CheckPackageContentOps m
wops String
wfp
      if b
        then (return . Just) (PackageDistInexcusable $ BOMStart wfp)
        else return Nothing

    bomUtf8 :: BS.ByteString
    bomUtf8 :: ByteString
bomUtf8 = [Word8] -> ByteString
BS.pack [Word8
0xef, Word8
0xbb, Word8
0xbf] -- U+FEFF encoded as UTF8
    noMatch :: FilePath -> Maybe PackageCheck
    noMatch :: String -> Maybe PackageCheck
noMatch String
wd =
      let expd :: String
expd = PackageName -> String
unPackageName PackageName
pn String -> String -> String
<.> String
"cabal"
       in if String -> String
takeFileName String
wd String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
expd
            then PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
Just (CheckExplanation -> PackageCheck
PackageDistInexcusable (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ String -> String -> CheckExplanation
NotPackageName String
wd String
expd)
            else Maybe PackageCheck
forall a. Maybe a
Nothing

checkLicFileExist
  :: Monad m
  => SymbolicPath PackageDir LicenseFile
  -> CheckM m ()
checkLicFileExist :: forall (m :: * -> *).
Monad m =>
SymbolicPath PackageDir LicenseFile -> CheckM m ()
checkLicFileExist SymbolicPath PackageDir LicenseFile
sp = do
  let fp :: String
fp = SymbolicPath PackageDir LicenseFile -> String
forall from to. SymbolicPath from to -> String
getSymbolicPath SymbolicPath PackageDir LicenseFile
sp
  (CheckPackageContentOps m -> m Bool) -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
(CheckPackageContentOps m -> m Bool) -> PackageCheck -> CheckM m ()
checkPkg
    (\CheckPackageContentOps m
ops -> Bool -> Bool
not (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CheckPackageContentOps m -> String -> m Bool
forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesFileExist CheckPackageContentOps m
ops String
fp)
    (CheckExplanation -> PackageCheck
PackageBuildWarning (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ String -> SymbolicPath PackageDir LicenseFile -> CheckExplanation
UnknownFile String
"license-file" SymbolicPath PackageDir LicenseFile
sp)

checkConfigureExists :: Monad m => BuildType -> CheckM m ()
checkConfigureExists :: forall (m :: * -> *). Monad m => BuildType -> CheckM m ()
checkConfigureExists BuildType
Configure =
  (CheckPackageContentOps m -> m Bool) -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
(CheckPackageContentOps m -> m Bool) -> PackageCheck -> CheckM m ()
checkPkg
    (\CheckPackageContentOps m
ops -> Bool -> Bool
not (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CheckPackageContentOps m -> String -> m Bool
forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesFileExist CheckPackageContentOps m
ops String
"configure")
    (CheckExplanation -> PackageCheck
PackageBuildWarning CheckExplanation
MissingConfigureScript)
checkConfigureExists BuildType
_ = () -> CheckM m ()
forall a. a -> CheckM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

checkSetupExists :: Monad m => BuildType -> CheckM m ()
checkSetupExists :: forall (m :: * -> *). Monad m => BuildType -> CheckM m ()
checkSetupExists BuildType
Simple = () -> CheckM m ()
forall a. a -> CheckM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkSetupExists BuildType
_ =
  (CheckPackageContentOps m -> m Bool) -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
(CheckPackageContentOps m -> m Bool) -> PackageCheck -> CheckM m ()
checkPkg
    ( \CheckPackageContentOps m
ops -> do
        ba <- CheckPackageContentOps m -> String -> m Bool
forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesFileExist CheckPackageContentOps m
ops String
"Setup.hs"
        bb <- doesFileExist ops "Setup.lhs"
        return (not $ ba || bb)
    )
    (CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
MissingSetupFile)

-- The following functions are similar to 'CheckPackageContentOps m' ones,
-- but, as they inspect the files included in the package, but are primarily
-- looking for files in the working tree that may have been missed or other
-- similar problems that can only be detected pre-distribution.
--
-- Because Hackage necessarily checks the uploaded tarball, it is too late to
-- check these on the server; these checks only make sense in the development
-- and package-creation environment.
-- This most likely means we need to use IO, but a dictionary
-- 'CheckPreDistributionOps m' is provided in case in the future such
-- information can come from somewhere else (e.g. VCS filesystem).
--
-- Note: this really shouldn't return any 'Inexcusable' warnings,
-- because that will make us say that Hackage would reject the package.
-- But, because Hackage doesn't yet run these tests, that will be a lie!

checkGlobFile
  :: Monad m
  => CabalSpecVersion
  -> FilePath -- Glob pattern.
  -> FilePath -- Folder to check.
  -> CabalField -- .cabal field we are checking.
  -> CheckM m ()
checkGlobFile :: forall (m :: * -> *).
Monad m =>
CabalSpecVersion -> String -> String -> String -> CheckM m ()
checkGlobFile CabalSpecVersion
cv String
ddir String
title String
fp = do
  let adjDdir :: String
adjDdir = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ddir then String
"." else String
ddir
      dir :: String
dir
        | String
title String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"data-files" = String
adjDdir
        | Bool
otherwise = String
"."

  case CabalSpecVersion -> String -> Either GlobSyntaxError Glob
parseFileGlob CabalSpecVersion
cv String
fp of
    -- We just skip over parse errors here; they're reported elsewhere.
    Left GlobSyntaxError
_ -> () -> CheckM m ()
forall a. a -> CheckM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Right Glob
parsedGlob -> do
      (CheckInterface m -> Maybe (CheckPreDistributionOps m))
-> (CheckPreDistributionOps m -> m [PackageCheck]) -> CheckM m ()
forall (m :: * -> *) (i :: (* -> *) -> *).
Monad m =>
(CheckInterface m -> Maybe (i m))
-> (i m -> m [PackageCheck]) -> CheckM m ()
liftInt CheckInterface m -> Maybe (CheckPreDistributionOps m)
forall (m :: * -> *).
CheckInterface m -> Maybe (CheckPreDistributionOps m)
ciPreDistOps ((CheckPreDistributionOps m -> m [PackageCheck]) -> CheckM m ())
-> (CheckPreDistributionOps m -> m [PackageCheck]) -> CheckM m ()
forall a b. (a -> b) -> a -> b
$ \CheckPreDistributionOps m
po -> do
        rs <- CheckPreDistributionOps m
-> String -> Glob -> m [GlobResult String]
forall (m :: * -> *).
CheckPreDistributionOps m
-> String -> Glob -> m [GlobResult String]
runDirFileGlobM CheckPreDistributionOps m
po String
dir Glob
parsedGlob
        return $ checkGlobResult title fp rs

-- | Checks for matchless globs and too strict matching (<2.4 spec).
checkGlobResult
  :: CabalField -- .cabal field we are checking
  -> FilePath -- Glob pattern (to show the user
  -- which pattern is the offending
  -- one).
  -> [GlobResult FilePath] -- List of glob results.
  -> [PackageCheck]
checkGlobResult :: String -> String -> [GlobResult String] -> [PackageCheck]
checkGlobResult String
title String
fp [GlobResult String]
rs = [PackageCheck]
dirCheck [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ [Maybe PackageCheck] -> [PackageCheck]
forall a. [Maybe a] -> [a]
catMaybes ((GlobResult String -> Maybe PackageCheck)
-> [GlobResult String] -> [Maybe PackageCheck]
forall a b. (a -> b) -> [a] -> [b]
map GlobResult String -> Maybe PackageCheck
getWarning [GlobResult String]
rs)
  where
    dirCheck :: [PackageCheck]
dirCheck
      | (GlobResult String -> Bool) -> [GlobResult String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool)
-> (GlobResult String -> Bool) -> GlobResult String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobResult String -> Bool
forall {a}. GlobResult a -> Bool
withoutNoMatchesWarning) [GlobResult String]
rs =
          [CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ String -> String -> CheckExplanation
GlobNoMatch String
title String
fp]
      | Bool
otherwise = []

    -- If there's a missing directory in play, since globs in Cabal packages
    -- don't (currently) support disjunction, that will always mean there are
    -- no matches. The no matches error in this case is strictly less
    -- informative than the missing directory error.
    withoutNoMatchesWarning :: GlobResult a -> Bool
withoutNoMatchesWarning (GlobMatch a
_) = Bool
True
    withoutNoMatchesWarning (GlobWarnMultiDot a
_) = Bool
False
    withoutNoMatchesWarning (GlobMissingDirectory a
_) = Bool
True
    withoutNoMatchesWarning (GlobMatchesDirectory a
_) = Bool
True

    getWarning :: GlobResult FilePath -> Maybe PackageCheck
    getWarning :: GlobResult String -> Maybe PackageCheck
getWarning (GlobMatch String
_) = Maybe PackageCheck
forall a. Maybe a
Nothing
    -- Before Cabal 2.4, the extensions of globs had to match the file
    -- exactly. This has been relaxed in 2.4 to allow matching only the
    -- suffix. This warning detects when pre-2.4 package descriptions
    -- are omitting files purely because of the stricter check.
    getWarning (GlobWarnMultiDot String
file) =
      PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
Just (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$ CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn (String -> String -> String -> CheckExplanation
GlobExactMatch String
title String
fp String
file)
    getWarning (GlobMissingDirectory String
dir) =
      PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
Just (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$ CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn (String -> String -> String -> CheckExplanation
GlobNoDir String
title String
fp String
dir)
    -- GlobMatchesDirectory is handled elsewhere if relevant;
    -- we can discard it here.
    getWarning (GlobMatchesDirectory String
_) = Maybe PackageCheck
forall a. Maybe a
Nothing

-- ------------------------------------------------------------
-- Other exports
-- ------------------------------------------------------------

-- | Wraps `ParseWarning` into `PackageCheck`.
wrapParseWarning :: FilePath -> PWarning -> PackageCheck
wrapParseWarning :: String -> PWarning -> PackageCheck
wrapParseWarning String
fp PWarning
pw = CheckExplanation -> PackageCheck
PackageDistSuspicious (String -> PWarning -> CheckExplanation
ParseWarning String
fp PWarning
pw)

-- TODO: as Jul 2022 there is no severity indication attached PWarnType.
--       Once that is added, we can output something more appropriate
--       than PackageDistSuspicious for every parse warning.
--       (see: Cabal-syntax/src/Distribution/Parsec/Warning.hs)

-- ------------------------------------------------------------
-- Ancillaries
-- ------------------------------------------------------------

-- Gets a list of dependencies from a Library target to pass to PVP related
-- functions. We are not doing checks here: this is not imprecise, as the
-- library itself *will* be checked for PVP errors.
-- Same for branch merging,
-- each of those branch will be checked one by one.
extractAssocDeps
  :: UnqualComponentName -- Name of the target library
  -> CondTree ConfVar [Dependency] Library
  -> AssocDep
extractAssocDeps :: UnqualComponentName
-> CondTree ConfVar [Dependency] Library -> AssocDep
extractAssocDeps UnqualComponentName
n CondTree ConfVar [Dependency] Library
ct =
  let a :: (Library, [Dependency])
a = CondTree ConfVar [Dependency] Library -> (Library, [Dependency])
forall a c v.
(Semigroup a, Semigroup c) =>
CondTree v c a -> (a, c)
ignoreConditions CondTree ConfVar [Dependency] Library
ct
   in -- Merging is fine here, remember the specific
      -- library dependencies will be checked branch
      -- by branch.
      (UnqualComponentName
n, (Library, [Dependency]) -> [Dependency]
forall a b. (a, b) -> b
snd (Library, [Dependency])
a)

-- | August 2022: this function is an oddity due to the historical
-- GenericPackageDescription/PackageDescription split (check
-- Distribution.Types.PackageDescription for a description of the relationship
-- between GPD and PD.
-- It is only maintained not to break interface, should be deprecated in the
-- future in favour of `checkPackage` when PD and GPD are refactored sensibly.
pd2gpd :: PackageDescription -> GenericPackageDescription
pd2gpd :: PackageDescription -> GenericPackageDescription
pd2gpd PackageDescription
pd = GenericPackageDescription
gpd
  where
    gpd :: GenericPackageDescription
    gpd :: GenericPackageDescription
gpd =
      GenericPackageDescription
emptyGenericPackageDescription
        { packageDescription = pd
        , condLibrary = fmap t2c (library pd)
        , condSubLibraries = map (t2cName ln id) (subLibraries pd)
        , condForeignLibs =
            map
              (t2cName foreignLibName id)
              (foreignLibs pd)
        , condExecutables =
            map
              (t2cName exeName id)
              (executables pd)
        , condTestSuites =
            map
              (t2cName testName remTest)
              (testSuites pd)
        , condBenchmarks =
            map
              (t2cName benchmarkName remBench)
              (benchmarks pd)
        }

    -- From target to simple, unconditional CondTree.
    t2c :: a -> CondTree ConfVar [Dependency] a
    t2c :: forall a. a -> CondTree ConfVar [Dependency] a
t2c a
a = a
-> [Dependency]
-> [CondBranch ConfVar [Dependency] a]
-> CondTree ConfVar [Dependency] a
forall v c a. a -> c -> [CondBranch v c a] -> CondTree v c a
CondNode a
a [] []

    -- From named target to unconditional CondTree. Notice we have
    -- a function to extract the name *and* a function to modify
    -- the target. This is needed for 'initTargetAnnotation' to work
    -- properly and to contain all the quirks inside 'pd2gpd'.
    t2cName
      :: (a -> UnqualComponentName)
      -> (a -> a)
      -> a
      -> (UnqualComponentName, CondTree ConfVar [Dependency] a)
    t2cName :: forall a.
(a -> UnqualComponentName)
-> (a -> a)
-> a
-> (UnqualComponentName, CondTree ConfVar [Dependency] a)
t2cName a -> UnqualComponentName
nf a -> a
mf a
a = (a -> UnqualComponentName
nf a
a, a -> CondTree ConfVar [Dependency] a
forall a. a -> CondTree ConfVar [Dependency] a
t2c (a -> CondTree ConfVar [Dependency] a)
-> (a -> a) -> a -> CondTree ConfVar [Dependency] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
mf (a -> CondTree ConfVar [Dependency] a)
-> a -> CondTree ConfVar [Dependency] a
forall a b. (a -> b) -> a -> b
$ a
a)

    ln :: Library -> UnqualComponentName
    ln :: Library -> UnqualComponentName
ln Library
wl = case Library -> LibraryName
libName Library
wl of
      (LSubLibName UnqualComponentName
u) -> UnqualComponentName
u
      LibraryName
LMainLibName -> String -> UnqualComponentName
mkUnqualComponentName String
"main-library"

    remTest :: TestSuite -> TestSuite
    remTest :: TestSuite -> TestSuite
remTest TestSuite
t = TestSuite
t{testName = mempty}

    remBench :: Benchmark -> Benchmark
    remBench :: Benchmark -> Benchmark
remBench Benchmark
b = Benchmark
b{benchmarkName = mempty}

-- checkMissingDocs will check that we don’t have an interesting file
-- (changes.txt, Changelog.md, NEWS, etc.) in our work-tree which is not
-- present in our .cabal file.
checkMissingDocs
  :: Monad m
  => [Glob] -- data-files globs.
  -> [Glob] -- extra-source-files globs.
  -> [Glob] -- extra-doc-files globs.
  -> CheckM m ()
checkMissingDocs :: forall (m :: * -> *).
Monad m =>
[Glob] -> [Glob] -> [Glob] -> CheckM m ()
checkMissingDocs [Glob]
dgs [Glob]
esgs [Glob]
edgs = do
  extraDocSupport <- (CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV1_18) (CabalSpecVersion -> Bool)
-> CheckM m CabalSpecVersion -> CheckM m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CheckCtx m -> CabalSpecVersion) -> CheckM m CabalSpecVersion
forall (m :: * -> *) a. Monad m => (CheckCtx m -> a) -> CheckM m a
asksCM CheckCtx m -> CabalSpecVersion
forall (m :: * -> *). CheckCtx m -> CabalSpecVersion
ccSpecVersion

  -- Everything in this block uses CheckPreDistributionOps interface.
  liftInt
    ciPreDistOps
    ( \CheckPreDistributionOps m
ops -> do
        -- 1. Get root files, see if they are interesting to us.
        rootContents <- CheckPreDistributionOps m -> String -> m [String]
forall (m :: * -> *).
CheckPreDistributionOps m -> String -> m [String]
getDirectoryContentsM CheckPreDistributionOps m
ops String
"."
        -- Recall getDirectoryContentsM arg is relative to root path.
        let des = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isDesirableExtraDocFile [String]
rootContents

        -- 2. Realise Globs.
        let realGlob t Glob
t =
              ([GlobResult String] -> [String])
-> t [GlobResult String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [GlobResult String] -> [String]
forall a. [GlobResult a] -> [a]
globMatches
                (t [GlobResult String] -> [String])
-> m (t [GlobResult String]) -> m [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Glob -> m [GlobResult String])
-> t Glob -> m (t [GlobResult String])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
mapM (CheckPreDistributionOps m
-> String -> Glob -> m [GlobResult String]
forall (m :: * -> *).
CheckPreDistributionOps m
-> String -> Glob -> m [GlobResult String]
runDirFileGlobM CheckPreDistributionOps m
ops String
"") t Glob
t
        rgs <- realGlob dgs
        res <- realGlob esgs
        red <- realGlob edgs

        -- 3. Check if anything in 1. is missing in 2.
        let mcs = Bool -> [String] -> [String] -> [PackageCheck]
checkDoc Bool
extraDocSupport [String]
des ([String]
rgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
res [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
red)

        -- 4. Check if files are present but in the wrong field.
        let pcsData = Bool -> String -> [String] -> [String] -> [PackageCheck]
checkDocMove Bool
extraDocSupport String
"data-files" [String]
des [String]
rgs
            pcsSource =
              if Bool
extraDocSupport
                then
                  Bool -> String -> [String] -> [String] -> [PackageCheck]
checkDocMove
                    Bool
extraDocSupport
                    String
"extra-source-files"
                    [String]
des
                    [String]
res
                else []
            pcs = [PackageCheck]
pcsData [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ [PackageCheck]
pcsSource

        return (mcs ++ pcs)
    )
  where
    checkDoc
      :: Bool -- Cabal spec ≥ 1.18?
      -> [FilePath] -- Desirables.
      -> [FilePath] -- Actuals.
      -> [PackageCheck]
    checkDoc :: Bool -> [String] -> [String] -> [PackageCheck]
checkDoc Bool
b [String]
ds [String]
as =
      let fds :: [String]
fds = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"." String -> String -> String
</>) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> [String] -> Bool) -> [String] -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem [String]
as) [String]
ds
       in if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
fds
            then []
            else
              [ CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$
                  Bool -> [String] -> CheckExplanation
MissingExpectedDocFiles Bool
b [String]
fds
              ]

    checkDocMove
      :: Bool -- Cabal spec ≥ 1.18?
      -> CabalField -- Name of the field.
      -> [FilePath] -- Desirables.
      -> [FilePath] -- Actuals.
      -> [PackageCheck]
    checkDocMove :: Bool -> String -> [String] -> [String] -> [PackageCheck]
checkDocMove Bool
b String
field [String]
ds [String]
as =
      let fds :: [String]
fds = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> [String] -> Bool) -> [String] -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [String]
as) [String]
ds
       in if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
fds
            then []
            else
              [ CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$
                  Bool -> String -> [String] -> CheckExplanation
WrongFieldForExpectedDocFiles Bool
b String
field [String]
fds
              ]

-- Predicate for desirable documentation file on Hackage server.
isDesirableExtraDocFile :: FilePath -> Bool
isDesirableExtraDocFile :: String -> Bool
isDesirableExtraDocFile String
path =
  String
basename String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
desirableChangeLog
    Bool -> Bool -> Bool
&& String
ext String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
desirableChangeLogExtensions
  where
    (String
basename, String
ext) = String -> (String, String)
splitExtension ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
path)

    -- Changelog patterns (basenames & extensions)
    -- Source: hackage-server/src/Distribution/Server/Packages/ChangeLog.hs
    desirableChangeLog :: [String]
desirableChangeLog = [String
"news", String
"changelog", String
"change_log", String
"changes"]
    desirableChangeLogExtensions :: [String]
desirableChangeLogExtensions = [String
"", String
".txt", String
".md", String
".markdown", String
".rst"]

-- [TODO] Check readme. Observations:
--        • Readme is not necessary if package description is good.
--        • Some readmes exists only for repository browsing.
--        • There is currently no reliable way to check what a good
--          description is; there will be complains if the criterion
--          is based on the length or number of words (can of worms).
-- -- Readme patterns
-- -- Source: hackage-server/src/Distribution/Server/Packages/Readme.hs
-- desirableReadme = ["readme"]

-- Remove duplicates from list.
dups :: Ord a => [a] -> [a]
dups :: forall a. Ord a => [a] -> [a]
dups [a]
xs = [a
x | (a
x : a
_ : [a]
_) <- [a] -> [[a]]
forall a. Eq a => [a] -> [[a]]
group ([a] -> [a]
forall a. Ord a => [a] -> [a]
sort [a]
xs)]