{-# LANGUAGE DataKinds #-}
{-# 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
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 -> [Char] -> IO [PackageCheck]
checkPackageFilesGPD Verbosity
verbosity GenericPackageDescription
gpd [Char]
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 :: [Char] -> IO Bool
doesFileExist = [Char] -> IO Bool
System.doesFileExist ([Char] -> IO Bool) -> ([Char] -> [Char]) -> [Char] -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
relative
        , doesDirectoryExist :: [Char] -> IO Bool
doesDirectoryExist = [Char] -> IO Bool
System.doesDirectoryExist ([Char] -> IO Bool) -> ([Char] -> [Char]) -> [Char] -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
relative
        , getDirectoryContents :: [Char] -> IO [[Char]]
getDirectoryContents = [Char] -> IO [[Char]]
System.Directory.getDirectoryContents ([Char] -> IO [[Char]])
-> ([Char] -> [Char]) -> [Char] -> IO [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
relative
        , getFileContents :: [Char] -> IO ByteString
getFileContents = [Char] -> IO ByteString
BS.readFile ([Char] -> IO ByteString)
-> ([Char] -> [Char]) -> [Char] -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
relative
        }

    checkPreIO :: CheckPreDistributionOps IO
checkPreIO =
      CheckPreDistributionOps
        { runDirFileGlobM :: [Char] -> Glob -> IO [GlobResult [Char]]
runDirFileGlobM = \[Char]
fp Glob
g -> Verbosity
-> Maybe CabalSpecVersion
-> [Char]
-> Glob
-> IO [GlobResult [Char]]
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) ([Char]
root [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
fp) Glob
g
        , getDirectoryContentsM :: [Char] -> IO [[Char]]
getDirectoryContentsM = [Char] -> IO [[Char]]
System.Directory.getDirectoryContents ([Char] -> IO [[Char]])
-> ([Char] -> [Char]) -> [Char] -> IO [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
relative
        }

    relative :: FilePath -> FilePath
    relative :: [Char] -> [Char]
relative [Char]
path = [Char]
root [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
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 -> [Char] -> IO [PackageCheck]
checkPackageFiles Verbosity
verbosity PackageDescription
pd [Char]
oot =
  Verbosity
-> GenericPackageDescription -> [Char] -> IO [PackageCheck]
checkPackageFilesGPD Verbosity
verbosity (PackageDescription -> GenericPackageDescription
pd2gpd PackageDescription
pd) [Char]
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)
      -- 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 =
            [(UnqualComponentName, [Dependency])]
-> (CondTree ConfVar [Dependency] Library
    -> [(UnqualComponentName, [Dependency])])
-> Maybe (CondTree ConfVar [Dependency] Library)
-> [(UnqualComponentName, [Dependency])]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (((UnqualComponentName, [Dependency])
-> [(UnqualComponentName, [Dependency])]
-> [(UnqualComponentName, [Dependency])]
forall a. a -> [a] -> [a]
: []) ((UnqualComponentName, [Dependency])
 -> [(UnqualComponentName, [Dependency])])
-> (CondTree ConfVar [Dependency] Library
    -> (UnqualComponentName, [Dependency]))
-> CondTree ConfVar [Dependency] Library
-> [(UnqualComponentName, [Dependency])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName
-> CondTree ConfVar [Dependency] Library
-> (UnqualComponentName, [Dependency])
extractAssocDeps UnqualComponentName
pName) Maybe (CondTree ConfVar [Dependency] Library)
condLibrary_
              [(UnqualComponentName, [Dependency])]
-> [(UnqualComponentName, [Dependency])]
-> [(UnqualComponentName, [Dependency])]
forall a. [a] -> [a] -> [a]
++ ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
 -> (UnqualComponentName, [Dependency]))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [(UnqualComponentName, [Dependency])]
forall a b. (a -> b) -> [a] -> [b]
map ((UnqualComponentName
 -> CondTree ConfVar [Dependency] Library
 -> (UnqualComponentName, [Dependency]))
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> (UnqualComponentName, [Dependency])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry UnqualComponentName
-> CondTree ConfVar [Dependency] Library
-> (UnqualComponentName, [Dependency])
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
-> [(UnqualComponentName, [Dependency])] -> Library -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool
-> [(UnqualComponentName, [Dependency])] -> Library -> CheckM m ()
checkLibrary Bool
False [(UnqualComponentName, [Dependency])]
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 :: [Char]
fn = FlagName -> [Char]
unFlagName (FlagName -> [Char])
-> (PackageFlag -> FlagName) -> PackageFlag -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageFlag -> FlagName
flagName (PackageFlag -> [Char]) -> PackageFlag -> [Char]
forall a b. (a -> b) -> a -> b
$ PackageFlag
pf

            invalidFlagName :: [Char] -> Bool
invalidFlagName (Char
'-' : [Char]
_) = Bool
True -- starts with dash
            invalidFlagName [Char]
cs = (Char -> Bool) -> [Char] -> 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) [Char]
cs -- non ASCII
         in Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
              ([Char] -> Bool
invalidFlagName [Char]
fn)
              (CheckExplanation -> PackageCheck
PackageDistInexcusable (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ [[Char]] -> CheckExplanation
SuspiciousFlagName [[Char]
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_
          [RelativePath Pkg 'File]
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_
          [([Char], [Char])]
customFieldsPD_
          Maybe BuildType
buildTypeRaw_
          Maybe SetupBuildInfo
setupBuildInfo_
          Maybe Library
_library_
          [Library]
_subLibraries_
          [Executable]
_executables_
          [ForeignLib]
_foreignLibs_
          [TestSuite]
_testSuites_
          [Benchmark]
_benchmarks_
          [RelativePath DataDir 'File]
dataFiles_
          SymbolicPath Pkg ('Dir DataDir)
dataDir_
          [RelativePath Pkg 'File]
extraSrcFiles_
          [RelativePath Pkg 'File]
extraTmpFiles_
          [RelativePath Pkg 'File]
extraDocFiles_
          [RelativePath Pkg 'File]
extraFiles_
        ) = 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
      ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Char] -> Bool) -> (PackageName -> [Char]) -> PackageName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> [Char]
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 . getSymbolicPath) extraSrcFiles_
    mapM_ (checkPath False "extra-tmp-files" PathKindFile . getSymbolicPath) extraTmpFiles_
    mapM_ (checkPath False "extra-doc-files" PathKindGlob . getSymbolicPath) extraDocFiles_
    mapM_ (checkPath False "extra-files" PathKindGlob . getSymbolicPath) extraFiles_
    mapM_ (checkPath False "data-files" PathKindGlob . getSymbolicPath) dataFiles_
    let rawDataDir = SymbolicPath Pkg ('Dir DataDir) -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath SymbolicPath Pkg ('Dir DataDir)
dataDir_
    checkPath True "data-dir" PathKindDirectory rawDataDir
    let licPaths = (RelativePath Pkg 'File -> [Char])
-> [RelativePath Pkg 'File] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map RelativePath Pkg 'File -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath [RelativePath Pkg 'File]
licenseFiles_
    mapM_ (checkPath False "license-file" PathKindFile) licPaths
    mapM_ checkLicFileExist licenseFiles_

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

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

    -- § 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 `notElem` [Custom, Hooks])
      (PackageBuildWarning NoCustomSetup)

    -- Contents.
    checkConfigureExists (buildType pkg)
    checkSetupExists (buildType pkg)
    checkCabalFile (packageName pkg)
    mapM_ (checkGlobFile specVersion_ "." "extra-source-files" . getSymbolicPath) extraSrcFiles_
    mapM_ (checkGlobFile specVersion_ "." "extra-doc-files" . getSymbolicPath) extraDocFiles_
    mapM_ (checkGlobFile specVersion_ "." "extra-files" . getSymbolicPath) extraFiles_
    mapM_ (checkGlobFile specVersion_ rawDataDir "data-files" . getSymbolicPath) 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 [Char]
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
$ [[Char]] -> CheckExplanation
UnknownCompilers [[Char]
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
                      ([Char] -> PackageName
mkPackageName (CompilerFlavor -> [Char]
forall a. Pretty a => a -> [Char]
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 = ([Char] -> UnqualComponentName)
-> [[Char]] -> [UnqualComponentName]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> UnqualComponentName
mkUnqualComponentName [[Char]
"base", [Char]
"Cabal"]
  (is, rs) <- [(UnqualComponentName, [Dependency])]
-> [UnqualComponentName]
-> [Dependency]
-> CheckM m ([Dependency], [Dependency])
forall (m :: * -> *).
Monad m =>
[(UnqualComponentName, [Dependency])]
-> [UnqualComponentName]
-> [Dependency]
-> CheckM m ([Dependency], [Dependency])
partitionDeps [] [UnqualComponentName]
uqs [Dependency]
ds
  let ick = CheckExplanation -> PackageCheck
PackageDistInexcusable (CheckExplanation -> PackageCheck)
-> ([Char] -> CheckExplanation) -> [Char] -> PackageCheck
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> CheckExplanation
UpperBoundSetup
      rck =
        CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn
          (CheckExplanation -> PackageCheck)
-> ([[Char]] -> CheckExplanation) -> [[Char]] -> PackageCheck
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CEType -> [[Char]] -> CheckExplanation
MissingUpperBounds CEType
CETSetup
      leuck =
        CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn
          (CheckExplanation -> PackageCheck)
-> ([[Char]] -> CheckExplanation) -> [[Char]] -> PackageCheck
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CEType -> [[Char]] -> CheckExplanation
LEUpperBounds CEType
CETSetup
      tzuck =
        CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn
          (CheckExplanation -> PackageCheck)
-> ([[Char]] -> CheckExplanation) -> [[Char]] -> PackageCheck
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CEType -> [[Char]] -> CheckExplanation
TrailingZeroUpperBounds CEType
CETSetup
      gtlck =
        CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn
          (CheckExplanation -> PackageCheck)
-> ([[Char]] -> CheckExplanation) -> [[Char]] -> PackageCheck
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CEType -> [[Char]] -> CheckExplanation
GTLowerBounds CEType
CETSetup
  checkPVP (checkDependencyVersionRange $ not . hasUpperBound) ick is
  checkPVPs (checkDependencyVersionRange $ not . hasUpperBound) rck rs
  checkPVPs (checkDependencyVersionRange hasLEUpperBound) leuck ds
  checkPVPs (checkDependencyVersionRange hasTrailingZeroUpperBound) tzuck ds
  checkPVPs (checkDependencyVersionRange hasGTLowerBound) gtlck ds

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
. [Char] -> Bool
FilePath.Windows.isValid ([Char] -> Bool) -> (PackageName -> [Char]) -> PackageName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> [Char]
forall a. Pretty a => a -> [Char]
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 ([Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
"z-" ([Char] -> Bool) -> (PackageName -> [Char]) -> PackageName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> [Char]
forall a. Pretty a => a -> [Char]
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 [Char]
l ->
      PackageCheck -> CheckM m ()
forall (m :: * -> *). Monad m => PackageCheck -> CheckM m ()
tellP (CheckExplanation -> PackageCheck
PackageBuildWarning ([Char] -> CheckExplanation
UnrecognisedLicense [Char]
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 [Char]
repoLocation_
          Maybe [Char]
repoModule_
          Maybe [Char]
_repoBranch_
          Maybe [Char]
repoTag_
          Maybe [Char]
repoSubdir_
        ) = do
        case RepoKind
repoKind_ of
          RepoKindUnknown [Char]
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
$ [Char] -> CheckExplanation
UnrecognisedSourceRepo [Char]
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 [Char] -> Bool
forall a. Maybe a -> Bool
isNothing Maybe [Char]
repoLocation_)
          (CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
MissingLocation)
        Maybe [Char] -> CheckM m ()
forall (m :: * -> *). Monad m => Maybe [Char] -> CheckM m ()
checkGitProtocol Maybe [Char]
repoLocation_
        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 [Char] -> Bool
forall a. Maybe a -> Bool
isNothing Maybe [Char]
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 [Char] -> Bool
forall a. Maybe a -> Bool
isNothing Maybe [Char]
repoTag_)
          (CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
MissingTag)
        Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
          (([Char] -> Bool) -> Maybe [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [Char] -> Bool
isAbsoluteOnAnyPlatform Maybe [Char]
repoSubdir_)
          (CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
SubdirRelPath)
        case Maybe (Maybe [Char]) -> Maybe [Char]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe [Char]) -> Maybe [Char])
-> (Maybe [Char] -> Maybe (Maybe [Char]))
-> Maybe [Char]
-> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Maybe [Char]) -> Maybe [Char] -> Maybe (Maybe [Char])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Maybe [Char]
isGoodRelativeDirectoryPath (Maybe [Char] -> Maybe [Char]) -> Maybe [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Maybe [Char]
repoSubdir_ of
          Just [Char]
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
$ [Char] -> CheckExplanation
SubdirGoodRelPath [Char]
err)
          Maybe [Char]
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 :: [[Char]]
rdirs = (KnownRepoType -> [[Char]]) -> [KnownRepoType] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap KnownRepoType -> [[Char]]
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
<$> ([Char] -> m Bool) -> [[Char]] -> 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 -> [Char] -> m Bool
forall (m :: * -> *). CheckPackageContentOps m -> [Char] -> m Bool
doesDirectoryExist CheckPackageContentOps m
ops) [[Char]]
rdirs
            return (null rs && us)
        )
        (CheckExplanation -> PackageCheck
PackageDistSuspicious CheckExplanation
MissingSourceControl)
  where
    repoTypeDirname :: KnownRepoType -> [FilePath]
    repoTypeDirname :: KnownRepoType -> [[Char]]
repoTypeDirname KnownRepoType
Darcs = [[Char]
"_darcs"]
    repoTypeDirname KnownRepoType
Git = [[Char]
".git"]
    repoTypeDirname KnownRepoType
SVN = [[Char]
".svn"]
    repoTypeDirname KnownRepoType
CVS = [[Char]
"CVS"]
    repoTypeDirname KnownRepoType
Mercurial = [[Char]
".hg"]
    repoTypeDirname KnownRepoType
GnuArch = [[Char]
".arch-params"]
    repoTypeDirname KnownRepoType
Bazaar = [[Char]
".bzr"]
    repoTypeDirname KnownRepoType
Monotone = [[Char]
"_MTN"]
    repoTypeDirname KnownRepoType
Pijul = [[Char]
".pijul"]

-- git:// lacks TLS or other encryption, see
-- https://git-scm.com/book/en/v2/Git-on-the-Server-The-Protocols#_the_cons_4
checkGitProtocol
  :: Monad m
  => Maybe String -- Repository location
  -> CheckM m ()
checkGitProtocol :: forall (m :: * -> *). Monad m => Maybe [Char] -> CheckM m ()
checkGitProtocol Maybe [Char]
mloc =
  Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
    (([Char] -> Bool) -> Maybe [Char] -> Maybe Bool
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
"git://") Maybe [Char]
mloc Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)
    (CheckExplanation -> PackageCheck
PackageBuildWarning CheckExplanation
GitProtocol)

-- ------------------------------------------------------------
-- 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 [[Char]]
findPackageDesc CheckPackageContentOps m
ops = do
  let dir :: [Char]
dir = [Char]
"."
  files <- CheckPackageContentOps m -> [Char] -> m [[Char]]
forall (m :: * -> *).
CheckPackageContentOps m -> [Char] -> m [[Char]]
getDirectoryContents CheckPackageContentOps m
ops [Char]
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 [[Char]]
forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m -> m [[Char]]
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.
          [[Char]
d] -> do
            bc <- CheckPackageContentOps m -> [Char] -> m (Maybe PackageCheck)
forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m -> [Char] -> m (Maybe PackageCheck)
bomf CheckPackageContentOps m
ops [Char]
d
            return (catMaybes [bc, noMatch d])
          -- BOM + no matching .cabal checks.
          [[Char]]
_ -> [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
$ [[Char]] -> CheckExplanation
MultiDesc [[Char]]
ds]
    )
  where
    -- Multiple .cabal files.

    bomf
      :: Monad m
      => CheckPackageContentOps m
      -> FilePath
      -> m (Maybe PackageCheck)
    bomf :: forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m -> [Char] -> m (Maybe PackageCheck)
bomf CheckPackageContentOps m
wops [Char]
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 -> [Char] -> m ByteString
forall (m :: * -> *).
CheckPackageContentOps m -> [Char] -> m ByteString
getFileContents CheckPackageContentOps m
wops [Char]
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 :: [Char] -> Maybe PackageCheck
noMatch [Char]
wd =
      let expd :: [Char]
expd = PackageName -> [Char]
unPackageName PackageName
pn [Char] -> [Char] -> [Char]
forall p. FileLike p => p -> [Char] -> p
<.> [Char]
"cabal"
       in if [Char] -> [Char]
takeFileName [Char]
wd [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
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
$ [Char] -> [Char] -> CheckExplanation
NotPackageName [Char]
wd [Char]
expd)
            else Maybe PackageCheck
forall a. Maybe a
Nothing

checkLicFileExist
  :: Monad m
  => RelativePath Pkg File
  -> CheckM m ()
checkLicFileExist :: forall (m :: * -> *).
Monad m =>
RelativePath Pkg 'File -> CheckM m ()
checkLicFileExist RelativePath Pkg 'File
sp = do
  let fp :: [Char]
fp = RelativePath Pkg 'File -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath RelativePath Pkg 'File
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 -> [Char] -> m Bool
forall (m :: * -> *). CheckPackageContentOps m -> [Char] -> m Bool
doesFileExist CheckPackageContentOps m
ops [Char]
fp)
    (CheckExplanation -> PackageCheck
PackageBuildWarning (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ [Char] -> RelativePath Pkg 'File -> CheckExplanation
UnknownFile [Char]
"license-file" RelativePath Pkg 'File
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 -> [Char] -> m Bool
forall (m :: * -> *). CheckPackageContentOps m -> [Char] -> m Bool
doesFileExist CheckPackageContentOps m
ops [Char]
"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 -> [Char] -> m Bool
forall (m :: * -> *). CheckPackageContentOps m -> [Char] -> m Bool
doesFileExist CheckPackageContentOps m
ops [Char]
"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 -> [Char] -> [Char] -> [Char] -> CheckM m ()
checkGlobFile CabalSpecVersion
cv [Char]
ddir [Char]
title [Char]
fp = do
  let adjDdir :: [Char]
adjDdir = if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ddir then [Char]
"." else [Char]
ddir
      dir :: [Char]
dir
        | [Char]
title [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"data-files" = [Char]
adjDdir
        | Bool
otherwise = [Char]
"."

  case CabalSpecVersion -> [Char] -> Either GlobSyntaxError Glob
parseFileGlob CabalSpecVersion
cv [Char]
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
-> [Char] -> Glob -> m [GlobResult [Char]]
forall (m :: * -> *).
CheckPreDistributionOps m
-> [Char] -> Glob -> m [GlobResult [Char]]
runDirFileGlobM CheckPreDistributionOps m
po [Char]
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 :: [Char] -> [Char] -> [GlobResult [Char]] -> [PackageCheck]
checkGlobResult [Char]
title [Char]
fp [GlobResult [Char]]
rs = [PackageCheck]
dirCheck [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ [Maybe PackageCheck] -> [PackageCheck]
forall a. [Maybe a] -> [a]
catMaybes ((GlobResult [Char] -> Maybe PackageCheck)
-> [GlobResult [Char]] -> [Maybe PackageCheck]
forall a b. (a -> b) -> [a] -> [b]
map GlobResult [Char] -> Maybe PackageCheck
getWarning [GlobResult [Char]]
rs)
  where
    dirCheck :: [PackageCheck]
dirCheck
      | (GlobResult [Char] -> Bool) -> [GlobResult [Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool)
-> (GlobResult [Char] -> Bool) -> GlobResult [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobResult [Char] -> Bool
forall {a}. GlobResult a -> Bool
withoutNoMatchesWarning) [GlobResult [Char]]
rs =
          [CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> CheckExplanation
GlobNoMatch [Char]
title [Char]
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 [Char] -> Maybe PackageCheck
getWarning (GlobMatch [Char]
_) = 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 [Char]
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 ([Char] -> [Char] -> [Char] -> CheckExplanation
GlobExactMatch [Char]
title [Char]
fp [Char]
file)
    getWarning (GlobMissingDirectory [Char]
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 ([Char] -> [Char] -> [Char] -> CheckExplanation
GlobNoDir [Char]
title [Char]
fp [Char]
dir)
    -- GlobMatchesDirectory is handled elsewhere if relevant;
    -- we can discard it here.
    getWarning (GlobMatchesDirectory [Char]
_) = Maybe PackageCheck
forall a. Maybe a
Nothing

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

-- | Wraps `ParseWarning` into `PackageCheck`.
wrapParseWarning :: FilePath -> PWarning -> PackageCheck
wrapParseWarning :: [Char] -> PWarning -> PackageCheck
wrapParseWarning [Char]
fp PWarning
pw = CheckExplanation -> PackageCheck
PackageDistSuspicious ([Char] -> PWarning -> CheckExplanation
ParseWarning [Char]
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
-> (UnqualComponentName, [Dependency])
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 -> [Char] -> UnqualComponentName
mkUnqualComponentName [Char]
"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.
  -> [Glob] -- extra-files globs.
  -> CheckM m ()
checkMissingDocs :: forall (m :: * -> *).
Monad m =>
[Glob] -> [Glob] -> [Glob] -> [Glob] -> CheckM m ()
checkMissingDocs [Glob]
dgs [Glob]
esgs [Glob]
edgs [Glob]
efgs = 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 -> [Char] -> m [[Char]]
forall (m :: * -> *).
CheckPreDistributionOps m -> [Char] -> m [[Char]]
getDirectoryContentsM CheckPreDistributionOps m
ops [Char]
"."
        -- Recall getDirectoryContentsM arg is relative to root path.
        let des = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
isDesirableExtraDocFile [[Char]]
rootContents

        -- 2. Realise Globs.
        let realGlob t Glob
t =
              ([GlobResult [Char]] -> [[Char]])
-> t [GlobResult [Char]] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [GlobResult [Char]] -> [[Char]]
forall a. [GlobResult a] -> [a]
globMatches
                (t [GlobResult [Char]] -> [[Char]])
-> m (t [GlobResult [Char]]) -> m [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Glob -> m [GlobResult [Char]])
-> t Glob -> m (t [GlobResult [Char]])
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
-> [Char] -> Glob -> m [GlobResult [Char]]
forall (m :: * -> *).
CheckPreDistributionOps m
-> [Char] -> Glob -> m [GlobResult [Char]]
runDirFileGlobM CheckPreDistributionOps m
ops [Char]
"") t Glob
t
        rgs <- realGlob dgs
        res <- realGlob esgs
        red <- realGlob edgs
        ref <- realGlob efgs

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

        -- 4. Check if files are present but in the wrong field.
        let pcsData = Bool -> [Char] -> [[Char]] -> [[Char]] -> [PackageCheck]
checkDocMove Bool
extraDocSupport [Char]
"data-files" [[Char]]
des [[Char]]
rgs
            pcsSource =
              if Bool
extraDocSupport
                then
                  Bool -> [Char] -> [[Char]] -> [[Char]] -> [PackageCheck]
checkDocMove
                    Bool
extraDocSupport
                    [Char]
"extra-source-files"
                    [[Char]]
des
                    [[Char]]
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 -> [[Char]] -> [[Char]] -> [PackageCheck]
checkDoc Bool
b [[Char]]
ds [[Char]]
as =
      let fds :: [[Char]]
fds = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"." [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</>) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char] -> [[Char]] -> Bool) -> [[Char]] -> [Char] -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem [[Char]]
as) [[Char]]
ds
       in if [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
fds
            then []
            else
              [ CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$
                  Bool -> [[Char]] -> CheckExplanation
MissingExpectedDocFiles Bool
b [[Char]]
fds
              ]

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

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

    -- Changelog patterns (basenames & extensions)
    -- Source: hackage-server/src/Distribution/Server/Packages/ChangeLog.hs
    desirableChangeLog :: [[Char]]
desirableChangeLog = [[Char]
"news", [Char]
"changelog", [Char]
"change_log", [Char]
"changes"]
    desirableChangeLogExtensions :: [[Char]]
desirableChangeLogExtensions = [[Char]
"", [Char]
".txt", [Char]
".md", [Char]
".markdown", [Char]
".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)]