-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.PackageDescription.Check
-- Copyright   :  Lennart Kolmodin 2008
-- 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
        PackageCheck(..),
        checkPackage,
        checkConfiguredPackage,

        -- ** Checking package contents
        checkPackageFiles,
        checkPackageContent,
        CheckPackageContentOps(..),
        checkPackageFileNames,
  ) 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.Configuration
import Distribution.Pretty                           (prettyShow)
import Distribution.Simple.BuildPaths                (autogenPathsModuleName)
import Distribution.Simple.BuildToolDepends
import Distribution.Simple.CCompiler
import Distribution.Simple.Glob
import Distribution.Simple.Utils                     hiding (findPackageDesc, notice)
import Distribution.System
import Distribution.Types.ComponentRequestedSpec
import Distribution.Utils.Generic                    (isAscii)
import Distribution.Verbosity
import Distribution.Version
import Distribution.Utils.Path
import Language.Haskell.Extension
import System.FilePath
       (splitDirectories, splitExtension, splitPath, takeExtension, takeFileName, (<.>), (</>))

import qualified Data.ByteString.Lazy      as BS
import qualified Data.Map                  as Map
import qualified Distribution.Compat.DList as DList
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.BuildInfo.Lens                 as L
import qualified Distribution.Types.GenericPackageDescription.Lens as L
import qualified Distribution.Types.PackageDescription.Lens        as L

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

-- | Results of some kind of failed package check.
--
-- There are a range of severities, from merely dubious to totally insane.
-- All of them come with a human readable explanation. In future we may augment
-- them with more machine readable explanations, for example to help an IDE
-- suggest automatic corrections.
--
data PackageCheck =

       -- | This package description is no good. There's no way it's going to
       -- build sensibly. This should give an error at configure time.
       PackageBuildImpossible { PackageCheck -> String
explanation :: String }

       -- | A problem that is likely to affect building the package, or an
       -- issue that we'd like every package author to be aware of, even if
       -- the package is never distributed.
     | PackageBuildWarning { explanation :: String }

       -- | An issue that might not be a problem for the package author but
       -- might be annoying or detrimental when the package is distributed to
       -- users. We should encourage distributed packages to be free from these
       -- issues, but occasionally there are justifiable reasons so we cannot
       -- ban them entirely.
     | PackageDistSuspicious { explanation :: String }

       -- | Like PackageDistSuspicious but will only display warnings
       -- rather than causing abnormal exit when you run 'cabal check'.
     | PackageDistSuspiciousWarn { explanation :: String }

       -- | An issue that is OK in the author's environment but is almost
       -- certain to be a portability problem for other environments. We can
       -- quite legitimately refuse to publicly distribute packages with these
       -- problems.
     | PackageDistInexcusable { explanation :: String }
  deriving (PackageCheck -> PackageCheck -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageCheck -> PackageCheck -> Bool
$c/= :: PackageCheck -> PackageCheck -> Bool
== :: PackageCheck -> PackageCheck -> Bool
$c== :: PackageCheck -> PackageCheck -> Bool
Eq, Eq PackageCheck
PackageCheck -> PackageCheck -> Bool
PackageCheck -> PackageCheck -> Ordering
PackageCheck -> PackageCheck -> PackageCheck
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PackageCheck -> PackageCheck -> PackageCheck
$cmin :: PackageCheck -> PackageCheck -> PackageCheck
max :: PackageCheck -> PackageCheck -> PackageCheck
$cmax :: PackageCheck -> PackageCheck -> PackageCheck
>= :: PackageCheck -> PackageCheck -> Bool
$c>= :: PackageCheck -> PackageCheck -> Bool
> :: PackageCheck -> PackageCheck -> Bool
$c> :: PackageCheck -> PackageCheck -> Bool
<= :: PackageCheck -> PackageCheck -> Bool
$c<= :: PackageCheck -> PackageCheck -> Bool
< :: PackageCheck -> PackageCheck -> Bool
$c< :: PackageCheck -> PackageCheck -> Bool
compare :: PackageCheck -> PackageCheck -> Ordering
$ccompare :: PackageCheck -> PackageCheck -> Ordering
Ord)

instance Show PackageCheck where
    show :: PackageCheck -> String
show PackageCheck
notice = PackageCheck -> String
explanation PackageCheck
notice

check :: Bool -> PackageCheck -> Maybe PackageCheck
check :: Bool -> PackageCheck -> Maybe PackageCheck
check Bool
False PackageCheck
_  = forall a. Maybe a
Nothing
check Bool
True  PackageCheck
pc = forall a. a -> Maybe a
Just PackageCheck
pc

checkSpecVersion :: PackageDescription -> CabalSpecVersion -> Bool -> PackageCheck
                 -> Maybe PackageCheck
checkSpecVersion :: PackageDescription
-> CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkSpecVersion PackageDescription
pkg CabalSpecVersion
specver Bool
cond PackageCheck
pc
  | PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
specver  = forall a. Maybe a
Nothing
  | Bool
otherwise                   = Bool -> PackageCheck -> Maybe PackageCheck
check Bool
cond PackageCheck
pc

-- ------------------------------------------------------------
-- * Standard checks
-- ------------------------------------------------------------

-- | 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'.
--
-- It requires the 'GenericPackageDescription' and optionally a particular
-- configuration of that package. If you pass 'Nothing' then we just check
-- a version of the generic description using 'flattenPackageDescription'.
--
checkPackage :: GenericPackageDescription
             -> Maybe PackageDescription
             -> [PackageCheck]
checkPackage :: GenericPackageDescription
-> Maybe PackageDescription -> [PackageCheck]
checkPackage GenericPackageDescription
gpkg Maybe PackageDescription
mpkg =
     PackageDescription -> [PackageCheck]
checkConfiguredPackage PackageDescription
pkg
  forall a. [a] -> [a] -> [a]
++ GenericPackageDescription -> [PackageCheck]
checkConditionals GenericPackageDescription
gpkg
  forall a. [a] -> [a] -> [a]
++ GenericPackageDescription -> [PackageCheck]
checkPackageVersions GenericPackageDescription
gpkg
  forall a. [a] -> [a] -> [a]
++ GenericPackageDescription -> [PackageCheck]
checkDevelopmentOnlyFlags GenericPackageDescription
gpkg
  forall a. [a] -> [a] -> [a]
++ GenericPackageDescription -> [PackageCheck]
checkFlagNames GenericPackageDescription
gpkg
  forall a. [a] -> [a] -> [a]
++ GenericPackageDescription -> [PackageCheck]
checkUnusedFlags GenericPackageDescription
gpkg
  forall a. [a] -> [a] -> [a]
++ GenericPackageDescription -> [PackageCheck]
checkUnicodeXFields GenericPackageDescription
gpkg
  forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkPathsModuleExtensions PackageDescription
pkg
  where
    pkg :: PackageDescription
pkg = forall a. a -> Maybe a -> a
fromMaybe (GenericPackageDescription -> PackageDescription
flattenPackageDescription GenericPackageDescription
gpkg) Maybe PackageDescription
mpkg

--TODO: make this variant go away
--      we should always know the GenericPackageDescription
checkConfiguredPackage :: PackageDescription -> [PackageCheck]
checkConfiguredPackage :: PackageDescription -> [PackageCheck]
checkConfiguredPackage PackageDescription
pkg =
    PackageDescription -> [PackageCheck]
checkSanity PackageDescription
pkg
 forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkFields PackageDescription
pkg
 forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkLicense PackageDescription
pkg
 forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkSourceRepos PackageDescription
pkg
 forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkAllGhcOptions PackageDescription
pkg
 forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkCCOptions PackageDescription
pkg
 forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkCxxOptions PackageDescription
pkg
 forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkCPPOptions PackageDescription
pkg
 forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkPaths PackageDescription
pkg
 forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkCabalVersion PackageDescription
pkg


-- ------------------------------------------------------------
-- * Basic sanity checks
-- ------------------------------------------------------------

-- | Check that this package description is sane.
--
checkSanity :: PackageDescription -> [PackageCheck]
checkSanity :: PackageDescription -> [PackageCheck]
checkSanity PackageDescription
pkg =
  forall a. [Maybe a] -> [a]
catMaybes [

    Bool -> PackageCheck -> Maybe PackageCheck
check (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
unPackageName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pkg. Package pkg => pkg -> PackageName
packageName forall a b. (a -> b) -> a -> b
$ PackageDescription
pkg) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible String
"No 'name' field."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Version
nullVersion forall a. Eq a => a -> a -> Bool
== forall pkg. Package pkg => pkg -> Version
packageVersion PackageDescription
pkg) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible String
"No 'version' field."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a b. (a -> b) -> a -> b
$ PackageDescription
pkg) [ forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [Executable]
executables
                       , forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [TestSuite]
testSuites
                       , forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [Benchmark]
benchmarks
                       , forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [Library]
allLibraries
                       , forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [ForeignLib]
foreignLibs ]) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible
        String
"No executables, libraries, tests, or benchmarks found. Nothing to do."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== LibraryName
LMainLibName) (forall a b. (a -> b) -> [a] -> [b]
map Library -> LibraryName
libName forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Library]
subLibraries PackageDescription
pkg)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible forall a b. (a -> b) -> a -> b
$ String
"Found one or more unnamed internal libraries. "
        forall a. [a] -> [a] -> [a]
++ String
"Only the non-internal library can have the same name as the package."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UnqualComponentName]
duplicateNames)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible forall a b. (a -> b) -> a -> b
$ String
"Duplicate sections: "
        forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map UnqualComponentName -> String
unUnqualComponentName [UnqualComponentName]
duplicateNames)
        forall a. [a] -> [a] -> [a]
++ String
". The name of every library, executable, test suite,"
        forall a. [a] -> [a] -> [a]
++ String
" and benchmark section in"
        forall a. [a] -> [a] -> [a]
++ String
" the package must be unique."

  -- NB: but it's OK for executables to have the same name!
  -- TODO shouldn't need to compare on the string level
  , Bool -> PackageCheck -> Maybe PackageCheck
check (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== forall a. Pretty a => a -> String
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg)) (forall a. Pretty a => a -> String
prettyShow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UnqualComponentName]
subLibNames)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible forall a b. (a -> b) -> a -> b
$ String
"Illegal internal library name "
        forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg)
        forall a. [a] -> [a] -> [a]
++ String
". Internal libraries cannot have the same name as the package."
        forall a. [a] -> [a] -> [a]
++ String
" Maybe you wanted a non-internal library?"
        forall a. [a] -> [a] -> [a]
++ String
" If so, rewrite the section stanza"
        forall a. [a] -> [a] -> [a]
++ String
" from 'library: '" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg) forall a. [a] -> [a] -> [a]
++ String
"' to 'library'."
  ]
  --TODO: check for name clashes case insensitively: windows file systems cannot
  --cope.

  forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PackageDescription -> Library -> [PackageCheck]
checkLibrary    PackageDescription
pkg) (PackageDescription -> [Library]
allLibraries PackageDescription
pkg)
  forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PackageDescription -> Executable -> [PackageCheck]
checkExecutable PackageDescription
pkg) (PackageDescription -> [Executable]
executables PackageDescription
pkg)
  forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PackageDescription -> TestSuite -> [PackageCheck]
checkTestSuite  PackageDescription
pkg) (PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg)
  forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PackageDescription -> Benchmark -> [PackageCheck]
checkBenchmark  PackageDescription
pkg) (PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg)

  where
    -- The public 'library' gets special dispensation, because it
    -- is common practice to export a library and name the executable
    -- the same as the package.
    subLibNames :: [UnqualComponentName]
subLibNames = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (LibraryName -> Maybe UnqualComponentName
libraryNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName) forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Library]
subLibraries PackageDescription
pkg
    exeNames :: [UnqualComponentName]
exeNames = forall a b. (a -> b) -> [a] -> [b]
map Executable -> UnqualComponentName
exeName forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Executable]
executables PackageDescription
pkg
    testNames :: [UnqualComponentName]
testNames = forall a b. (a -> b) -> [a] -> [b]
map TestSuite -> UnqualComponentName
testName forall a b. (a -> b) -> a -> b
$ PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg
    bmNames :: [UnqualComponentName]
bmNames = forall a b. (a -> b) -> [a] -> [b]
map Benchmark -> UnqualComponentName
benchmarkName forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg
    duplicateNames :: [UnqualComponentName]
duplicateNames = forall a. Ord a => [a] -> [a]
dups forall a b. (a -> b) -> a -> b
$ [UnqualComponentName]
subLibNames forall a. [a] -> [a] -> [a]
++ [UnqualComponentName]
exeNames forall a. [a] -> [a] -> [a]
++ [UnqualComponentName]
testNames forall a. [a] -> [a] -> [a]
++ [UnqualComponentName]
bmNames

checkLibrary :: PackageDescription -> Library -> [PackageCheck]
checkLibrary :: PackageDescription -> Library -> [PackageCheck]
checkLibrary PackageDescription
pkg Library
lib =
  forall a. [Maybe a] -> [a]
catMaybes [

    Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleName]
moduleDuplicates)) forall a b. (a -> b) -> a -> b
$
       String -> PackageCheck
PackageBuildImpossible forall a b. (a -> b) -> a -> b
$
            String
"Duplicate modules in library: "
         forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [ModuleName]
moduleDuplicates)

  -- TODO: This check is bogus if a required-signature was passed through
  , Bool -> PackageCheck -> Maybe PackageCheck
check (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> [ModuleName]
explicitLibModules Library
lib) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> [ModuleReexport]
reexportedModules Library
lib)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspiciousWarn forall a b. (a -> b) -> a -> b
$
           LibraryName -> String
showLibraryName (Library -> LibraryName
libName Library
lib) forall a. [a] -> [a] -> [a]
++ String
" does not expose any modules"

    -- check use of signatures sections
  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV2_0 (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> [ModuleName]
signatures Library
lib))) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"To use the 'signatures' field the package needs to specify "
        forall a. [a] -> [a] -> [a]
++ String
"at least 'cabal-version: 2.0'."

    -- check that all autogen-modules appear on other-modules or exposed-modules
  , Bool -> PackageCheck -> Maybe PackageCheck
check
      (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Library -> [ModuleName]
explicitLibModules Library
lib)) (Library -> [ModuleName]
libModulesAutogen Library
lib)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible forall a b. (a -> b) -> a -> b
$
           String
"An 'autogen-module' is neither on 'exposed-modules' or "
        forall a. [a] -> [a] -> [a]
++ String
"'other-modules'."

    -- check that all autogen-includes appear on includes or install-includes
  , Bool -> PackageCheck -> Maybe PackageCheck
check
      (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (forall a. HasBuildInfo a => a -> [String]
allExplicitIncludes Library
lib)) (forall a s. Getting a s a -> s -> a
view forall a. HasBuildInfo a => Lens' a [String]
L.autogenIncludes Library
lib)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible forall a b. (a -> b) -> a -> b
$
           String
"An include in 'autogen-includes' is neither in 'includes' or "
        forall a. [a] -> [a] -> [a]
++ String
"'install-includes'."
  ]

  where
    checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
    checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
ver Bool
cond PackageCheck
pc
      | PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
ver = forall a. Maybe a
Nothing
      | Bool
otherwise              = Bool -> PackageCheck -> Maybe PackageCheck
check Bool
cond PackageCheck
pc

    -- TODO: not sure if this check is always right in Backpack
    moduleDuplicates :: [ModuleName]
moduleDuplicates = forall a. Ord a => [a] -> [a]
dups (Library -> [ModuleName]
explicitLibModules Library
lib forall a. [a] -> [a] -> [a]
++
                             forall a b. (a -> b) -> [a] -> [b]
map ModuleReexport -> ModuleName
moduleReexportName (Library -> [ModuleReexport]
reexportedModules Library
lib))

allExplicitIncludes :: L.HasBuildInfo a => a -> [FilePath]
allExplicitIncludes :: forall a. HasBuildInfo a => a -> [String]
allExplicitIncludes a
x = forall a s. Getting a s a -> s -> a
view forall a. HasBuildInfo a => Lens' a [String]
L.includes a
x forall a. [a] -> [a] -> [a]
++ forall a s. Getting a s a -> s -> a
view forall a. HasBuildInfo a => Lens' a [String]
L.installIncludes a
x

checkExecutable :: PackageDescription -> Executable -> [PackageCheck]
checkExecutable :: PackageDescription -> Executable -> [PackageCheck]
checkExecutable PackageDescription
pkg Executable
exe =
  forall a. [Maybe a] -> [a]
catMaybes [

    Bool -> PackageCheck -> Maybe PackageCheck
check (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Executable -> String
modulePath Executable
exe)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible forall a b. (a -> b) -> a -> b
$
        String
"No 'main-is' field found for executable " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (Executable -> UnqualComponentName
exeName Executable
exe)

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Executable -> String
modulePath Executable
exe))
       Bool -> Bool -> Bool
&& (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ String -> Bool
fileExtensionSupportedLanguage forall a b. (a -> b) -> a -> b
$ Executable -> String
modulePath Executable
exe)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible forall a b. (a -> b) -> a -> b
$
           String
"The 'main-is' field must specify a '.hs' or '.lhs' file "
        forall a. [a] -> [a] -> [a]
++ String
"(even if it is generated by a preprocessor), "
        forall a. [a] -> [a] -> [a]
++ String
"or it may specify a C/C++/obj-C source file."

  , PackageDescription
-> CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkSpecVersion PackageDescription
pkg CabalSpecVersion
CabalSpecV1_18
          (String -> Bool
fileExtensionSupportedLanguage (Executable -> String
modulePath Executable
exe)
        Bool -> Bool -> Bool
&& ShowS
takeExtension (Executable -> String
modulePath Executable
exe) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
".hs", String
".lhs"]) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"The package uses a C/C++/obj-C source file for the 'main-is' field. "
        forall a. [a] -> [a] -> [a]
++ String
"To use this feature you must specify 'cabal-version: >= 1.18'."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleName]
moduleDuplicates)) forall a b. (a -> b) -> a -> b
$
       String -> PackageCheck
PackageBuildImpossible forall a b. (a -> b) -> a -> b
$
            String
"Duplicate modules in executable '" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (Executable -> UnqualComponentName
exeName Executable
exe) forall a. [a] -> [a] -> [a]
++ String
"': "
         forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [ModuleName]
moduleDuplicates)

    -- check that all autogen-modules appear on other-modules
  , Bool -> PackageCheck -> Maybe PackageCheck
check
      (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Executable -> [ModuleName]
exeModules Executable
exe)) (Executable -> [ModuleName]
exeModulesAutogen Executable
exe)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible forall a b. (a -> b) -> a -> b
$
           String
"On executable '" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (Executable -> UnqualComponentName
exeName Executable
exe) forall a. [a] -> [a] -> [a]
++ String
"' an 'autogen-module' is not "
        forall a. [a] -> [a] -> [a]
++ String
"on 'other-modules'"

    -- check that all autogen-includes appear on includes
  , Bool -> PackageCheck -> Maybe PackageCheck
check
      (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (forall a s. Getting a s a -> s -> a
view forall a. HasBuildInfo a => Lens' a [String]
L.includes Executable
exe)) (forall a s. Getting a s a -> s -> a
view forall a. HasBuildInfo a => Lens' a [String]
L.autogenIncludes Executable
exe)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible String
"An include in 'autogen-includes' is not in 'includes'."
  ]
  where
    moduleDuplicates :: [ModuleName]
moduleDuplicates = forall a. Ord a => [a] -> [a]
dups (Executable -> [ModuleName]
exeModules Executable
exe)

checkTestSuite :: PackageDescription -> TestSuite -> [PackageCheck]
checkTestSuite :: PackageDescription -> TestSuite -> [PackageCheck]
checkTestSuite PackageDescription
pkg TestSuite
test =
  forall a. [Maybe a] -> [a]
catMaybes [

    case TestSuite -> TestSuiteInterface
testInterface TestSuite
test of
      TestSuiteUnsupported tt :: TestType
tt@(TestTypeUnknown String
_ Version
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
        String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
             ShowS
quote (forall a. Pretty a => a -> String
prettyShow TestType
tt) forall a. [a] -> [a] -> [a]
++ String
" is not a known type of test suite. "
          forall a. [a] -> [a] -> [a]
++ String
"The known test suite types are: "
          forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [TestType]
knownTestTypes)

      TestSuiteUnsupported TestType
tt -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
        String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
             ShowS
quote (forall a. Pretty a => a -> String
prettyShow TestType
tt) forall a. [a] -> [a] -> [a]
++ String
" is not a supported test suite version. "
          forall a. [a] -> [a] -> [a]
++ String
"The known test suite types are: "
          forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [TestType]
knownTestTypes)
      TestSuiteInterface
_ -> forall a. Maybe a
Nothing

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleName]
moduleDuplicates) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible forall a b. (a -> b) -> a -> b
$
           String
"Duplicate modules in test suite '" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (TestSuite -> UnqualComponentName
testName TestSuite
test) forall a. [a] -> [a] -> [a]
++ String
"': "
        forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [ModuleName]
moduleDuplicates)

  , Bool -> PackageCheck -> Maybe PackageCheck
check Bool
mainIsWrongExt forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible forall a b. (a -> b) -> a -> b
$
           String
"The 'main-is' field must specify a '.hs' or '.lhs' file "
        forall a. [a] -> [a] -> [a]
++ String
"(even if it is generated by a preprocessor), "
        forall a. [a] -> [a] -> [a]
++ String
"or it may specify a C/C++/obj-C source file."

  , PackageDescription
-> CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkSpecVersion PackageDescription
pkg CabalSpecVersion
CabalSpecV1_18 (Bool
mainIsNotHsExt Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
mainIsWrongExt) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"The package uses a C/C++/obj-C source file for the 'main-is' field. "
        forall a. [a] -> [a] -> [a]
++ String
"To use this feature you must specify 'cabal-version: >= 1.18'."

    -- check that all autogen-modules appear on other-modules
  , Bool -> PackageCheck -> Maybe PackageCheck
check
      (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (TestSuite -> [ModuleName]
testModules TestSuite
test)) (TestSuite -> [ModuleName]
testModulesAutogen TestSuite
test)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible forall a b. (a -> b) -> a -> b
$
           String
"On test suite '" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (TestSuite -> UnqualComponentName
testName TestSuite
test) forall a. [a] -> [a] -> [a]
++ String
"' an 'autogen-module' is not "
        forall a. [a] -> [a] -> [a]
++ String
"on 'other-modules'"

    -- check that all autogen-includes appear on includes
  , Bool -> PackageCheck -> Maybe PackageCheck
check
      (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (forall a s. Getting a s a -> s -> a
view forall a. HasBuildInfo a => Lens' a [String]
L.includes TestSuite
test)) (forall a s. Getting a s a -> s -> a
view forall a. HasBuildInfo a => Lens' a [String]
L.autogenIncludes TestSuite
test)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible String
"An include in 'autogen-includes' is not in 'includes'."
  ]
  where
    moduleDuplicates :: [ModuleName]
moduleDuplicates = forall a. Ord a => [a] -> [a]
dups forall a b. (a -> b) -> a -> b
$ TestSuite -> [ModuleName]
testModules TestSuite
test

    mainIsWrongExt :: Bool
mainIsWrongExt = case TestSuite -> TestSuiteInterface
testInterface TestSuite
test of
      TestSuiteExeV10 Version
_ String
f -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ String -> Bool
fileExtensionSupportedLanguage String
f
      TestSuiteInterface
_                   -> Bool
False

    mainIsNotHsExt :: Bool
mainIsNotHsExt = case TestSuite -> TestSuiteInterface
testInterface TestSuite
test of
      TestSuiteExeV10 Version
_ String
f -> ShowS
takeExtension String
f forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
".hs", String
".lhs"]
      TestSuiteInterface
_                   -> Bool
False

checkBenchmark :: PackageDescription -> Benchmark -> [PackageCheck]
checkBenchmark :: PackageDescription -> Benchmark -> [PackageCheck]
checkBenchmark PackageDescription
_pkg Benchmark
bm =
  forall a. [Maybe a] -> [a]
catMaybes [

    case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
bm of
      BenchmarkUnsupported tt :: BenchmarkType
tt@(BenchmarkTypeUnknown String
_ Version
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
        String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
             ShowS
quote (forall a. Pretty a => a -> String
prettyShow BenchmarkType
tt) forall a. [a] -> [a] -> [a]
++ String
" is not a known type of benchmark. "
          forall a. [a] -> [a] -> [a]
++ String
"The known benchmark types are: "
          forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [BenchmarkType]
knownBenchmarkTypes)

      BenchmarkUnsupported BenchmarkType
tt -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
        String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
             ShowS
quote (forall a. Pretty a => a -> String
prettyShow BenchmarkType
tt) forall a. [a] -> [a] -> [a]
++ String
" is not a supported benchmark version. "
          forall a. [a] -> [a] -> [a]
++ String
"The known benchmark types are: "
          forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [BenchmarkType]
knownBenchmarkTypes)
      BenchmarkInterface
_ -> forall a. Maybe a
Nothing

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleName]
moduleDuplicates) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible forall a b. (a -> b) -> a -> b
$
           String
"Duplicate modules in benchmark '" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (Benchmark -> UnqualComponentName
benchmarkName Benchmark
bm) forall a. [a] -> [a] -> [a]
++ String
"': "
        forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [ModuleName]
moduleDuplicates)

  , Bool -> PackageCheck -> Maybe PackageCheck
check Bool
mainIsWrongExt forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible forall a b. (a -> b) -> a -> b
$
           String
"The 'main-is' field must specify a '.hs' or '.lhs' file "
        forall a. [a] -> [a] -> [a]
++ String
"(even if it is generated by a preprocessor)."

    -- check that all autogen-modules appear on other-modules
  , Bool -> PackageCheck -> Maybe PackageCheck
check
      (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Benchmark -> [ModuleName]
benchmarkModules Benchmark
bm)) (Benchmark -> [ModuleName]
benchmarkModulesAutogen Benchmark
bm)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible forall a b. (a -> b) -> a -> b
$
             String
"On benchmark '" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (Benchmark -> UnqualComponentName
benchmarkName Benchmark
bm) forall a. [a] -> [a] -> [a]
++ String
"' an 'autogen-module' is "
          forall a. [a] -> [a] -> [a]
++ String
"not on 'other-modules'"

    -- check that all autogen-includes appear on includes
  , Bool -> PackageCheck -> Maybe PackageCheck
check
      (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (forall a s. Getting a s a -> s -> a
view forall a. HasBuildInfo a => Lens' a [String]
L.includes Benchmark
bm)) (forall a s. Getting a s a -> s -> a
view forall a. HasBuildInfo a => Lens' a [String]
L.autogenIncludes Benchmark
bm)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible String
"An include in 'autogen-includes' is not in 'includes'."
  ]
  where
    moduleDuplicates :: [ModuleName]
moduleDuplicates = forall a. Ord a => [a] -> [a]
dups forall a b. (a -> b) -> a -> b
$ Benchmark -> [ModuleName]
benchmarkModules Benchmark
bm

    mainIsWrongExt :: Bool
mainIsWrongExt = case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
bm of
      BenchmarkExeV10 Version
_ String
f -> ShowS
takeExtension String
f forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
".hs", String
".lhs"]
      BenchmarkInterface
_                   -> Bool
False

-- ------------------------------------------------------------
-- * Additional pure checks
-- ------------------------------------------------------------

checkFields :: PackageDescription -> [PackageCheck]
checkFields :: PackageDescription -> [PackageCheck]
checkFields PackageDescription
pkg =
  forall a. [Maybe a] -> [a]
catMaybes [

    Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
FilePath.Windows.isValid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
prettyShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pkg. Package pkg => pkg -> PackageName
packageName forall a b. (a -> b) -> a -> b
$ PackageDescription
pkg) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"Unfortunately, the package name '" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg)
        forall a. [a] -> [a] -> [a]
++ String
"' is one of the reserved system file names on Windows. Many tools "
        forall a. [a] -> [a] -> [a]
++ String
"need to convert package names to file names so using this name "
        forall a. [a] -> [a] -> [a]
++ String
"would cause problems."

  , Bool -> PackageCheck -> Maybe PackageCheck
check ((forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"z-") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
prettyShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pkg. Package pkg => pkg -> PackageName
packageName forall a b. (a -> b) -> a -> b
$ PackageDescription
pkg) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"Package names with the prefix 'z-' are reserved by Cabal and "
        forall a. [a] -> [a] -> [a]
++ String
"cannot be used."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (forall a. Maybe a -> Bool
isNothing (PackageDescription -> Maybe BuildType
buildTypeRaw PackageDescription
pkg) Bool -> Bool -> Bool
&& PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV2_2) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
           String
"No 'build-type' specified. If you do not need a custom Setup.hs or "
        forall a. [a] -> [a] -> [a]
++ String
"./configure script then use 'build-type: Simple'."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (forall a. Maybe a -> Bool
isJust (PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo PackageDescription
pkg) Bool -> Bool -> Bool
&& PackageDescription -> BuildType
buildType PackageDescription
pkg forall a. Eq a => a -> a -> Bool
/= BuildType
Custom) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
           String
"Ignoring the 'custom-setup' section because the 'build-type' is "
        forall a. [a] -> [a] -> [a]
++ String
"not 'Custom'. Use 'build-type: Custom' if you need to use a "
        forall a. [a] -> [a] -> [a]
++ String
"custom Setup.hs script."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unknownCompilers)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
        String
"Unknown compiler " forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map ShowS
quote [String]
unknownCompilers)
                            forall a. [a] -> [a] -> [a]
++ String
" in 'tested-with' field."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unknownLanguages)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
        String
"Unknown languages: " forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep [String]
unknownLanguages

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unknownExtensions)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
        String
"Unknown extensions: " forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep [String]
unknownExtensions

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
languagesUsedAsExtensions)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
           String
"Languages listed as extensions: "
        forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep [String]
languagesUsedAsExtensions
        forall a. [a] -> [a] -> [a]
++ String
". Languages must be specified in either the 'default-language' "
        forall a. [a] -> [a] -> [a]
++ String
" or the 'other-languages' field."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Extension, Maybe Extension)]
ourDeprecatedExtensions)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious forall a b. (a -> b) -> a -> b
$
           String
"Deprecated extensions: "
        forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map (ShowS
quote forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
prettyShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Extension, Maybe Extension)]
ourDeprecatedExtensions)
        forall a. [a] -> [a] -> [a]
++ String
". " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords
             [ String
"Instead of '" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Extension
ext
            forall a. [a] -> [a] -> [a]
++ String
"' use '" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Extension
replacement forall a. [a] -> [a] -> [a]
++ String
"'."
             | (Extension
ext, Just Extension
replacement) <- [(Extension, Maybe Extension)]
ourDeprecatedExtensions ]

  , Bool -> PackageCheck -> Maybe PackageCheck
check (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
category PackageDescription
pkg)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious String
"No 'category' field."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
maintainer PackageDescription
pkg)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious String
"No 'maintainer' field."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
synopsis PackageDescription
pkg) Bool -> Bool -> Bool
&& ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
description PackageDescription
pkg)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable String
"No 'synopsis' or 'description' field."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
description PackageDescription
pkg) Bool -> Bool -> Bool
&& Bool -> Bool
not (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
synopsis PackageDescription
pkg))) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious String
"No 'description' field."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
synopsis PackageDescription
pkg) Bool -> Bool -> Bool
&& Bool -> Bool
not (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
description PackageDescription
pkg))) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious String
"No 'synopsis' field."

    --TODO: recommend the bug reports URL, author and homepage fields
    --TODO: recommend not using the stability field
    --TODO: recommend specifying a source repo

  , Bool -> PackageCheck -> Maybe PackageCheck
check (ShortText -> Int
ShortText.length (PackageDescription -> ShortText
synopsis PackageDescription
pkg) forall a. Ord a => a -> a -> Bool
>= Int
80) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious
        String
"The 'synopsis' field is rather long (max 80 chars is recommended)."

    -- See also https://github.com/haskell/cabal/pull/3479
  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
description PackageDescription
pkg))
           Bool -> Bool -> Bool
&& ShortText -> Int
ShortText.length (PackageDescription -> ShortText
description PackageDescription
pkg) forall a. Ord a => a -> a -> Bool
<= ShortText -> Int
ShortText.length (PackageDescription -> ShortText
synopsis PackageDescription
pkg)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious forall a b. (a -> b) -> a -> b
$
           String
"The 'description' field should be longer than the 'synopsis' "
        forall a. [a] -> [a] -> [a]
++ String
"field. "
        forall a. [a] -> [a] -> [a]
++ String
"It's useful to provide an informative 'description' to allow "
        forall a. [a] -> [a] -> [a]
++ String
"Haskell programmers who have never heard about your package to "
        forall a. [a] -> [a] -> [a]
++ String
"understand the purpose of your package. "
        forall a. [a] -> [a] -> [a]
++ String
"The 'description' field content is typically shown by tooling "
        forall a. [a] -> [a] -> [a]
++ String
"(e.g. 'cabal info', Haddock, Hackage) below the 'synopsis' which "
        forall a. [a] -> [a] -> [a]
++ String
"serves as a headline. "
        forall a. [a] -> [a] -> [a]
++ String
"Please refer to <https://www.haskell.org/"
        forall a. [a] -> [a] -> [a]
++ String
"cabal/users-guide/developing-packages.html#package-properties>"
        forall a. [a] -> [a] -> [a]
++ String
" for more details."

    -- check use of impossible constraints "tested-with: GHC== 6.10 && ==6.12"
  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Dependency]
testedWithImpossibleRanges)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"Invalid 'tested-with' version range: "
        forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [Dependency]
testedWithImpossibleRanges)
        forall a. [a] -> [a] -> [a]
++ String
". To indicate that you have tested a package with multiple "
        forall a. [a] -> [a] -> [a]
++ String
"different versions of the same compiler use multiple entries, "
        forall a. [a] -> [a] -> [a]
++ String
"for example 'tested-with: GHC==6.10.4, GHC==6.12.3' and not "
        forall a. [a] -> [a] -> [a]
++ String
"'tested-with: GHC==6.10.4 && ==6.12.3'."

  -- for more details on why the following was commented out,
  -- check https://github.com/haskell/cabal/pull/7470#issuecomment-875878507
  -- , check (not (null depInternalLibraryWithExtraVersion)) $
  --     PackageBuildWarning $
  --          "The package has an extraneous version range for a dependency on an "
  --       ++ "internal library: "
  --       ++ commaSep (map prettyShow depInternalLibraryWithExtraVersion)
  --       ++ ". This version range includes the current package but isn't needed "
  --       ++ "as the current package's library will always be used."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Dependency]
depInternalLibraryWithImpossibleVersion)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible forall a b. (a -> b) -> a -> b
$
           String
"The package has an impossible version range for a dependency on an "
        forall a. [a] -> [a] -> [a]
++ String
"internal library: "
        forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [Dependency]
depInternalLibraryWithImpossibleVersion)
        forall a. [a] -> [a] -> [a]
++ String
". This version range does not include the current package, and must "
        forall a. [a] -> [a] -> [a]
++ String
"be removed as the current package's library will always be used."

  -- , check (not (null depInternalExecutableWithExtraVersion)) $
  --     PackageBuildWarning $
  --          "The package has an extraneous version range for a dependency on an "
  --       ++ "internal executable: "
  --       ++ commaSep (map prettyShow depInternalExecutableWithExtraVersion)
  --       ++ ". This version range includes the current package but isn't needed "
  --       ++ "as the current package's executable will always be used."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ExeDependency]
depInternalExecutableWithImpossibleVersion)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible forall a b. (a -> b) -> a -> b
$
           String
"The package has an impossible version range for a dependency on an "
        forall a. [a] -> [a] -> [a]
++ String
"internal executable: "
        forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [ExeDependency]
depInternalExecutableWithImpossibleVersion)
        forall a. [a] -> [a] -> [a]
++ String
". This version range does not include the current package, and must "
        forall a. [a] -> [a] -> [a]
++ String
"be removed as the current package's executable will always be used."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ExeDependency]
depMissingInternalExecutable)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible forall a b. (a -> b) -> a -> b
$
           String
"The package depends on a missing internal executable: "
        forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [ExeDependency]
depInternalExecutableWithImpossibleVersion)
  ]
  where
    unknownCompilers :: [String]
unknownCompilers  = [ String
name | (OtherCompiler String
name, VersionRange
_) <- PackageDescription -> [(CompilerFlavor, VersionRange)]
testedWith PackageDescription
pkg ]
    unknownLanguages :: [String]
unknownLanguages  = [ String
name | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
                               , UnknownLanguage String
name <- BuildInfo -> [Language]
allLanguages BuildInfo
bi ]
    unknownExtensions :: [String]
unknownExtensions = [ String
name | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
                               , UnknownExtension String
name <- BuildInfo -> [Extension]
allExtensions BuildInfo
bi
                               , String
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [Language]
knownLanguages ]
    ourDeprecatedExtensions :: [(Extension, Maybe Extension)]
ourDeprecatedExtensions = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes
      [ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
==Extension
ext) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Extension, Maybe Extension)]
deprecatedExtensions
      | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
      , Extension
ext <- BuildInfo -> [Extension]
allExtensions BuildInfo
bi ]
    languagesUsedAsExtensions :: [String]
languagesUsedAsExtensions =
      [ String
name | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
             , UnknownExtension String
name <- BuildInfo -> [Extension]
allExtensions BuildInfo
bi
             , String
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [Language]
knownLanguages ]

    testedWithImpossibleRanges :: [Dependency]
testedWithImpossibleRanges =
      [ PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency (String -> PackageName
mkPackageName (forall a. Pretty a => a -> String
prettyShow CompilerFlavor
compiler)) VersionRange
vr NonEmptySet LibraryName
mainLibSet
      | (CompilerFlavor
compiler, VersionRange
vr) <- PackageDescription -> [(CompilerFlavor, VersionRange)]
testedWith PackageDescription
pkg
      , VersionRange -> Bool
isNoVersion VersionRange
vr ]

    internalLibraries :: [PackageName]
internalLibraries =
        forall a b. (a -> b) -> [a] -> [b]
map (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg) (UnqualComponentName -> PackageName
unqualComponentNameToPackageName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. LibraryName -> Maybe UnqualComponentName
libraryNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName)
            (PackageDescription -> [Library]
allLibraries PackageDescription
pkg)

    internalExecutables :: [UnqualComponentName]
internalExecutables = forall a b. (a -> b) -> [a] -> [b]
map Executable -> UnqualComponentName
exeName forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Executable]
executables PackageDescription
pkg

    internalLibDeps :: [Dependency]
internalLibDeps =
      [ Dependency
dep
      | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
      , dep :: Dependency
dep@(Dependency PackageName
name VersionRange
_ NonEmptySet LibraryName
_) <- BuildInfo -> [Dependency]
targetBuildDepends BuildInfo
bi
      , PackageName
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PackageName]
internalLibraries
      ]

    internalExeDeps :: [ExeDependency]
internalExeDeps =
      [ ExeDependency
dep
      | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
      , ExeDependency
dep <- PackageDescription -> BuildInfo -> [ExeDependency]
getAllToolDependencies PackageDescription
pkg BuildInfo
bi
      , PackageDescription -> ExeDependency -> Bool
isInternal PackageDescription
pkg ExeDependency
dep
      ]

    -- depInternalLibraryWithExtraVersion =
    --   [ dep
    --   | dep@(Dependency _ versionRange _) <- internalLibDeps
    --   , not $ isAnyVersion versionRange
    --   , packageVersion pkg `withinRange` versionRange
    --   ]

    depInternalLibraryWithImpossibleVersion :: [Dependency]
depInternalLibraryWithImpossibleVersion =
      [ Dependency
dep
      | dep :: Dependency
dep@(Dependency PackageName
_ VersionRange
versionRange NonEmptySet LibraryName
_) <- [Dependency]
internalLibDeps
      , Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall pkg. Package pkg => pkg -> Version
packageVersion PackageDescription
pkg Version -> VersionRange -> Bool
`withinRange` VersionRange
versionRange
      ]

    -- depInternalExecutableWithExtraVersion =
    --   [ dep
    --   | dep@(ExeDependency _ _ versionRange) <- internalExeDeps
    --   , not $ isAnyVersion versionRange
    --   , packageVersion pkg `withinRange` versionRange
    --   ]

    depInternalExecutableWithImpossibleVersion :: [ExeDependency]
depInternalExecutableWithImpossibleVersion =
      [ ExeDependency
dep
      | dep :: ExeDependency
dep@(ExeDependency PackageName
_ UnqualComponentName
_ VersionRange
versionRange) <- [ExeDependency]
internalExeDeps
      , Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall pkg. Package pkg => pkg -> Version
packageVersion PackageDescription
pkg Version -> VersionRange -> Bool
`withinRange` VersionRange
versionRange
      ]

    depMissingInternalExecutable :: [ExeDependency]
depMissingInternalExecutable =
      [ ExeDependency
dep
      | dep :: ExeDependency
dep@(ExeDependency PackageName
_ UnqualComponentName
eName VersionRange
_) <- [ExeDependency]
internalExeDeps
      , Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ UnqualComponentName
eName forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [UnqualComponentName]
internalExecutables
      ]


checkLicense :: PackageDescription -> [PackageCheck]
checkLicense :: PackageDescription -> [PackageCheck]
checkLicense PackageDescription
pkg = case PackageDescription -> Either License License
licenseRaw PackageDescription
pkg of
    Right License
l -> PackageDescription -> License -> [PackageCheck]
checkOldLicense PackageDescription
pkg License
l
    Left  License
l -> PackageDescription -> License -> [PackageCheck]
checkNewLicense PackageDescription
pkg License
l

checkNewLicense :: PackageDescription -> SPDX.License -> [PackageCheck]
checkNewLicense :: PackageDescription -> License -> [PackageCheck]
checkNewLicense PackageDescription
_pkg License
lic = forall a. [Maybe a] -> [a]
catMaybes
    [ Bool -> PackageCheck -> Maybe PackageCheck
check (License
lic forall a. Eq a => a -> a -> Bool
== License
SPDX.NONE) forall a b. (a -> b) -> a -> b
$
        String -> PackageCheck
PackageDistInexcusable
            String
"The 'license' field is missing or is NONE."
    ]

checkOldLicense :: PackageDescription -> License -> [PackageCheck]
checkOldLicense :: PackageDescription -> License -> [PackageCheck]
checkOldLicense PackageDescription
pkg License
lic = forall a. [Maybe a] -> [a]
catMaybes
  [ Bool -> PackageCheck -> Maybe PackageCheck
check (License
lic forall a. Eq a => a -> a -> Bool
== License
UnspecifiedLicense) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable
        String
"The 'license' field is missing."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (License
lic forall a. Eq a => a -> a -> Bool
== License
AllRightsReserved) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious
        String
"The 'license' is AllRightsReserved. Is that really what you want?"

  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_4 (License
lic forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [License]
compatLicenses) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"Unfortunately the license " forall a. [a] -> [a] -> [a]
++ ShowS
quote (forall a. Pretty a => a -> String
prettyShow (PackageDescription -> License
license PackageDescription
pkg))
        forall a. [a] -> [a] -> [a]
++ String
" messes up the parser in earlier Cabal versions so you need to "
        forall a. [a] -> [a] -> [a]
++ String
"specify 'cabal-version: >= 1.4'. Alternatively if you require "
        forall a. [a] -> [a] -> [a]
++ String
"compatibility with earlier Cabal versions then use 'OtherLicense'."

  , case License
lic of
      UnknownLicense String
l -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
        String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
             ShowS
quote (String
"license: " forall a. [a] -> [a] -> [a]
++ String
l) forall a. [a] -> [a] -> [a]
++ String
" is not a recognised license. The "
          forall a. [a] -> [a] -> [a]
++ String
"known licenses are: "
          forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [License]
knownLicenses)
      License
_ -> forall a. Maybe a
Nothing

  , Bool -> PackageCheck -> Maybe PackageCheck
check (License
lic forall a. Eq a => a -> a -> Bool
== License
BSD4) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious forall a b. (a -> b) -> a -> b
$
           String
"Using 'license: BSD4' is almost always a misunderstanding. 'BSD4' "
        forall a. [a] -> [a] -> [a]
++ String
"refers to the old 4-clause BSD license with the advertising "
        forall a. [a] -> [a] -> [a]
++ String
"clause. 'BSD3' refers the new 3-clause BSD license."

  , case License -> Maybe [Version]
unknownLicenseVersion (License
lic) of
      Just [Version]
knownVersions -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
        String -> PackageCheck
PackageDistSuspicious forall a b. (a -> b) -> a -> b
$
             String
"'license: " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (License
lic) forall a. [a] -> [a] -> [a]
++ String
"' is not a known "
          forall a. [a] -> [a] -> [a]
++ String
"version of that license. The known versions are "
          forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [Version]
knownVersions)
          forall a. [a] -> [a] -> [a]
++ String
". If this is not a mistake and you think it should be a known "
          forall a. [a] -> [a] -> [a]
++ String
"version then please file a ticket."
      Maybe [Version]
_ -> forall a. Maybe a
Nothing

  , Bool -> PackageCheck -> Maybe PackageCheck
check (License
lic forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ License
AllRightsReserved
                                 , License
UnspecifiedLicense, License
PublicDomain]
           -- AllRightsReserved and PublicDomain are not strictly
           -- licenses so don't need license files.
        Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageDescription -> [SymbolicPath PackageDir LicenseFile]
licenseFiles PackageDescription
pkg)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious String
"A 'license-file' is not specified."
  ]
  where
    unknownLicenseVersion :: License -> Maybe [Version]
unknownLicenseVersion (GPL  (Just Version
v))
      | Version
v forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Version]
knownVersions = 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Version]
knownVersions = 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Version]
knownVersions = 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Version]
knownVersions = forall a. a -> Maybe a
Just [Version]
knownVersions
      where knownVersions :: [Version]
knownVersions = [ Version
v' | Apache  (Just Version
v') <- [License]
knownLicenses ]
    unknownLicenseVersion License
_ = forall a. Maybe a
Nothing

    checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
    checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
ver Bool
cond PackageCheck
pc
      | PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
ver  = forall a. Maybe a
Nothing
      | Bool
otherwise               = Bool -> PackageCheck -> Maybe PackageCheck
check Bool
cond PackageCheck
pc

    compatLicenses :: [License]
compatLicenses = [ Maybe Version -> License
GPL forall a. Maybe a
Nothing, Maybe Version -> License
LGPL forall a. Maybe a
Nothing, Maybe Version -> License
AGPL forall a. Maybe a
Nothing, License
BSD3, License
BSD4
                     , License
PublicDomain, License
AllRightsReserved
                     , License
UnspecifiedLicense, License
OtherLicense ]

checkSourceRepos :: PackageDescription -> [PackageCheck]
checkSourceRepos :: PackageDescription -> [PackageCheck]
checkSourceRepos PackageDescription
pkg =
  forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[

    case SourceRepo -> RepoKind
repoKind SourceRepo
repo of
      RepoKindUnknown String
kind -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
        ShowS
quote String
kind forall a. [a] -> [a] -> [a]
++ String
" is not a recognised kind of source-repository. "
                   forall a. [a] -> [a] -> [a]
++ String
"The repo kind is usually 'head' or 'this'"
      RepoKind
_ -> forall a. Maybe a
Nothing

  , Bool -> PackageCheck -> Maybe PackageCheck
check (forall a. Maybe a -> Bool
isNothing (SourceRepo -> Maybe RepoType
repoType SourceRepo
repo)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable
        String
"The source-repository 'type' is a required field."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (forall a. Maybe a -> Bool
isNothing (SourceRepo -> Maybe String
repoLocation SourceRepo
repo)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable
        String
"The source-repository 'location' is a required field."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (SourceRepo -> Maybe RepoType
repoType SourceRepo
repo forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (KnownRepoType -> RepoType
KnownRepoType KnownRepoType
CVS) Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing (SourceRepo -> Maybe String
repoModule SourceRepo
repo)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable
        String
"For a CVS source-repository, the 'module' is a required field."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (SourceRepo -> RepoKind
repoKind SourceRepo
repo forall a. Eq a => a -> a -> Bool
== RepoKind
RepoThis Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing (SourceRepo -> Maybe String
repoTag SourceRepo
repo)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"For the 'this' kind of source-repository, the 'tag' is a required "
        forall a. [a] -> [a] -> [a]
++ String
"field. It should specify the tag corresponding to this version "
        forall a. [a] -> [a] -> [a]
++ String
"or release of the package."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False String -> Bool
isAbsoluteOnAnyPlatform (SourceRepo -> Maybe String
repoSubdir SourceRepo
repo)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable
        String
"The 'subdir' field of a source-repository must be a relative path."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False String -> Bool
isAbsoluteOnAnyPlatform (SourceRepo -> Maybe String
repoSubdir SourceRepo
repo)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable
        String
"The 'subdir' field of a source-repository must be a relative path."

  , do
      String
subdir <- SourceRepo -> Maybe String
repoSubdir SourceRepo
repo
      String
err    <- String -> Maybe String
isGoodRelativeDirectoryPath String
subdir
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
        String
"The 'subdir' field of a source-repository is not a good relative path: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
err
  ]
  | SourceRepo
repo <- PackageDescription -> [SourceRepo]
sourceRepos PackageDescription
pkg ]

--TODO: check location looks like a URL for some repo types.

-- | Checks GHC options from all ghc-*-options fields in the given
-- PackageDescription and reports commonly misused or non-portable flags
checkAllGhcOptions :: PackageDescription -> [PackageCheck]
checkAllGhcOptions :: PackageDescription -> [PackageCheck]
checkAllGhcOptions PackageDescription
pkg =
    String
-> (BuildInfo -> [String]) -> PackageDescription -> [PackageCheck]
checkGhcOptions String
"ghc-options" (CompilerFlavor -> BuildInfo -> [String]
hcOptions CompilerFlavor
GHC) PackageDescription
pkg
 forall a. [a] -> [a] -> [a]
++ String
-> (BuildInfo -> [String]) -> PackageDescription -> [PackageCheck]
checkGhcOptions String
"ghc-prof-options" (CompilerFlavor -> BuildInfo -> [String]
hcProfOptions CompilerFlavor
GHC) PackageDescription
pkg
 forall a. [a] -> [a] -> [a]
++ String
-> (BuildInfo -> [String]) -> PackageDescription -> [PackageCheck]
checkGhcOptions String
"ghc-shared-options" (CompilerFlavor -> BuildInfo -> [String]
hcSharedOptions CompilerFlavor
GHC) PackageDescription
pkg

-- | Extracts GHC options belonging to the given field from the given
-- PackageDescription using given function and checks them for commonly misused
-- or non-portable flags
checkGhcOptions :: String -> (BuildInfo -> [String]) -> PackageDescription -> [PackageCheck]
checkGhcOptions :: String
-> (BuildInfo -> [String]) -> PackageDescription -> [PackageCheck]
checkGhcOptions String
fieldName BuildInfo -> [String]
getOptions PackageDescription
pkg =
  forall a. [Maybe a] -> [a]
catMaybes [

    [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-fasm"] forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -fasm' is unnecessary and will not work on CPU "
        forall a. [a] -> [a] -> [a]
++ String
"architectures other than x86, x86-64, ppc or sparc."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-fvia-C"] forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious forall a b. (a -> b) -> a -> b
$
           String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++String
": -fvia-C' is usually unnecessary. If your package "
        forall a. [a] -> [a] -> [a]
++ String
"needs -via-C for correctness rather than performance then it "
        forall a. [a] -> [a] -> [a]
++ String
"is using the FFI incorrectly and will probably not work with GHC "
        forall a. [a] -> [a] -> [a]
++ String
"6.10 or later."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-fhpc"] forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -fhpc' is not necessary. Use the configure flag "
        forall a. [a] -> [a] -> [a]
++ String
" --enable-coverage instead."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-prof"] forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
           String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -prof' is not necessary and will lead to problems "
        forall a. [a] -> [a] -> [a]
++ String
"when used on a library. Use the configure flag "
        forall a. [a] -> [a] -> [a]
++ String
"--enable-library-profiling and/or --enable-profiling."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-o"] forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
           String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -o' is not needed. "
        forall a. [a] -> [a] -> [a]
++ String
"The output files are named automatically."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-hide-package"] forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
      String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -hide-package' is never needed. "
      forall a. [a] -> [a] -> [a]
++ String
"Cabal hides all packages."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"--make"] forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
      String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": --make' is never needed. Cabal uses this automatically."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-main-is"] forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious forall a b. (a -> b) -> a -> b
$
      String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -main-is' is not portable."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkNonTestAndBenchmarkFlags [String
"-O0", String
"-Onot"] forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious forall a b. (a -> b) -> a -> b
$
      String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -O0' is not needed. "
      forall a. [a] -> [a] -> [a]
++ String
"Use the --disable-optimization configure flag."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkTestAndBenchmarkFlags [String
"-O0", String
"-Onot"] forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspiciousWarn forall a b. (a -> b) -> a -> b
$
      String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -O0' is not needed. "
      forall a. [a] -> [a] -> [a]
++ String
"Use the --disable-optimization configure flag."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [ String
"-O", String
"-O1"] forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
      String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -O' is not needed. "
      forall a. [a] -> [a] -> [a]
++ String
"Cabal automatically adds the '-O' flag. "
      forall a. [a] -> [a] -> [a]
++ String
"Setting it yourself interferes with the --disable-optimization flag."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-O2"] forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspiciousWarn forall a b. (a -> b) -> a -> b
$
      String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -O2' is rarely needed. "
      forall a. [a] -> [a] -> [a]
++ String
"Check that it is giving a real benefit "
      forall a. [a] -> [a] -> [a]
++ String
"and not just imposing longer compile times on your users."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-split-sections"] forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
        String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -split-sections' is not needed. "
        forall a. [a] -> [a] -> [a]
++ String
"Use the --enable-split-sections configure flag."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-split-objs"] forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
        String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -split-objs' is not needed. "
        forall a. [a] -> [a] -> [a]
++ String
"Use the --enable-split-objs configure flag."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-optl-Wl,-s", String
"-optl-s"] forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -optl-Wl,-s' is not needed and is not portable to all"
        forall a. [a] -> [a] -> [a]
++ String
" operating systems. Cabal 1.4 and later automatically strip"
        forall a. [a] -> [a] -> [a]
++ String
" executables. Cabal also has a flag --disable-executable-stripping"
        forall a. [a] -> [a] -> [a]
++ String
" which is necessary when building packages for some Linux"
        forall a. [a] -> [a] -> [a]
++ String
" distributions and using '-optl-Wl,-s' prevents that from working."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-fglasgow-exts"] forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious forall a b. (a -> b) -> a -> b
$
        String
"Instead of '" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -fglasgow-exts' it is preferable to use "
        forall a. [a] -> [a] -> [a]
++ String
"the 'extensions' field."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (String
"-threaded" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
lib_ghc_options) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
           String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -threaded' has no effect for libraries. It should "
        forall a. [a] -> [a] -> [a]
++ String
"only be used for executables."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (String
"-rtsopts" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
lib_ghc_options) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
           String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -rtsopts' has no effect for libraries. It should "
        forall a. [a] -> [a] -> [a]
++ String
"only be used for executables."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\String
opt -> String
"-with-rtsopts" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
opt) [String]
lib_ghc_options) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
           String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -with-rtsopts' has no effect for libraries. It "
        forall a. [a] -> [a] -> [a]
++ String
"should only be used for executables."

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
fieldName String
"extensions"
      [ (String
flag, forall a. Pretty a => a -> String
prettyShow Extension
extension) | String
flag <- [String]
all_ghc_options
                                  , Just Extension
extension <- [String -> Maybe Extension
ghcExtension String
flag] ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
fieldName String
"extensions"
      [ (String
flag, String
extension) | flag :: String
flag@(Char
'-':Char
'X':String
extension) <- [String]
all_ghc_options ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
fieldName String
"cpp-options" forall a b. (a -> b) -> a -> b
$
         [ (String
flag, String
flag) | flag :: String
flag@(Char
'-':Char
'D':String
_) <- [String]
all_ghc_options ]
      forall a. [a] -> [a] -> [a]
++ [ (String
flag, String
flag) | flag :: String
flag@(Char
'-':Char
'U':String
_) <- [String]
all_ghc_options ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
fieldName String
"include-dirs"
      [ (String
flag, String
dir) | flag :: String
flag@(Char
'-':Char
'I':String
dir) <- [String]
all_ghc_options ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
fieldName String
"extra-libraries"
      [ (String
flag, String
lib) | flag :: String
flag@(Char
'-':Char
'l':String
lib) <- [String]
all_ghc_options ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
fieldName String
"extra-lib-dirs"
      [ (String
flag, String
dir) | flag :: String
flag@(Char
'-':Char
'L':String
dir) <- [String]
all_ghc_options ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
fieldName String
"frameworks"
      [ (String
flag, String
fmwk) | (flag :: String
flag@String
"-framework", String
fmwk) <-
           forall a b. [a] -> [b] -> [(a, b)]
zip [String]
all_ghc_options (forall a. [a] -> [a]
safeTail [String]
all_ghc_options) ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
fieldName String
"extra-framework-dirs"
      [ (String
flag, String
dir) | (flag :: String
flag@String
"-framework-path", String
dir) <-
           forall a b. [a] -> [b] -> [(a, b)]
zip [String]
all_ghc_options (forall a. [a] -> [a]
safeTail [String]
all_ghc_options) ]
  ]

  where
    all_ghc_options :: [String]
all_ghc_options    = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [String]
getOptions (PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg)
    lib_ghc_options :: [String]
lib_ghc_options    = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (BuildInfo -> [String]
getOptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> BuildInfo
libBuildInfo)
                         (PackageDescription -> [Library]
allLibraries PackageDescription
pkg)
    test_ghc_options :: [String]
test_ghc_options      = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (BuildInfo -> [String]
getOptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestSuite -> BuildInfo
testBuildInfo)
                            (PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg)
    benchmark_ghc_options :: [String]
benchmark_ghc_options = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (BuildInfo -> [String]
getOptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark -> BuildInfo
benchmarkBuildInfo)
                            (PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg)
    test_and_benchmark_ghc_options :: [String]
test_and_benchmark_ghc_options     = [String]
test_ghc_options forall a. [a] -> [a] -> [a]
++
                                         [String]
benchmark_ghc_options
    non_test_and_benchmark_ghc_options :: [String]
non_test_and_benchmark_ghc_options = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [String]
getOptions
                                         (PackageDescription -> [BuildInfo]
allBuildInfo (PackageDescription
pkg { testSuites :: [TestSuite]
testSuites = []
                                                            , benchmarks :: [Benchmark]
benchmarks = []
                                                            }))

    checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
    checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String]
flags = Bool -> PackageCheck -> Maybe PackageCheck
check (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
flags) [String]
all_ghc_options)

    checkTestAndBenchmarkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
    checkTestAndBenchmarkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
checkTestAndBenchmarkFlags [String]
flags = Bool -> PackageCheck -> Maybe PackageCheck
check (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
flags) [String]
test_and_benchmark_ghc_options)

    checkNonTestAndBenchmarkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
    checkNonTestAndBenchmarkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
checkNonTestAndBenchmarkFlags [String]
flags = Bool -> PackageCheck -> Maybe PackageCheck
check (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
flags) [String]
non_test_and_benchmark_ghc_options)

    ghcExtension :: String -> Maybe Extension
ghcExtension (Char
'-':Char
'f':String
name) = case String
name of
      String
"allow-overlapping-instances"    -> KnownExtension -> Maybe Extension
enable  KnownExtension
OverlappingInstances
      String
"no-allow-overlapping-instances" -> KnownExtension -> Maybe Extension
disable KnownExtension
OverlappingInstances
      String
"th"                             -> KnownExtension -> Maybe Extension
enable  KnownExtension
TemplateHaskell
      String
"no-th"                          -> KnownExtension -> Maybe Extension
disable KnownExtension
TemplateHaskell
      String
"ffi"                            -> KnownExtension -> Maybe Extension
enable  KnownExtension
ForeignFunctionInterface
      String
"no-ffi"                         -> KnownExtension -> Maybe Extension
disable KnownExtension
ForeignFunctionInterface
      String
"fi"                             -> KnownExtension -> Maybe Extension
enable  KnownExtension
ForeignFunctionInterface
      String
"no-fi"                          -> KnownExtension -> Maybe Extension
disable KnownExtension
ForeignFunctionInterface
      String
"monomorphism-restriction"       -> KnownExtension -> Maybe Extension
enable  KnownExtension
MonomorphismRestriction
      String
"no-monomorphism-restriction"    -> KnownExtension -> Maybe Extension
disable KnownExtension
MonomorphismRestriction
      String
"mono-pat-binds"                 -> KnownExtension -> Maybe Extension
enable  KnownExtension
MonoPatBinds
      String
"no-mono-pat-binds"              -> KnownExtension -> Maybe Extension
disable KnownExtension
MonoPatBinds
      String
"allow-undecidable-instances"    -> KnownExtension -> Maybe Extension
enable  KnownExtension
UndecidableInstances
      String
"no-allow-undecidable-instances" -> KnownExtension -> Maybe Extension
disable KnownExtension
UndecidableInstances
      String
"allow-incoherent-instances"     -> KnownExtension -> Maybe Extension
enable  KnownExtension
IncoherentInstances
      String
"no-allow-incoherent-instances"  -> KnownExtension -> Maybe Extension
disable KnownExtension
IncoherentInstances
      String
"arrows"                         -> KnownExtension -> Maybe Extension
enable  KnownExtension
Arrows
      String
"no-arrows"                      -> KnownExtension -> Maybe Extension
disable KnownExtension
Arrows
      String
"generics"                       -> KnownExtension -> Maybe Extension
enable  KnownExtension
Generics
      String
"no-generics"                    -> KnownExtension -> Maybe Extension
disable KnownExtension
Generics
      String
"implicit-prelude"               -> KnownExtension -> Maybe Extension
enable  KnownExtension
ImplicitPrelude
      String
"no-implicit-prelude"            -> KnownExtension -> Maybe Extension
disable KnownExtension
ImplicitPrelude
      String
"implicit-params"                -> KnownExtension -> Maybe Extension
enable  KnownExtension
ImplicitParams
      String
"no-implicit-params"             -> KnownExtension -> Maybe Extension
disable KnownExtension
ImplicitParams
      String
"bang-patterns"                  -> KnownExtension -> Maybe Extension
enable  KnownExtension
BangPatterns
      String
"no-bang-patterns"               -> KnownExtension -> Maybe Extension
disable KnownExtension
BangPatterns
      String
"scoped-type-variables"          -> KnownExtension -> Maybe Extension
enable  KnownExtension
ScopedTypeVariables
      String
"no-scoped-type-variables"       -> KnownExtension -> Maybe Extension
disable KnownExtension
ScopedTypeVariables
      String
"extended-default-rules"         -> KnownExtension -> Maybe Extension
enable  KnownExtension
ExtendedDefaultRules
      String
"no-extended-default-rules"      -> KnownExtension -> Maybe Extension
disable KnownExtension
ExtendedDefaultRules
      String
_                                -> forall a. Maybe a
Nothing
    ghcExtension String
"-cpp"             = KnownExtension -> Maybe Extension
enable KnownExtension
CPP
    ghcExtension String
_                  = forall a. Maybe a
Nothing

    enable :: KnownExtension -> Maybe Extension
enable  KnownExtension
e = forall a. a -> Maybe a
Just (KnownExtension -> Extension
EnableExtension KnownExtension
e)
    disable :: KnownExtension -> Maybe Extension
disable KnownExtension
e = forall a. a -> Maybe a
Just (KnownExtension -> Extension
DisableExtension KnownExtension
e)

checkCCOptions :: PackageDescription -> [PackageCheck]
checkCCOptions :: PackageDescription -> [PackageCheck]
checkCCOptions = String
-> String
-> (BuildInfo -> [String])
-> PackageDescription
-> [PackageCheck]
checkCLikeOptions String
"C" String
"cc-options" BuildInfo -> [String]
ccOptions

checkCxxOptions :: PackageDescription -> [PackageCheck]
checkCxxOptions :: PackageDescription -> [PackageCheck]
checkCxxOptions = String
-> String
-> (BuildInfo -> [String])
-> PackageDescription
-> [PackageCheck]
checkCLikeOptions String
"C++" String
"cxx-options" BuildInfo -> [String]
cxxOptions

checkCLikeOptions :: String -> String -> (BuildInfo -> [String]) -> PackageDescription -> [PackageCheck]
checkCLikeOptions :: String
-> String
-> (BuildInfo -> [String])
-> PackageDescription
-> [PackageCheck]
checkCLikeOptions String
label String
prefix BuildInfo -> [String]
accessor PackageDescription
pkg =
  forall a. [Maybe a] -> [a]
catMaybes [

    String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
prefix String
"include-dirs"
      [ (String
flag, String
dir) | flag :: String
flag@(Char
'-':Char
'I':String
dir) <- [String]
all_cLikeOptions ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
prefix String
"extra-libraries"
      [ (String
flag, String
lib) | flag :: String
flag@(Char
'-':Char
'l':String
lib) <- [String]
all_cLikeOptions ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
prefix String
"extra-lib-dirs"
      [ (String
flag, String
dir) | flag :: String
flag@(Char
'-':Char
'L':String
dir) <- [String]
all_cLikeOptions ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
"ld-options" String
"extra-libraries"
      [ (String
flag, String
lib) | flag :: String
flag@(Char
'-':Char
'l':String
lib) <- [String]
all_ldOptions ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
"ld-options" String
"extra-lib-dirs"
      [ (String
flag, String
dir) | flag :: String
flag@(Char
'-':Char
'L':String
dir) <- [String]
all_ldOptions ]

  , [String] -> PackageCheck -> Maybe PackageCheck
checkCCFlags [ String
"-O", String
"-Os", String
"-O0", String
"-O1", String
"-O2", String
"-O3" ] forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious forall a b. (a -> b) -> a -> b
$
           String
"'"forall a. [a] -> [a] -> [a]
++String
prefixforall a. [a] -> [a] -> [a]
++String
": -O[n]' is generally not needed. When building with "
        forall a. [a] -> [a] -> [a]
++ String
" optimisations Cabal automatically adds '-O2' for "forall a. [a] -> [a] -> [a]
++String
labelforall a. [a] -> [a] -> [a]
++String
" code. "
        forall a. [a] -> [a] -> [a]
++ String
"Setting it yourself interferes with the --disable-optimization flag."
  ]

  where all_cLikeOptions :: [String]
all_cLikeOptions = [ String
opts | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
                                  , String
opts <- BuildInfo -> [String]
accessor BuildInfo
bi ]
        all_ldOptions :: [String]
all_ldOptions = [ String
opts | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
                               , String
opts <- BuildInfo -> [String]
ldOptions BuildInfo
bi ]

        checkCCFlags :: [String] -> PackageCheck -> Maybe PackageCheck
        checkCCFlags :: [String] -> PackageCheck -> Maybe PackageCheck
checkCCFlags [String]
flags = Bool -> PackageCheck -> Maybe PackageCheck
check (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
flags) [String]
all_cLikeOptions)

checkCPPOptions :: PackageDescription -> [PackageCheck]
checkCPPOptions :: PackageDescription -> [PackageCheck]
checkCPPOptions PackageDescription
pkg = forall a. [Maybe a] -> [a]
catMaybes
    [ String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
"cpp-options" String
"include-dirs"
      [ (String
flag, String
dir) | flag :: String
flag@(Char
'-':Char
'I':String
dir) <- [String]
all_cppOptions ]
    ]
    forall a. [a] -> [a] -> [a]
++
    [ String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$ String
"'cpp-options': " forall a. [a] -> [a] -> [a]
++ String
opt forall a. [a] -> [a] -> [a]
++ String
" is not portable C-preprocessor flag"
    | String
opt <- [String]
all_cppOptions
    -- "-I" is handled above, we allow only -DNEWSTUFF and -UOLDSTUFF
    , Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
opt) [String
"-D", String
"-U", String
"-I" ]
    ]
  where
    all_cppOptions :: [String]
all_cppOptions = [ String
opts | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg, String
opts <- BuildInfo -> [String]
cppOptions BuildInfo
bi ]

checkAlternatives :: String -> String -> [(String, String)]
                  -> Maybe PackageCheck
checkAlternatives :: String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
badField String
goodField [(String, String)]
flags =
  Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
badFlags)) forall a b. (a -> b) -> a -> b
$
    String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
         String
"Instead of " forall a. [a] -> [a] -> [a]
++ ShowS
quote (String
badField forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
badFlags)
      forall a. [a] -> [a] -> [a]
++ String
" use " forall a. [a] -> [a] -> [a]
++ ShowS
quote (String
goodField forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
goodFlags)

  where ([String]
badFlags, [String]
goodFlags) = forall a b. [(a, b)] -> ([a], [b])
unzip [(String, String)]
flags

data PathKind
    = PathKindFile
    | PathKindDirectory
    | PathKindGlob

checkPaths :: PackageDescription -> [PackageCheck]
checkPaths :: PackageDescription -> [PackageCheck]
checkPaths PackageDescription
pkg =
  [ String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
         ShowS
quote (String
field forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
path)
      forall a. [a] -> [a] -> [a]
++ String
" is a relative path outside of the source tree. "
      forall a. [a] -> [a] -> [a]
++ String
"This will not work when generating a tarball with 'sdist'."
  | (String
path, String
field, PathKind
_) <- [(String, String, PathKind)]
relPaths forall a. [a] -> [a] -> [a]
++ [(String, String, PathKind)]
absPaths
  , String -> Bool
isOutsideTree String
path ]
  forall a. [a] -> [a] -> [a]
++
  [ String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
      ShowS
quote (String
field forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
path) forall a. [a] -> [a] -> [a]
++ String
" is an absolute path."
  | (String
path, String
field, PathKind
_) <- [(String, String, PathKind)]
relPaths
  , String -> Bool
isAbsoluteOnAnyPlatform String
path ]
  forall a. [a] -> [a] -> [a]
++
  [ String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
      ShowS
quote (String
field forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
path) forall a. [a] -> [a] -> [a]
++ String
" is not good relative path: " forall a. [a] -> [a] -> [a]
++ String
err
  | (String
path, String
field, PathKind
kind) <- [(String, String, PathKind)]
relPaths
  -- these are not paths, but globs...
  , String
err <- forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ case PathKind
kind of
      PathKind
PathKindFile      -> String -> Maybe String
isGoodRelativeFilePath String
path
      PathKind
PathKindGlob      -> String -> Maybe String
isGoodRelativeGlob String
path
      PathKind
PathKindDirectory -> String -> Maybe String
isGoodRelativeDirectoryPath String
path
  ]
  forall a. [a] -> [a] -> [a]
++
  [ String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
         ShowS
quote (String
field forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
path) forall a. [a] -> [a] -> [a]
++ String
" points inside the 'dist' "
      forall a. [a] -> [a] -> [a]
++ String
"directory. This is not reliable because the location of this "
      forall a. [a] -> [a] -> [a]
++ String
"directory is configurable by the user (or package manager). In "
      forall a. [a] -> [a] -> [a]
++ String
"addition the layout of the 'dist' directory is subject to change "
      forall a. [a] -> [a] -> [a]
++ String
"in future versions of Cabal."
  | (String
path, String
field, PathKind
_) <- [(String, String, PathKind)]
relPaths forall a. [a] -> [a] -> [a]
++ [(String, String, PathKind)]
absPaths
  , String -> Bool
isInsideDist String
path ]
  forall a. [a] -> [a] -> [a]
++
  [ String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
         String
"The 'ghc-options' contains the path '" forall a. [a] -> [a] -> [a]
++ String
path forall a. [a] -> [a] -> [a]
++ String
"' which points "
      forall a. [a] -> [a] -> [a]
++ String
"inside the 'dist' directory. This is not reliable because the "
      forall a. [a] -> [a] -> [a]
++ String
"location of this directory is configurable by the user (or package "
      forall a. [a] -> [a] -> [a]
++ String
"manager). In addition the layout of the 'dist' directory is subject "
      forall a. [a] -> [a] -> [a]
++ String
"to change in future versions of Cabal."
  | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
  , (CompilerFlavor
GHC, [String]
flags) <- forall v. PerCompilerFlavor v -> [(CompilerFlavor, v)]
perCompilerFlavorToList forall a b. (a -> b) -> a -> b
$ BuildInfo -> PerCompilerFlavor [String]
options BuildInfo
bi
  , String
path <- [String]
flags
  , String -> Bool
isInsideDist String
path ]
  forall a. [a] -> [a] -> [a]
++
  [ String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
        String
"In the 'data-files' field: " forall a. [a] -> [a] -> [a]
++ String -> GlobSyntaxError -> String
explainGlobSyntaxError String
pat GlobSyntaxError
err
  | String
pat <- PackageDescription -> [String]
dataFiles PackageDescription
pkg
  , Left GlobSyntaxError
err <- [CabalSpecVersion -> String -> Either GlobSyntaxError Glob
parseFileGlob (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg) String
pat]
  ]
  forall a. [a] -> [a] -> [a]
++
  [ String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
        String
"In the 'extra-source-files' field: " forall a. [a] -> [a] -> [a]
++ String -> GlobSyntaxError -> String
explainGlobSyntaxError String
pat GlobSyntaxError
err
  | String
pat <- PackageDescription -> [String]
extraSrcFiles PackageDescription
pkg
  , Left GlobSyntaxError
err <- [CabalSpecVersion -> String -> Either GlobSyntaxError Glob
parseFileGlob (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg) String
pat]
  ]
  forall a. [a] -> [a] -> [a]
++
  [ String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
        String
"In the 'extra-doc-files' field: " forall a. [a] -> [a] -> [a]
++ String -> GlobSyntaxError -> String
explainGlobSyntaxError String
pat GlobSyntaxError
err
  | String
pat <- PackageDescription -> [String]
extraDocFiles PackageDescription
pkg
  , Left GlobSyntaxError
err <- [CabalSpecVersion -> String -> Either GlobSyntaxError Glob
parseFileGlob (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg) String
pat]
  ]
  where
    isOutsideTree :: String -> Bool
isOutsideTree String
path = case String -> [String]
splitDirectories String
path of
      String
"..":[String]
_     -> Bool
True
      String
".":String
"..":[String]
_ -> Bool
True
      [String]
_          -> Bool
False
    isInsideDist :: String -> Bool
isInsideDist String
path = case forall a b. (a -> b) -> [a] -> [b]
map ShowS
lowercase (String -> [String]
splitDirectories String
path) of
      String
"dist"    :[String]
_ -> Bool
True
      String
".":String
"dist":[String]
_ -> Bool
True
      [String]
_            -> Bool
False

    -- paths that must be relative
    relPaths :: [(FilePath, String, PathKind)]
    relPaths :: [(String, String, PathKind)]
relPaths =
      [ (String
path, String
"extra-source-files", PathKind
PathKindGlob)      | String
path <- PackageDescription -> [String]
extraSrcFiles PackageDescription
pkg ] forall a. [a] -> [a] -> [a]
++
      [ (String
path, String
"extra-tmp-files",    PathKind
PathKindFile)      | String
path <- PackageDescription -> [String]
extraTmpFiles PackageDescription
pkg ] forall a. [a] -> [a] -> [a]
++
      [ (String
path, String
"extra-doc-files",    PathKind
PathKindGlob)      | String
path <- PackageDescription -> [String]
extraDocFiles PackageDescription
pkg ] forall a. [a] -> [a] -> [a]
++
      [ (String
path, String
"data-files",         PathKind
PathKindGlob)      | String
path <- PackageDescription -> [String]
dataFiles     PackageDescription
pkg ] forall a. [a] -> [a] -> [a]
++
      [ (String
path, String
"data-dir",           PathKind
PathKindDirectory) | String
path <- [PackageDescription -> String
dataDir      PackageDescription
pkg]] forall a. [a] -> [a] -> [a]
++
      [ (String
path, String
"license-file",       PathKind
PathKindFile)      | String
path <- forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath forall a b. (a -> b) -> a -> b
$ PackageDescription -> [SymbolicPath PackageDir LicenseFile]
licenseFiles  PackageDescription
pkg ] forall a. [a] -> [a] -> [a]
++
      forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [ (String
path, String
"asm-sources",      PathKind
PathKindFile)      | String
path <- BuildInfo -> [String]
asmSources      BuildInfo
bi ] forall a. [a] -> [a] -> [a]
++
          [ (String
path, String
"cmm-sources",      PathKind
PathKindFile)      | String
path <- BuildInfo -> [String]
cmmSources      BuildInfo
bi ] forall a. [a] -> [a] -> [a]
++
          [ (String
path, String
"c-sources",        PathKind
PathKindFile)      | String
path <- BuildInfo -> [String]
cSources        BuildInfo
bi ] forall a. [a] -> [a] -> [a]
++
          [ (String
path, String
"cxx-sources",      PathKind
PathKindFile)      | String
path <- BuildInfo -> [String]
cxxSources      BuildInfo
bi ] forall a. [a] -> [a] -> [a]
++
          [ (String
path, String
"js-sources",       PathKind
PathKindFile)      | String
path <- BuildInfo -> [String]
jsSources       BuildInfo
bi ] forall a. [a] -> [a] -> [a]
++
          [ (String
path, String
"install-includes", PathKind
PathKindFile)      | String
path <- BuildInfo -> [String]
installIncludes BuildInfo
bi ] forall a. [a] -> [a] -> [a]
++
          [ (String
path, String
"hs-source-dirs",   PathKind
PathKindDirectory) | String
path <- forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath forall a b. (a -> b) -> a -> b
$ BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi ]
        | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
        ]

    -- paths that are allowed to be absolute
    absPaths :: [(FilePath, String, PathKind)]
    absPaths :: [(String, String, PathKind)]
absPaths = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ [ (String
path, String
"includes",       PathKind
PathKindFile)      | String
path <- BuildInfo -> [String]
includes     BuildInfo
bi ] forall a. [a] -> [a] -> [a]
++
        [ (String
path, String
"include-dirs",   PathKind
PathKindDirectory) | String
path <- BuildInfo -> [String]
includeDirs  BuildInfo
bi ] forall a. [a] -> [a] -> [a]
++
        [ (String
path, String
"extra-lib-dirs", PathKind
PathKindDirectory) | String
path <- BuildInfo -> [String]
extraLibDirs BuildInfo
bi ]
      | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
      ]

--TODO: check sets of paths that would be interpreted differently between Unix
-- and windows, ie case-sensitive or insensitive. Things that might clash, or
-- conversely be distinguished.

--TODO: use the tar path checks on all the above paths

-- | Check that the package declares the version in the @\"cabal-version\"@
-- field correctly.
--
checkCabalVersion :: PackageDescription -> [PackageCheck]
checkCabalVersion :: PackageDescription -> [PackageCheck]
checkCabalVersion PackageDescription
pkg =
  forall a. [Maybe a] -> [a]
catMaybes [

    -- check use of test suite sections
    CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_8 (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"The 'test-suite' section is new in Cabal 1.10. "
        forall a. [a] -> [a] -> [a]
++ String
"Unfortunately it messes up the parser in older Cabal versions "
        forall a. [a] -> [a] -> [a]
++ String
"so you must specify at least 'cabal-version: >= 1.8', but note "
        forall a. [a] -> [a] -> [a]
++ String
"that only Cabal 1.10 and later can actually run such test suites."

    -- check use of default-language field
    -- note that we do not need to do an equivalent check for the
    -- other-language field since that one does not change behaviour
  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_10 (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall a. Maybe a -> Bool
isJust (forall {b}. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> Maybe Language
defaultLanguage)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
           String
"To use the 'default-language' field the package needs to specify "
        forall a. [a] -> [a] -> [a]
++ String
"at least 'cabal-version: >= 1.10'."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV1_10 Bool -> Bool -> Bool
&& PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV3_4
           Bool -> Bool -> Bool
&& (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall a. Maybe a -> Bool
isNothing (forall {b}. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> Maybe Language
defaultLanguage))) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
           String
"Packages using 'cabal-version: >= 1.10' and before 'cabal-version: 3.4' must specify the "
        forall a. [a] -> [a] -> [a]
++ String
"'default-language' field for each component (e.g. Haskell98 or "
        forall a. [a] -> [a] -> [a]
++ String
"Haskell2010). If a component uses different languages in "
        forall a. [a] -> [a] -> [a]
++ String
"different modules then list the other ones in the "
        forall a. [a] -> [a] -> [a]
++ String
"'other-languages' field."

  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_18
    (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ PackageDescription -> [String]
extraDocFiles PackageDescription
pkg) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"To use the 'extra-doc-files' field the package needs to specify "
        forall a. [a] -> [a] -> [a]
++ String
"at least 'cabal-version: >= 1.18'."

  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV2_0
    (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageDescription -> [Library]
subLibraries PackageDescription
pkg))) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"To use multiple 'library' sections or a named library section "
        forall a. [a] -> [a] -> [a]
++ String
"the package needs to specify at least 'cabal-version: 2.0'."

    -- check use of reexported-modules sections
  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_22
    (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (t :: * -> *) a. Foldable t => t a -> Bool
nullforall b c a. (b -> c) -> (a -> b) -> a -> c
.Library -> [ModuleReexport]
reexportedModules) (PackageDescription -> [Library]
allLibraries PackageDescription
pkg)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"To use the 'reexported-module' field the package needs to specify "
        forall a. [a] -> [a] -> [a]
++ String
"at least 'cabal-version: >= 1.22'."

    -- check use of thinning and renaming
  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV2_0 Bool
usesBackpackIncludes forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"To use the 'mixins' field the package needs to specify "
        forall a. [a] -> [a] -> [a]
++ String
"at least 'cabal-version: 2.0'."

    -- check use of 'extra-framework-dirs' field
  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_24 (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (forall {b}. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> [String]
extraFrameworkDirs)) forall a b. (a -> b) -> a -> b
$
      -- Just a warning, because this won't break on old Cabal versions.
      String -> PackageCheck
PackageDistSuspiciousWarn forall a b. (a -> b) -> a -> b
$
           String
"To use the 'extra-framework-dirs' field the package needs to specify"
        forall a. [a] -> [a] -> [a]
++ String
" at least 'cabal-version: >= 1.24'."

    -- check use of default-extensions field
    -- don't need to do the equivalent check for other-extensions
  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_10 (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (forall {b}. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> [Extension]
defaultExtensions)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
           String
"To use the 'default-extensions' field the package needs to specify "
        forall a. [a] -> [a] -> [a]
++ String
"at least 'cabal-version: >= 1.10'."

    -- check use of extensions field
  , Bool -> PackageCheck -> Maybe PackageCheck
check (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV1_10
           Bool -> Bool -> Bool
&& (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (forall {b}. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> [Extension]
oldExtensions))) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
           String
"For packages using 'cabal-version: >= 1.10' the 'extensions' "
        forall a. [a] -> [a] -> [a]
++ String
"field is deprecated. The new 'default-extensions' field lists "
        forall a. [a] -> [a] -> [a]
++ String
"extensions that are used in all modules in the component, while "
        forall a. [a] -> [a] -> [a]
++ String
"the 'other-extensions' field lists extensions that are used in "
        forall a. [a] -> [a] -> [a]
++ String
"some modules, e.g. via the {-# LANGUAGE #-} pragma."

  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV3_0 (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
                        (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {b}. (BuildInfo -> b) -> [b]
buildInfoField
                         [ BuildInfo -> [String]
asmSources
                         , BuildInfo -> [String]
cmmSources
                         , BuildInfo -> [String]
extraBundledLibs
                         , BuildInfo -> [String]
extraLibFlavours ])) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"The use of 'asm-sources', 'cmm-sources', 'extra-bundled-libraries' "
        forall a. [a] -> [a] -> [a]
++ String
" and 'extra-library-flavours' requires the package "
        forall a. [a] -> [a] -> [a]
++ String
" to specify at least 'cabal-version: 3.0'."

  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV3_0 (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall a b. (a -> b) -> a -> b
$ forall {b}. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> [String]
extraDynLibFlavours) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"The use of 'extra-dynamic-library-flavours' requires the package "
        forall a. [a] -> [a] -> [a]
++ String
" to specify at least 'cabal-version: 3.0'. The flavours are: "
        forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep [ String
flav
                    | [String]
flavs <- forall {b}. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> [String]
extraDynLibFlavours
                    , String
flav <- [String]
flavs ]

  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV2_2 (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
                        (forall {b}. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> [ModuleName]
virtualModules)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"The use of 'virtual-modules' requires the package "
        forall a. [a] -> [a] -> [a]
++ String
" to specify at least 'cabal-version: 2.2'."

    -- check use of "source-repository" section
  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_6 (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageDescription -> [SourceRepo]
sourceRepos PackageDescription
pkg))) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"The 'source-repository' section is new in Cabal 1.6. "
        forall a. [a] -> [a] -> [a]
++ String
"Unfortunately it messes up the parser in earlier Cabal versions "
        forall a. [a] -> [a] -> [a]
++ String
"so you need to specify 'cabal-version: >= 1.6'."

    -- check for new language extensions
  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_4 (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Extension]
mentionedExtensionsThatNeedCabal12)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"Unfortunately the language extensions "
        forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map (ShowS
quote forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
prettyShow) [Extension]
mentionedExtensionsThatNeedCabal12)
        forall a. [a] -> [a] -> [a]
++ String
" break the parser in earlier Cabal versions so you need to "
        forall a. [a] -> [a] -> [a]
++ String
"specify 'cabal-version: >= 1.4'. Alternatively if you require "
        forall a. [a] -> [a] -> [a]
++ String
"compatibility with earlier Cabal versions then you may be able to "
        forall a. [a] -> [a] -> [a]
++ String
"use an equivalent compiler-specific flag."

  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_4 (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Extension]
mentionedExtensionsThatNeedCabal14)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"Unfortunately the language extensions "
        forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map (ShowS
quote forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
prettyShow) [Extension]
mentionedExtensionsThatNeedCabal14)
        forall a. [a] -> [a] -> [a]
++ String
" break the parser in earlier Cabal versions so you need to "
        forall a. [a] -> [a] -> [a]
++ String
"specify 'cabal-version: >= 1.4'. Alternatively if you require "
        forall a. [a] -> [a] -> [a]
++ String
"compatibility with earlier Cabal versions then you may be able to "
        forall a. [a] -> [a] -> [a]
++ String
"use an equivalent compiler-specific flag."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV1_24
           Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing (PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo PackageDescription
pkg)
           Bool -> Bool -> Bool
&& PackageDescription -> BuildType
buildType PackageDescription
pkg forall a. Eq a => a -> a -> Bool
== BuildType
Custom) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
           String
"Packages using 'cabal-version: >= 1.24' with 'build-type: Custom' "
        forall a. [a] -> [a] -> [a]
++ String
"must use a 'custom-setup' section with a 'setup-depends' field "
        forall a. [a] -> [a] -> [a]
++ String
"that specifies the dependencies of the Setup.hs script itself. "
        forall a. [a] -> [a] -> [a]
++ String
"The 'setup-depends' field uses the same syntax as 'build-depends', "
        forall a. [a] -> [a] -> [a]
++ String
"so a simple example would be 'setup-depends: base, Cabal'."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV1_24
           Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing (PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo PackageDescription
pkg)
           Bool -> Bool -> Bool
&& PackageDescription -> BuildType
buildType PackageDescription
pkg forall a. Eq a => a -> a -> Bool
== BuildType
Custom) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspiciousWarn forall a b. (a -> b) -> a -> b
$
           String
"From version 1.24 cabal supports specifying explicit dependencies "
        forall a. [a] -> [a] -> [a]
++ String
"for Custom setup scripts. Consider using cabal-version >= 1.24 and "
        forall a. [a] -> [a] -> [a]
++ String
"adding a 'custom-setup' section with a 'setup-depends' field "
        forall a. [a] -> [a] -> [a]
++ String
"that specifies the dependencies of the Setup.hs script itself. "
        forall a. [a] -> [a] -> [a]
++ String
"The 'setup-depends' field uses the same syntax as 'build-depends', "
        forall a. [a] -> [a] -> [a]
++ String
"so a simple example would be 'setup-depends: base, Cabal'."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV2_0
           Bool -> Bool -> Bool
&& forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (PackageDescription -> ModuleName
autogenPathsModuleName PackageDescription
pkg) [ModuleName]
allModuleNames
           Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (PackageDescription -> ModuleName
autogenPathsModuleName PackageDescription
pkg) [ModuleName]
allModuleNamesAutogen) ) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"Packages using 'cabal-version: 2.0' and the autogenerated "
        forall a. [a] -> [a] -> [a]
++ String
"module Paths_* must include it also on the 'autogen-modules' field "
        forall a. [a] -> [a] -> [a]
++ String
"besides 'exposed-modules' and 'other-modules'. This specifies that "
        forall a. [a] -> [a] -> [a]
++ String
"the module does not come with the package and is generated on "
        forall a. [a] -> [a] -> [a]
++ String
"setup. Modules built with a custom Setup.hs script also go here "
        forall a. [a] -> [a] -> [a]
++ String
"to ensure that commands like sdist don't fail."

  ]
  where
    -- Perform a check on packages that use a version of the spec less than
    -- the version given. This is for cases where a new Cabal version adds
    -- a new feature and we want to check that it is not used prior to that
    -- version.
    checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
    checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
ver Bool
cond PackageCheck
pc
      | PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
ver = forall a. Maybe a
Nothing
      | Bool
otherwise              = Bool -> PackageCheck -> Maybe PackageCheck
check Bool
cond PackageCheck
pc

    buildInfoField :: (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> b
field         = forall a b. (a -> b) -> [a] -> [b]
map BuildInfo -> b
field (PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg)

    usesBackpackIncludes :: Bool
usesBackpackIncludes = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildInfo -> [Mixin]
mixins) (PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg)

    mentionedExtensions :: [Extension]
mentionedExtensions = [ Extension
ext | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
                                , Extension
ext <- BuildInfo -> [Extension]
allExtensions BuildInfo
bi ]
    mentionedExtensionsThatNeedCabal12 :: [Extension]
mentionedExtensionsThatNeedCabal12 =
      forall a. Eq a => [a] -> [a]
nub (forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Extension]
compatExtensionsExtra) [Extension]
mentionedExtensions)

    -- As of Cabal-1.4 we can add new extensions without worrying about
    -- breaking old versions of cabal.
    mentionedExtensionsThatNeedCabal14 :: [Extension]
mentionedExtensionsThatNeedCabal14 =
      forall a. Eq a => [a] -> [a]
nub (forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Extension]
compatExtensions) [Extension]
mentionedExtensions)

    -- The known extensions in Cabal-1.2.3
    compatExtensions :: [Extension]
compatExtensions =
      forall a b. (a -> b) -> [a] -> [b]
map KnownExtension -> Extension
EnableExtension
      [ KnownExtension
OverlappingInstances, KnownExtension
UndecidableInstances, KnownExtension
IncoherentInstances
      , KnownExtension
RecursiveDo, KnownExtension
ParallelListComp, KnownExtension
MultiParamTypeClasses
      , KnownExtension
FunctionalDependencies, KnownExtension
Rank2Types
      , KnownExtension
RankNTypes, KnownExtension
PolymorphicComponents, KnownExtension
ExistentialQuantification
      , KnownExtension
ScopedTypeVariables, KnownExtension
ImplicitParams, KnownExtension
FlexibleContexts
      , KnownExtension
FlexibleInstances, KnownExtension
EmptyDataDecls, KnownExtension
CPP, KnownExtension
BangPatterns
      , KnownExtension
TypeSynonymInstances, KnownExtension
TemplateHaskell, KnownExtension
ForeignFunctionInterface
      , KnownExtension
Arrows, KnownExtension
Generics, KnownExtension
NamedFieldPuns, KnownExtension
PatternGuards
      , KnownExtension
GeneralizedNewtypeDeriving, KnownExtension
ExtensibleRecords, KnownExtension
RestrictedTypeSynonyms
      , KnownExtension
HereDocuments] forall a. [a] -> [a] -> [a]
++
      forall a b. (a -> b) -> [a] -> [b]
map KnownExtension -> Extension
DisableExtension
      [KnownExtension
MonomorphismRestriction, KnownExtension
ImplicitPrelude] forall a. [a] -> [a] -> [a]
++
      [Extension]
compatExtensionsExtra

    -- The extra known extensions in Cabal-1.2.3 vs Cabal-1.1.6
    -- (Cabal-1.1.6 came with ghc-6.6. Cabal-1.2 came with ghc-6.8)
    compatExtensionsExtra :: [Extension]
compatExtensionsExtra =
      forall a b. (a -> b) -> [a] -> [b]
map KnownExtension -> Extension
EnableExtension
      [ KnownExtension
KindSignatures, KnownExtension
MagicHash, KnownExtension
TypeFamilies, KnownExtension
StandaloneDeriving
      , KnownExtension
UnicodeSyntax, KnownExtension
PatternSignatures, KnownExtension
UnliftedFFITypes, KnownExtension
LiberalTypeSynonyms
      , KnownExtension
TypeOperators, KnownExtension
RecordWildCards, KnownExtension
RecordPuns, KnownExtension
DisambiguateRecordFields
      , KnownExtension
OverloadedStrings, KnownExtension
GADTs, KnownExtension
RelaxedPolyRec
      , KnownExtension
ExtendedDefaultRules, KnownExtension
UnboxedTuples, KnownExtension
DeriveDataTypeable
      , KnownExtension
ConstrainedClassMethods
      ] forall a. [a] -> [a] -> [a]
++
      forall a b. (a -> b) -> [a] -> [b]
map KnownExtension -> Extension
DisableExtension
      [KnownExtension
MonoPatBinds]

    allModuleNames :: [ModuleName]
allModuleNames =
         (case PackageDescription -> Maybe Library
library PackageDescription
pkg of
           Maybe Library
Nothing -> []
           (Just Library
lib) -> Library -> [ModuleName]
explicitLibModules Library
lib
         )
      forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [ModuleName]
otherModules (PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg)

    allModuleNamesAutogen :: [ModuleName]
allModuleNamesAutogen = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [ModuleName]
autogenModules (PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg)

-- ------------------------------------------------------------
-- * Checks on the GenericPackageDescription
-- ------------------------------------------------------------

-- | Check the build-depends fields for any weirdness or bad practice.
--
checkPackageVersions :: GenericPackageDescription -> [PackageCheck]
checkPackageVersions :: GenericPackageDescription -> [PackageCheck]
checkPackageVersions GenericPackageDescription
pkg =
  forall a. [Maybe a] -> [a]
catMaybes [

    -- Check that the version of base is bounded above.
    -- For example this bans "build-depends: base >= 3".
    -- It should probably be "build-depends: base >= 3 && < 4"
    -- which is the same as  "build-depends: base == 3.*"
    Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (VersionRange -> Bool
boundedAbove VersionRange
baseDependency)) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"The dependency 'build-depends: base' does not specify an upper "
        forall a. [a] -> [a] -> [a]
++ String
"bound on the version number. Each major release of the 'base' "
        forall a. [a] -> [a] -> [a]
++ String
"package changes the API in various ways and most packages will "
        forall a. [a] -> [a] -> [a]
++ String
"need some changes to compile with it. The recommended practice "
        forall a. [a] -> [a] -> [a]
++ String
"is to specify an upper bound on the version of the 'base' "
        forall a. [a] -> [a] -> [a]
++ String
"package. This ensures your package will continue to build when a "
        forall a. [a] -> [a] -> [a]
++ String
"new major version of the 'base' package is released. If you are "
        forall a. [a] -> [a] -> [a]
++ String
"not sure what upper bound to use then use the next  major "
        forall a. [a] -> [a] -> [a]
++ String
"version. For example if you have tested your package with 'base' "
        forall a. [a] -> [a] -> [a]
++ String
"version 4.5 and 4.6 then use 'build-depends: base >= 4.5 && < 4.7'."

  ]
  where
    -- TODO: What we really want to do is test if there exists any
    -- configuration in which the base version is unbounded above.
    -- However that's a bit tricky because there are many possible
    -- configurations. As a cheap easy and safe approximation we will
    -- pick a single "typical" configuration and check if that has an
    -- open upper bound. To get a typical configuration we finalise
    -- using no package index and the current platform.
    finalised :: Either [Dependency] (PackageDescription, FlagAssignment)
finalised = FlagAssignment
-> ComponentRequestedSpec
-> (Dependency -> Bool)
-> Platform
-> CompilerInfo
-> [PackageVersionConstraint]
-> GenericPackageDescription
-> Either [Dependency] (PackageDescription, FlagAssignment)
finalizePD
                              forall a. Monoid a => a
mempty ComponentRequestedSpec
defaultComponentRequestedSpec (forall a b. a -> b -> a
const Bool
True)
                              Platform
buildPlatform
                              (CompilerId -> AbiTag -> CompilerInfo
unknownCompilerInfo
                                (CompilerFlavor -> Version -> CompilerId
CompilerId CompilerFlavor
buildCompilerFlavor Version
nullVersion)
                                AbiTag
NoAbiTag)
                              [] GenericPackageDescription
pkg
    baseDependency :: VersionRange
baseDependency = case Either [Dependency] (PackageDescription, FlagAssignment)
finalised of
      Right (PackageDescription
pkg', FlagAssignment
_) | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [VersionRange]
baseDeps) ->
          forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr VersionRange -> VersionRange -> VersionRange
intersectVersionRanges VersionRange
anyVersion [VersionRange]
baseDeps
        where
          baseDeps :: [VersionRange]
baseDeps =
            [ VersionRange
vr | Dependency PackageName
pname VersionRange
vr NonEmptySet LibraryName
_ <- PackageDescription -> [Dependency]
allBuildDepends PackageDescription
pkg'
                 , PackageName
pname forall a. Eq a => a -> a -> Bool
== String -> PackageName
mkPackageName String
"base" ]

      -- Just in case finalizePD fails for any reason,
      -- or if the package doesn't depend on the base package at all,
      -- then we will just skip the check, since boundedAbove noVersion = True
      Either [Dependency] (PackageDescription, FlagAssignment)
_          -> VersionRange
noVersion

    -- TODO: move to Distribution.Version
    boundedAbove :: VersionRange -> Bool
    boundedAbove :: VersionRange -> Bool
boundedAbove VersionRange
vr = case VersionRange -> [VersionInterval]
asVersionIntervals VersionRange
vr of
      []     -> Bool
True -- this is the inconsistent version range.
      (VersionInterval
x:[VersionInterval]
xs) -> case forall a. NonEmpty a -> a
last (VersionInterval
xforall a. a -> [a] -> NonEmpty a
:|[VersionInterval]
xs) of
        VersionInterval LowerBound
_ UpperBound {} -> Bool
True
        VersionInterval LowerBound
_ UpperBound
NoUpperBound  -> Bool
False


checkConditionals :: GenericPackageDescription -> [PackageCheck]
checkConditionals :: GenericPackageDescription -> [PackageCheck]
checkConditionals GenericPackageDescription
pkg =
  forall a. [Maybe a] -> [a]
catMaybes [

    Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unknownOSs) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"Unknown operating system name "
        forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map ShowS
quote [String]
unknownOSs)

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unknownArches) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"Unknown architecture name "
        forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map ShowS
quote [String]
unknownArches)

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unknownImpls) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"Unknown compiler name "
        forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map ShowS
quote [String]
unknownImpls)
  ]
  where
    unknownOSs :: [String]
unknownOSs    = [ String
os   | OS   (OtherOS String
os)           <- [ConfVar]
conditions ]
    unknownArches :: [String]
unknownArches = [ String
arch | Arch (OtherArch String
arch)       <- [ConfVar]
conditions ]
    unknownImpls :: [String]
unknownImpls  = [ String
impl | Impl (OtherCompiler String
impl) VersionRange
_ <- [ConfVar]
conditions ]
    conditions :: [ConfVar]
conditions = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {b} {c} {a}. CondTree b c a -> [b]
fvs (forall a. Maybe a -> [a]
maybeToList (GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary GenericPackageDescription
pkg))
              forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {b} {c} {a}. CondTree b c a -> [b]
fvs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries GenericPackageDescription
pkg)
              forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {b} {c} {a}. CondTree b c a -> [b]
fvs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
condForeignLibs GenericPackageDescription
pkg)
              forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {b} {c} {a}. CondTree b c a -> [b]
fvs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
condExecutables GenericPackageDescription
pkg)
              forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {b} {c} {a}. CondTree b c a -> [b]
fvs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites GenericPackageDescription
pkg)
              forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {b} {c} {a}. CondTree b c a -> [b]
fvs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks GenericPackageDescription
pkg)
    fvs :: CondTree b c a -> [b]
fvs (CondNode a
_ c
_ [CondBranch b c a]
ifs) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CondBranch b c a -> [b]
compfv [CondBranch b c a]
ifs -- free variables
    compfv :: CondBranch b c a -> [b]
compfv (CondBranch Condition b
c CondTree b c a
ct Maybe (CondTree b c a)
mct) = forall {a}. Condition a -> [a]
condfv Condition b
c forall a. [a] -> [a] -> [a]
++ CondTree b c a -> [b]
fvs CondTree b c a
ct forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] CondTree b c a -> [b]
fvs Maybe (CondTree b c a)
mct
    condfv :: Condition a -> [a]
condfv Condition a
c = case Condition a
c of
      Var a
v      -> [a
v]
      Lit Bool
_      -> []
      CNot Condition a
c1    -> Condition a -> [a]
condfv Condition a
c1
      COr  Condition a
c1 Condition a
c2 -> Condition a -> [a]
condfv Condition a
c1 forall a. [a] -> [a] -> [a]
++ Condition a -> [a]
condfv Condition a
c2
      CAnd Condition a
c1 Condition a
c2 -> Condition a -> [a]
condfv Condition a
c1 forall a. [a] -> [a] -> [a]
++ Condition a -> [a]
condfv Condition a
c2

checkFlagNames :: GenericPackageDescription -> [PackageCheck]
checkFlagNames :: GenericPackageDescription -> [PackageCheck]
checkFlagNames GenericPackageDescription
gpd
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
invalidFlagNames = []
    | Bool
otherwise             = [ String -> PackageCheck
PackageDistInexcusable
        forall a b. (a -> b) -> a -> b
$ String
"Suspicious flag names: " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
invalidFlagNames forall a. [a] -> [a] -> [a]
++ String
". "
        forall a. [a] -> [a] -> [a]
++ String
"To avoid ambiguity in command line interfaces, flag shouldn't "
        forall a. [a] -> [a] -> [a]
++ String
"start with a dash. Also for better compatibility, flag names "
        forall a. [a] -> [a] -> [a]
++ String
"shouldn't contain non-ascii characters."
        ]
  where
    invalidFlagNames :: [String]
invalidFlagNames =
        [ String
fn
        | PackageFlag
flag <- GenericPackageDescription -> [PackageFlag]
genPackageFlags GenericPackageDescription
gpd
        , let fn :: String
fn = FlagName -> String
unFlagName (PackageFlag -> FlagName
flagName PackageFlag
flag)
        , String -> Bool
invalidFlagName String
fn
        ]
    -- starts with dash
    invalidFlagName :: String -> Bool
invalidFlagName (Char
'-':String
_) = Bool
True
    -- mon ascii letter
    invalidFlagName String
cs = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAscii) String
cs

checkUnusedFlags :: GenericPackageDescription -> [PackageCheck]
checkUnusedFlags :: GenericPackageDescription -> [PackageCheck]
checkUnusedFlags GenericPackageDescription
gpd
    | Set FlagName
declared forall a. Eq a => a -> a -> Bool
== Set FlagName
used = []
    | Bool
otherwise        = [ String -> PackageCheck
PackageDistSuspicious
        forall a b. (a -> b) -> a -> b
$ String
"Declared and used flag sets differ: "
        forall a. [a] -> [a] -> [a]
++ Set FlagName -> String
s Set FlagName
declared forall a. [a] -> [a] -> [a]
++ String
" /= " forall a. [a] -> [a] -> [a]
++ Set FlagName -> String
s Set FlagName
used forall a. [a] -> [a] -> [a]
++ String
". "
        ]
  where
    s :: Set.Set FlagName -> String
    s :: Set FlagName -> String
s = [String] -> String
commaSep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map FlagName -> String
unFlagName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toList

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

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

checkUnicodeXFields :: GenericPackageDescription -> [PackageCheck]
checkUnicodeXFields :: GenericPackageDescription -> [PackageCheck]
checkUnicodeXFields GenericPackageDescription
gpd
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
nonAsciiXFields = []
    | Bool
otherwise            = [ String -> PackageCheck
PackageDistInexcusable
        forall a b. (a -> b) -> a -> b
$ String
"Non ascii custom fields: " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
nonAsciiXFields forall a. [a] -> [a] -> [a]
++ String
". "
        forall a. [a] -> [a] -> [a]
++ String
"For better compatibility, custom field names "
        forall a. [a] -> [a] -> [a]
++ String
"shouldn't contain non-ascii characters."
        ]
  where
    nonAsciiXFields :: [String]
    nonAsciiXFields :: [String]
nonAsciiXFields = [ String
n | (String
n, String
_) <- [(String, String)]
xfields, forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAscii) String
n ]

    xfields :: [(String,String)]
    xfields :: [(String, String)]
xfields = forall a. DList a -> [a]
DList.runDList forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
        [ forall a s. Getting (DList a) s a -> s -> DList a
toDListOf (Lens' GenericPackageDescription PackageDescription
L.packageDescription forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PackageDescription [(String, String)]
L.customFieldsPD forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) GenericPackageDescription
gpd
        , forall a s. Getting (DList a) s a -> s -> DList a
toDListOf (forall a. HasBuildInfos a => Traversal' a BuildInfo
L.traverseBuildInfos forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasBuildInfo a => Lens' a [(String, String)]
L.customFieldsBI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) GenericPackageDescription
gpd
        ]

-- | cabal-version <2.2 + Paths_module + default-extensions: doesn't build.
checkPathsModuleExtensions :: PackageDescription -> [PackageCheck]
checkPathsModuleExtensions :: PackageDescription -> [PackageCheck]
checkPathsModuleExtensions PackageDescription
pd
    | PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pd forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV2_2 = []
    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any BuildInfo -> Bool
checkBI (PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pd) Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Library -> Bool
checkLib (PackageDescription -> [Library]
allLibraries PackageDescription
pd)
        = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> PackageCheck
PackageBuildImpossible forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
            [ String
"The package uses RebindableSyntax with OverloadedStrings or OverloadedLists"
            , String
"in default-extensions, and also Paths_ autogen module."
            , String
"That configuration is known to cause compile failures with Cabal < 2.2."
            , String
"To use these default-extensions with Paths_ autogen module"
            , String
"specify at least 'cabal-version: 2.2'."
            ]
    | Bool
otherwise = []
  where
    mn :: ModuleName
mn = PackageDescription -> ModuleName
autogenPathsModuleName PackageDescription
pd

    checkLib :: Library -> Bool
    checkLib :: Library -> Bool
checkLib Library
l = ModuleName
mn forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Library -> [ModuleName]
exposedModules Library
l Bool -> Bool -> Bool
&& forall {t :: * -> *}. Foldable t => t Extension -> Bool
checkExts (Library
l forall s a. s -> Getting a s a -> a
^. forall a. HasBuildInfo a => Lens' a [Extension]
L.defaultExtensions)

    checkBI :: BuildInfo -> Bool
    checkBI :: BuildInfo -> Bool
checkBI BuildInfo
bi =
        (ModuleName
mn forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` BuildInfo -> [ModuleName]
otherModules BuildInfo
bi Bool -> Bool -> Bool
|| ModuleName
mn forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` BuildInfo -> [ModuleName]
autogenModules BuildInfo
bi) Bool -> Bool -> Bool
&&
        forall {t :: * -> *}. Foldable t => t Extension -> Bool
checkExts (BuildInfo
bi forall s a. s -> Getting a s a -> a
^. forall a. HasBuildInfo a => Lens' a [Extension]
L.defaultExtensions)

    checkExts :: t Extension -> Bool
checkExts t Extension
exts = Extension
rebind forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Extension
exts Bool -> Bool -> Bool
&& (Extension
strings forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Extension
exts Bool -> Bool -> Bool
|| Extension
lists forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Extension
exts)
      where
        rebind :: Extension
rebind  = KnownExtension -> Extension
EnableExtension KnownExtension
RebindableSyntax
        strings :: Extension
strings = KnownExtension -> Extension
EnableExtension KnownExtension
OverloadedStrings
        lists :: Extension
lists   = KnownExtension -> Extension
EnableExtension KnownExtension
OverloadedLists

-- | Checks GHC options from all ghc-*-options fields from the given BuildInfo
-- and reports flags that are OK during development process, but are
-- unacceptable in a distrubuted package
checkDevelopmentOnlyFlagsBuildInfo :: BuildInfo -> [PackageCheck]
checkDevelopmentOnlyFlagsBuildInfo :: BuildInfo -> [PackageCheck]
checkDevelopmentOnlyFlagsBuildInfo BuildInfo
bi =
    String -> [String] -> [PackageCheck]
checkDevelopmentOnlyFlagsOptions String
"ghc-options" (CompilerFlavor -> BuildInfo -> [String]
hcOptions CompilerFlavor
GHC BuildInfo
bi)
 forall a. [a] -> [a] -> [a]
++ String -> [String] -> [PackageCheck]
checkDevelopmentOnlyFlagsOptions String
"ghc-prof-options" (CompilerFlavor -> BuildInfo -> [String]
hcProfOptions CompilerFlavor
GHC BuildInfo
bi)
 forall a. [a] -> [a] -> [a]
++ String -> [String] -> [PackageCheck]
checkDevelopmentOnlyFlagsOptions String
"ghc-shared-options" (CompilerFlavor -> BuildInfo -> [String]
hcSharedOptions CompilerFlavor
GHC BuildInfo
bi)

-- | Checks the given list of flags belonging to the given field and reports
-- flags that are OK during development process, but are unacceptable in a
-- distributed package
checkDevelopmentOnlyFlagsOptions :: String -> [String] -> [PackageCheck]
checkDevelopmentOnlyFlagsOptions :: String -> [String] -> [PackageCheck]
checkDevelopmentOnlyFlagsOptions String
fieldName [String]
ghcOptions =
  forall a. [Maybe a] -> [a]
catMaybes [

    Bool -> PackageCheck -> Maybe PackageCheck
check Bool
has_WerrorWall forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -Wall -Werror' makes the package very easy to "
        forall a. [a] -> [a] -> [a]
++ String
"break with future GHC versions because new GHC versions often "
        forall a. [a] -> [a] -> [a]
++ String
"add new warnings. Use just '" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -Wall' instead."
        forall a. [a] -> [a] -> [a]
++ String
extraExplanation

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not Bool
has_WerrorWall Bool -> Bool -> Bool
&& Bool
has_Werror) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -Werror' makes the package easy to "
        forall a. [a] -> [a] -> [a]
++ String
"break with future GHC versions because new GHC versions often "
        forall a. [a] -> [a] -> [a]
++ String
"add new warnings. "
        forall a. [a] -> [a] -> [a]
++ String
extraExplanation

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool
has_J) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -j[N]' can make sense for specific user's setup,"
        forall a. [a] -> [a] -> [a]
++ String
" but it is not appropriate for a distributed package."
        forall a. [a] -> [a] -> [a]
++ String
extraExplanation

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-fdefer-type-errors"] forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -fdefer-type-errors' is fine during development but "
        forall a. [a] -> [a] -> [a]
++ String
"is not appropriate for a distributed package. "
        forall a. [a] -> [a] -> [a]
++ String
extraExplanation

    -- -dynamic is not a debug flag
  , Bool -> PackageCheck -> Maybe PackageCheck
check (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\String
opt -> String
"-d" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
opt Bool -> Bool -> Bool
&& String
opt forall a. Eq a => a -> a -> Bool
/= String
"-dynamic")
           [String]
ghcOptions) forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
           String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -d*' debug flags are not appropriate "
        forall a. [a] -> [a] -> [a]
++ String
"for a distributed package. "
        forall a. [a] -> [a] -> [a]
++ String
extraExplanation

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-fprof-auto", String
"-fprof-auto-top", String
"-fprof-auto-calls",
               String
"-fprof-cafs", String
"-fno-prof-count-entries",
               String
"-auto-all", String
"-auto", String
"-caf-all"] forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious forall a b. (a -> b) -> a -> b
$
           String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -fprof*' profiling flags are typically not "
        forall a. [a] -> [a] -> [a]
++ String
"appropriate for a distributed library package. These flags are "
        forall a. [a] -> [a] -> [a]
++ String
"useful to profile this package, but when profiling other packages "
        forall a. [a] -> [a] -> [a]
++ String
"that use this one these flags clutter the profile output with "
        forall a. [a] -> [a] -> [a]
++ String
"excessive detail. If you think other packages really want to see "
        forall a. [a] -> [a] -> [a]
++ String
"cost centres from this package then use '-fprof-auto-exported' "
        forall a. [a] -> [a] -> [a]
++ String
"which puts cost centres only on exported functions. "
        forall a. [a] -> [a] -> [a]
++ String
extraExplanation
  ]
  where
    extraExplanation :: String
extraExplanation =
         String
" Alternatively, if you want to use this, make it conditional based "
      forall a. [a] -> [a] -> [a]
++ String
"on a Cabal configuration flag (with 'manual: True' and 'default: "
      forall a. [a] -> [a] -> [a]
++ String
"False') and enable that flag during development."

    has_WerrorWall :: Bool
has_WerrorWall   = Bool
has_Werror Bool -> Bool -> Bool
&& ( Bool
has_Wall Bool -> Bool -> Bool
|| Bool
has_W )
    has_Werror :: Bool
has_Werror       = String
"-Werror" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ghcOptions
    has_Wall :: Bool
has_Wall         = String
"-Wall"   forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ghcOptions
    has_W :: Bool
has_W            = String
"-W"      forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ghcOptions
    has_J :: Bool
has_J            = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
                         (\String
o -> case String
o of
                           String
"-j"                -> Bool
True
                           (Char
'-' : Char
'j' : Char
d : String
_) -> Char -> Bool
isDigit Char
d
                           String
_                   -> Bool
False
                         )
                         [String]
ghcOptions
    checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
    checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String]
flags = Bool -> PackageCheck -> Maybe PackageCheck
check (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
flags) [String]
ghcOptions)

checkDevelopmentOnlyFlags :: GenericPackageDescription -> [PackageCheck]
checkDevelopmentOnlyFlags :: GenericPackageDescription -> [PackageCheck]
checkDevelopmentOnlyFlags GenericPackageDescription
pkg =
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [PackageCheck]
checkDevelopmentOnlyFlagsBuildInfo
              [ BuildInfo
bi
              | ([Condition ConfVar]
conditions, BuildInfo
bi) <- [([Condition ConfVar], BuildInfo)]
allConditionalBuildInfo
              , Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Condition ConfVar -> Bool
guardedByManualFlag [Condition ConfVar]
conditions) ]
  where
    guardedByManualFlag :: Condition ConfVar -> Bool
guardedByManualFlag = Condition ConfVar -> Bool
definitelyFalse

    -- We've basically got three-values logic here: True, False or unknown
    -- hence this pattern to propagate the unknown cases properly.
    definitelyFalse :: Condition ConfVar -> Bool
definitelyFalse (Var (PackageFlag FlagName
n)) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Bool -> Bool
not (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FlagName
n Map FlagName Bool
manualFlags)
    definitelyFalse (Var ConfVar
_)        = Bool
False
    definitelyFalse (Lit  Bool
b)       = Bool -> Bool
not Bool
b
    definitelyFalse (CNot Condition ConfVar
c)       = Condition ConfVar -> Bool
definitelyTrue Condition ConfVar
c
    definitelyFalse (COr  Condition ConfVar
c1 Condition ConfVar
c2)   = Condition ConfVar -> Bool
definitelyFalse Condition ConfVar
c1 Bool -> Bool -> Bool
&& Condition ConfVar -> Bool
definitelyFalse Condition ConfVar
c2
    definitelyFalse (CAnd Condition ConfVar
c1 Condition ConfVar
c2)   = Condition ConfVar -> Bool
definitelyFalse Condition ConfVar
c1 Bool -> Bool -> Bool
|| Condition ConfVar -> Bool
definitelyFalse Condition ConfVar
c2

    definitelyTrue :: Condition ConfVar -> Bool
definitelyTrue (Var (PackageFlag FlagName
n)) = forall a. a -> Maybe a -> a
fromMaybe Bool
False (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FlagName
n Map FlagName Bool
manualFlags)
    definitelyTrue (Var ConfVar
_)        = Bool
False
    definitelyTrue (Lit  Bool
b)       = Bool
b
    definitelyTrue (CNot Condition ConfVar
c)       = Condition ConfVar -> Bool
definitelyFalse Condition ConfVar
c
    definitelyTrue (COr  Condition ConfVar
c1 Condition ConfVar
c2)   = Condition ConfVar -> Bool
definitelyTrue Condition ConfVar
c1 Bool -> Bool -> Bool
|| Condition ConfVar -> Bool
definitelyTrue Condition ConfVar
c2
    definitelyTrue (CAnd Condition ConfVar
c1 Condition ConfVar
c2)   = Condition ConfVar -> Bool
definitelyTrue Condition ConfVar
c1 Bool -> Bool -> Bool
&& Condition ConfVar -> Bool
definitelyTrue Condition ConfVar
c2

    manualFlags :: Map FlagName Bool
manualFlags = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                    [ (PackageFlag -> FlagName
flagName PackageFlag
flag, PackageFlag -> Bool
flagDefault PackageFlag
flag)
                    | PackageFlag
flag <- GenericPackageDescription -> [PackageFlag]
genPackageFlags GenericPackageDescription
pkg
                    , PackageFlag -> Bool
flagManual PackageFlag
flag ]

    allConditionalBuildInfo :: [([Condition ConfVar], BuildInfo)]
    allConditionalBuildInfo :: [([Condition ConfVar], BuildInfo)]
allConditionalBuildInfo =
        forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b v c. (a -> b) -> CondTree v c a -> [([Condition v], b)]
collectCondTreePaths Library -> BuildInfo
libBuildInfo)
                  (forall a. Maybe a -> [a]
maybeToList (GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary GenericPackageDescription
pkg))

     forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b v c. (a -> b) -> CondTree v c a -> [([Condition v], b)]
collectCondTreePaths Library -> BuildInfo
libBuildInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
                  (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries GenericPackageDescription
pkg)

     forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b v c. (a -> b) -> CondTree v c a -> [([Condition v], b)]
collectCondTreePaths Executable -> BuildInfo
buildInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
                  (GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
condExecutables GenericPackageDescription
pkg)

     forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b v c. (a -> b) -> CondTree v c a -> [([Condition v], b)]
collectCondTreePaths TestSuite -> BuildInfo
testBuildInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
                  (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites GenericPackageDescription
pkg)

     forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b v c. (a -> b) -> CondTree v c a -> [([Condition v], b)]
collectCondTreePaths Benchmark -> BuildInfo
benchmarkBuildInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
                  (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks GenericPackageDescription
pkg)

    -- get all the leaf BuildInfo, paired up with the path (in the tree sense)
    -- of if-conditions that guard it
    collectCondTreePaths :: (a -> b)
                         -> CondTree v c a
                         -> [([Condition v], b)]
    collectCondTreePaths :: forall a b v c. (a -> b) -> CondTree v c a -> [([Condition v], b)]
collectCondTreePaths a -> b
mapData = forall {v} {c}.
[Condition v] -> CondTree v c a -> [([Condition v], b)]
go []
      where
        go :: [Condition v] -> CondTree v c a -> [([Condition v], b)]
go [Condition v]
conditions CondTree v c a
condNode =
            -- the data at this level in the tree:
            (forall a. [a] -> [a]
reverse [Condition v]
conditions, a -> b
mapData (forall v c a. CondTree v c a -> a
condTreeData CondTree v c a
condNode))

          forall a. a -> [a] -> [a]
: forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [Condition v] -> CondTree v c a -> [([Condition v], b)]
go (Condition v
conditionforall a. a -> [a] -> [a]
:[Condition v]
conditions) CondTree v c a
ifThen
            | (CondBranch Condition v
condition CondTree v c a
ifThen Maybe (CondTree v c a)
_) <- forall v c a. CondTree v c a -> [CondBranch v c a]
condTreeComponents CondTree v c a
condNode ]

         forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [Condition v] -> CondTree v c a -> [([Condition v], b)]
go (Condition v
conditionforall a. a -> [a] -> [a]
:[Condition v]
conditions) CondTree v c a
elseThen
            | (CondBranch Condition v
condition CondTree v c a
_ (Just CondTree v c a
elseThen)) <- forall v c a. CondTree v c a -> [CondBranch v c a]
condTreeComponents CondTree v c a
condNode ]


-- ------------------------------------------------------------
-- * Checks involving files in the package
-- ------------------------------------------------------------

-- | Sanity check things that requires IO. It looks at the files in the
-- package and expects to find the package unpacked in at the given file path.
--
checkPackageFiles :: Verbosity -> PackageDescription -> FilePath -> IO [PackageCheck]
checkPackageFiles :: Verbosity -> PackageDescription -> String -> IO [PackageCheck]
checkPackageFiles Verbosity
verbosity PackageDescription
pkg String
root = do
  [PackageCheck]
contentChecks <- forall (m :: * -> *).
(Monad m, Applicative m) =>
CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
checkPackageContent CheckPackageContentOps IO
checkFilesIO PackageDescription
pkg
  [PackageCheck]
preDistributionChecks <- Verbosity -> PackageDescription -> String -> IO [PackageCheck]
checkPackageFilesPreDistribution Verbosity
verbosity PackageDescription
pkg String
root
  -- Sort because different platforms will provide files from
  -- `getDirectoryContents` in different orders, and we'd like to be
  -- stable for test output.
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Ord a => [a] -> [a]
sort [PackageCheck]
contentChecks forall a. [a] -> [a] -> [a]
++ forall a. Ord a => [a] -> [a]
sort [PackageCheck]
preDistributionChecks)
  where
    checkFilesIO :: CheckPackageContentOps IO
checkFilesIO = CheckPackageContentOps {
      doesFileExist :: String -> IO Bool
doesFileExist        = String -> IO Bool
System.doesFileExist                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
relative,
      doesDirectoryExist :: String -> IO Bool
doesDirectoryExist   = String -> IO Bool
System.doesDirectoryExist             forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
relative,
      getDirectoryContents :: String -> IO [String]
getDirectoryContents = String -> IO [String]
System.Directory.getDirectoryContents forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
relative,
      getFileContents :: String -> IO ByteString
getFileContents      = String -> IO ByteString
BS.readFile                           forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
relative
    }
    relative :: ShowS
relative String
path = String
root String -> ShowS
</> String
path

-- | A record of operations needed to check the contents of packages.
-- Used by 'checkPackageContent'.
--
data CheckPackageContentOps m = CheckPackageContentOps {
    forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesFileExist        :: FilePath -> m Bool,
    forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesDirectoryExist   :: FilePath -> m Bool,
    forall (m :: * -> *).
CheckPackageContentOps m -> String -> m [String]
getDirectoryContents :: FilePath -> m [FilePath],
    forall (m :: * -> *).
CheckPackageContentOps m -> String -> m ByteString
getFileContents      :: FilePath -> m BS.ByteString
  }

-- | 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, Applicative m)
                    => CheckPackageContentOps m
                    -> PackageDescription
                    -> m [PackageCheck]
checkPackageContent :: forall (m :: * -> *).
(Monad m, Applicative m) =>
CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
checkPackageContent CheckPackageContentOps m
ops PackageDescription
pkg = do
  Maybe PackageCheck
cabalBomError   <- forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m -> m (Maybe PackageCheck)
checkCabalFileBOM    CheckPackageContentOps m
ops
  Maybe PackageCheck
cabalNameError  <- forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m
-> PackageDescription -> m (Maybe PackageCheck)
checkCabalFileName   CheckPackageContentOps m
ops PackageDescription
pkg
  [PackageCheck]
licenseErrors   <- forall (m :: * -> *).
(Monad m, Applicative m) =>
CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
checkLicensesExist   CheckPackageContentOps m
ops PackageDescription
pkg
  Maybe PackageCheck
setupError      <- forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m
-> PackageDescription -> m (Maybe PackageCheck)
checkSetupExists     CheckPackageContentOps m
ops PackageDescription
pkg
  Maybe PackageCheck
configureError  <- forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m
-> PackageDescription -> m (Maybe PackageCheck)
checkConfigureExists CheckPackageContentOps m
ops PackageDescription
pkg
  [PackageCheck]
localPathErrors <- forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
checkLocalPathsExist CheckPackageContentOps m
ops PackageDescription
pkg
  [PackageCheck]
vcsLocation     <- forall (m :: * -> *).
(Monad m, Applicative m) =>
CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
checkMissingVcsInfo  CheckPackageContentOps m
ops PackageDescription
pkg

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [PackageCheck]
licenseErrors
        forall a. [a] -> [a] -> [a]
++ forall a. [Maybe a] -> [a]
catMaybes [Maybe PackageCheck
cabalBomError, Maybe PackageCheck
cabalNameError, Maybe PackageCheck
setupError, Maybe PackageCheck
configureError]
        forall a. [a] -> [a] -> [a]
++ [PackageCheck]
localPathErrors
        forall a. [a] -> [a] -> [a]
++ [PackageCheck]
vcsLocation

checkCabalFileBOM :: Monad m => CheckPackageContentOps m
                  -> m (Maybe PackageCheck)
checkCabalFileBOM :: forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m -> m (Maybe PackageCheck)
checkCabalFileBOM CheckPackageContentOps m
ops = do
  Either PackageCheck String
epdfile <- forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m -> m (Either PackageCheck String)
findPackageDesc CheckPackageContentOps m
ops
  case Either PackageCheck String
epdfile of
    -- MASSIVE HACK.  If the Cabal file doesn't exist, that is
    -- a very strange situation to be in, because the driver code
    -- in 'Distribution.Setup' ought to have noticed already!
    -- But this can be an issue, see #3552 and also when
    -- --cabal-file is specified.  So if you can't find the file,
    -- just don't bother with this check.
    Left PackageCheck
_       -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Maybe a
Nothing
    Right String
pdfile -> (forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> PackageCheck -> Maybe PackageCheck
check PackageCheck
pc forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Bool
BS.isPrefixOf ByteString
bomUtf8)
                    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (forall (m :: * -> *).
CheckPackageContentOps m -> String -> m ByteString
getFileContents CheckPackageContentOps m
ops String
pdfile)
      where pc :: PackageCheck
pc = String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
                 String
pdfile forall a. [a] -> [a] -> [a]
++ String
" starts with an Unicode byte order mark (BOM)."
                 forall a. [a] -> [a] -> [a]
++ String
" This may cause problems with older cabal versions."

  where
    bomUtf8 :: BS.ByteString
    bomUtf8 :: ByteString
bomUtf8 = [Word8] -> ByteString
BS.pack [Word8
0xef,Word8
0xbb,Word8
0xbf] -- U+FEFF encoded as UTF8

checkCabalFileName :: Monad m => CheckPackageContentOps m
                 -> PackageDescription
                 -> m (Maybe PackageCheck)
checkCabalFileName :: forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m
-> PackageDescription -> m (Maybe PackageCheck)
checkCabalFileName CheckPackageContentOps m
ops PackageDescription
pkg = do
  -- findPackageDesc already takes care to detect missing/multiple
  -- .cabal files; we don't include this check in 'findPackageDesc' in
  -- order not to short-cut other checks which call 'findPackageDesc'
  Either PackageCheck String
epdfile <- forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m -> m (Either PackageCheck String)
findPackageDesc CheckPackageContentOps m
ops
  case Either PackageCheck String
epdfile of
    -- see "MASSIVE HACK" note in 'checkCabalFileBOM'
    Left PackageCheck
_       -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    Right String
pdfile
      | ShowS
takeFileName String
pdfile forall a. Eq a => a -> a -> Bool
== String
expectedCabalname -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      | Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
                 String
"The filename " forall a. [a] -> [a] -> [a]
++ String
pdfile forall a. [a] -> [a] -> [a]
++ String
" does not match package name " forall a. [a] -> [a] -> [a]
++
                 String
"(expected: " forall a. [a] -> [a] -> [a]
++ String
expectedCabalname forall a. [a] -> [a] -> [a]
++ String
")"
  where
    pkgname :: String
pkgname = PackageName -> String
unPackageName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pkg. Package pkg => pkg -> PackageName
packageName forall a b. (a -> b) -> a -> b
$ PackageDescription
pkg
    expectedCabalname :: String
expectedCabalname = String
pkgname String -> ShowS
<.> String
"cabal"


-- |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 (Either PackageCheck FilePath) -- ^<pkgname>.cabal
findPackageDesc :: forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m -> m (Either PackageCheck String)
findPackageDesc CheckPackageContentOps m
ops
 = do let dir :: String
dir = String
"."
      [String]
files <- forall (m :: * -> *).
CheckPackageContentOps m -> String -> m [String]
getDirectoryContents CheckPackageContentOps m
ops String
dir
      -- to make sure we do not mistake a ~/.cabal/ dir for a <pkgname>.cabal
      -- file we filter to exclude dirs and null base file names:
      [String]
cabalFiles <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesFileExist CheckPackageContentOps m
ops)
                       [ String
dir String -> ShowS
</> String
file
                       | String
file <- [String]
files
                       , let (String
name, String
ext) = String -> (String, String)
splitExtension String
file
                       , Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
name) Bool -> Bool -> Bool
&& String
ext forall a. Eq a => a -> a -> Bool
== String
".cabal" ]
      case [String]
cabalFiles of
        []          -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> PackageCheck
PackageBuildImpossible String
noDesc)
        [String
cabalFile] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right String
cabalFile)
        [String]
multiple    -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> PackageCheck
PackageBuildImpossible
                               forall a b. (a -> b) -> a -> b
$ [String] -> String
multiDesc [String]
multiple)

  where
    noDesc :: String
    noDesc :: String
noDesc = String
"No cabal file found.\n"
             forall a. [a] -> [a] -> [a]
++ String
"Please create a package description file <pkgname>.cabal"

    multiDesc :: [String] -> String
    multiDesc :: [String] -> String
multiDesc [String]
l = String
"Multiple cabal files found while checking.\n"
                  forall a. [a] -> [a] -> [a]
++ String
"Please use only one of: "
                  forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
l

checkLicensesExist :: (Monad m, Applicative m)
                   => CheckPackageContentOps m
                   -> PackageDescription
                   -> m [PackageCheck]
checkLicensesExist :: forall (m :: * -> *).
(Monad m, Applicative m) =>
CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
checkLicensesExist CheckPackageContentOps m
ops PackageDescription
pkg = do
    [Bool]
exists <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesFileExist CheckPackageContentOps m
ops forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall from to. SymbolicPath from to -> String
getSymbolicPath) (PackageDescription -> [SymbolicPath PackageDir LicenseFile]
licenseFiles PackageDescription
pkg)
    forall (m :: * -> *) a. Monad m => a -> m a
return
      [ String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
           String
"The '" forall a. [a] -> [a] -> [a]
++ String
fieldname forall a. [a] -> [a] -> [a]
++ String
"' field refers to the file "
        forall a. [a] -> [a] -> [a]
++ ShowS
quote (forall from to. SymbolicPath from to -> String
getSymbolicPath SymbolicPath PackageDir LicenseFile
file) forall a. [a] -> [a] -> [a]
++ String
" which does not exist."
      | (SymbolicPath PackageDir LicenseFile
file, Bool
False) <- forall a b. [a] -> [b] -> [(a, b)]
zip (PackageDescription -> [SymbolicPath PackageDir LicenseFile]
licenseFiles PackageDescription
pkg) [Bool]
exists ]
  where
    fieldname :: String
fieldname | forall (t :: * -> *) a. Foldable t => t a -> Int
length (PackageDescription -> [SymbolicPath PackageDir LicenseFile]
licenseFiles PackageDescription
pkg) forall a. Eq a => a -> a -> Bool
== Int
1 = String
"license-file"
              | Bool
otherwise                      = String
"license-files"

checkSetupExists :: Monad m => CheckPackageContentOps m
                 -> PackageDescription
                 -> m (Maybe PackageCheck)
checkSetupExists :: forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m
-> PackageDescription -> m (Maybe PackageCheck)
checkSetupExists CheckPackageContentOps m
ops PackageDescription
pkg = do
  let simpleBuild :: Bool
simpleBuild = PackageDescription -> BuildType
buildType PackageDescription
pkg forall a. Eq a => a -> a -> Bool
== BuildType
Simple
  Bool
hsexists  <- forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesFileExist CheckPackageContentOps m
ops String
"Setup.hs"
  Bool
lhsexists <- forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesFileExist CheckPackageContentOps m
ops String
"Setup.lhs"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not Bool
simpleBuild Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hsexists Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
lhsexists) forall a b. (a -> b) -> a -> b
$
    String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
      String
"The package is missing a Setup.hs or Setup.lhs script."

checkConfigureExists :: Monad m => CheckPackageContentOps m
                     -> PackageDescription
                     -> m (Maybe PackageCheck)
checkConfigureExists :: forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m
-> PackageDescription -> m (Maybe PackageCheck)
checkConfigureExists CheckPackageContentOps m
ops PackageDescription
pd
  | PackageDescription -> BuildType
buildType PackageDescription
pd forall a. Eq a => a -> a -> Bool
== BuildType
Configure = do
      Bool
exists <- forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesFileExist CheckPackageContentOps m
ops String
"configure"
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not Bool
exists) forall a b. (a -> b) -> a -> b
$
        String -> PackageCheck
PackageBuildWarning forall a b. (a -> b) -> a -> b
$
          String
"The 'build-type' is 'Configure' but there is no 'configure' script. "
          forall a. [a] -> [a] -> [a]
++ String
"You probably need to run 'autoreconf -i' to generate it."
  | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

checkLocalPathsExist :: Monad m => CheckPackageContentOps m
                     -> PackageDescription
                     -> m [PackageCheck]
checkLocalPathsExist :: forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
checkLocalPathsExist CheckPackageContentOps m
ops PackageDescription
pkg = do
  let dirs :: [(String, String)]
dirs = [ (String
dir, String
kind)
             | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
             , (String
dir, String
kind) <-
                  [ (String
dir, String
"extra-lib-dirs") | String
dir <- BuildInfo -> [String]
extraLibDirs BuildInfo
bi ]
               forall a. [a] -> [a] -> [a]
++ [ (String
dir, String
"extra-framework-dirs")
                  | String
dir <- BuildInfo -> [String]
extraFrameworkDirs  BuildInfo
bi ]
               forall a. [a] -> [a] -> [a]
++ [ (String
dir, String
"include-dirs")   | String
dir <- BuildInfo -> [String]
includeDirs  BuildInfo
bi ]
               forall a. [a] -> [a] -> [a]
++ [ (forall from to. SymbolicPath from to -> String
getSymbolicPath SymbolicPath PackageDir SourceDir
dir, String
"hs-source-dirs") | SymbolicPath PackageDir SourceDir
dir <- BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi ]
             , String -> Bool
isRelativeOnAnyPlatform String
dir ]
  [(String, String)]
missing <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesDirectoryExist CheckPackageContentOps m
ops forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(String, String)]
dirs
  forall (m :: * -> *) a. Monad m => a -> m a
return [ PackageBuildWarning {
             explanation :: String
explanation = ShowS
quote (String
kind forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
dir)
                        forall a. [a] -> [a] -> [a]
++ String
" directory does not exist."
           }
         | (String
dir, String
kind) <- [(String, String)]
missing ]

checkMissingVcsInfo :: (Monad m, Applicative m)
                    => CheckPackageContentOps m
                    -> PackageDescription
                    -> m [PackageCheck]
checkMissingVcsInfo :: forall (m :: * -> *).
(Monad m, Applicative m) =>
CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
checkMissingVcsInfo CheckPackageContentOps m
ops PackageDescription
pkg | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageDescription -> [SourceRepo]
sourceRepos PackageDescription
pkg) = do
    Bool
vcsInUse <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (t :: * -> *). Foldable t => t Bool -> Bool
or forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesDirectoryExist CheckPackageContentOps m
ops) [String]
repoDirnames
    if Bool
vcsInUse
      then forall (m :: * -> *) a. Monad m => a -> m a
return [ String -> PackageCheck
PackageDistSuspicious String
message ]
      else forall (m :: * -> *) a. Monad m => a -> m a
return []
  where
    repoDirnames :: [String]
repoDirnames = [ String
dirname | KnownRepoType
repo    <- [KnownRepoType]
knownRepoTypes
                             , String
dirname <- KnownRepoType -> [String]
repoTypeDirname KnownRepoType
repo]
    message :: String
message  = String
"When distributing packages it is encouraged to specify source "
            forall a. [a] -> [a] -> [a]
++ String
"control information in the .cabal file using one or more "
            forall a. [a] -> [a] -> [a]
++ String
"'source-repository' sections. See the Cabal user guide for "
            forall a. [a] -> [a] -> [a]
++ String
"details."

checkMissingVcsInfo CheckPackageContentOps m
_ PackageDescription
_ = forall (m :: * -> *) a. Monad m => a -> m a
return []

repoTypeDirname :: KnownRepoType -> [FilePath]
repoTypeDirname :: KnownRepoType -> [String]
repoTypeDirname KnownRepoType
Darcs     = [String
"_darcs"]
repoTypeDirname KnownRepoType
Git       = [String
".git"]
repoTypeDirname KnownRepoType
SVN       = [String
".svn"]
repoTypeDirname KnownRepoType
CVS       = [String
"CVS"]
repoTypeDirname KnownRepoType
Mercurial = [String
".hg"]
repoTypeDirname KnownRepoType
GnuArch   = [String
".arch-params"]
repoTypeDirname KnownRepoType
Bazaar    = [String
".bzr"]
repoTypeDirname KnownRepoType
Monotone  = [String
"_MTN"]
repoTypeDirname KnownRepoType
Pijul     = [String
".pijul"]

-- ------------------------------------------------------------
-- * Checks involving files in the package
-- ------------------------------------------------------------

-- | Check the names of all files in a package for portability problems. This
-- should be done for example when creating or validating a package tarball.
--
checkPackageFileNames :: [FilePath] -> [PackageCheck]
checkPackageFileNames :: [String] -> [PackageCheck]
checkPackageFileNames [String]
files =
     (forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe PackageCheck
checkWindowsPath forall a b. (a -> b) -> a -> b
$ [String]
files)
  forall a. [a] -> [a] -> [a]
++ (forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe PackageCheck
checkTarPath     forall a b. (a -> b) -> a -> b
$ [String]
files)
      -- If we get any of these checks triggering then we're likely to get
      -- many, and that's probably not helpful, so return at most one.

checkWindowsPath :: FilePath -> Maybe PackageCheck
checkWindowsPath :: String -> Maybe PackageCheck
checkWindowsPath String
path =
  Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ String -> Bool
FilePath.Windows.isValid String
path') forall a b. (a -> b) -> a -> b
$
    String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
         String
"Unfortunately, the file " forall a. [a] -> [a] -> [a]
++ ShowS
quote String
path forall a. [a] -> [a] -> [a]
++ String
" is not a valid file "
      forall a. [a] -> [a] -> [a]
++ String
"name on Windows which would cause portability problems for this "
      forall a. [a] -> [a] -> [a]
++ String
"package. Windows file names cannot contain any of the characters "
      forall a. [a] -> [a] -> [a]
++ String
"\":*?<>|\" and there are a few reserved names including \"aux\", "
      forall a. [a] -> [a] -> [a]
++ String
"\"nul\", \"con\", \"prn\", \"com1-9\", \"lpt1-9\" and \"clock$\"."
  where
    path' :: String
path' = String
".\\" forall a. [a] -> [a] -> [a]
++ String
path
    -- force a relative name to catch invalid file names like "f:oo" which
    -- otherwise parse as file "oo" in the current directory on the 'f' drive.

-- | Check a file name is valid for the portable POSIX tar format.
--
-- The POSIX tar format has a restriction on the length of file names. It is
-- unfortunately not a simple restriction like a maximum length. The exact
-- restriction is that either the whole path be 100 characters or less, or it
-- be possible to split the path on a directory separator such that the first
-- part is 155 characters or less and the second part 100 characters or less.
--
checkTarPath :: FilePath -> Maybe PackageCheck
checkTarPath :: String -> Maybe PackageCheck
checkTarPath String
path
  | forall (t :: * -> *) a. Foldable t => t a -> Int
length String
path forall a. Ord a => a -> a -> Bool
> Int
255   = forall a. a -> Maybe a
Just PackageCheck
longPath
  | Bool
otherwise = case forall {t :: * -> *} {a}.
Foldable t =>
Int -> [t a] -> Either PackageCheck [t a]
pack Int
nameMax (forall a. [a] -> [a]
reverse (String -> [String]
splitPath String
path)) of
    Left PackageCheck
err           -> forall a. a -> Maybe a
Just PackageCheck
err
    Right []           -> forall a. Maybe a
Nothing
    Right (String
h:[String]
rest) -> case forall {t :: * -> *} {a}.
Foldable t =>
Int -> [t a] -> Either PackageCheck [t a]
pack Int
prefixMax [String]
remainder of
      Left PackageCheck
err         -> forall a. a -> Maybe a
Just PackageCheck
err
      Right []         -> forall a. Maybe a
Nothing
      Right (String
_:[String]
_)      -> forall a. a -> Maybe a
Just PackageCheck
noSplit
     where
        -- drop the '/' between the name and prefix:
        remainder :: [String]
remainder = forall a. [a] -> [a]
safeInit String
h forall a. a -> [a] -> [a]
: [String]
rest

  where
    nameMax, prefixMax :: Int
    nameMax :: Int
nameMax   = Int
100
    prefixMax :: Int
prefixMax = Int
155

    pack :: Int -> [t a] -> Either PackageCheck [t a]
pack Int
_   []     = forall a b. a -> Either a b
Left PackageCheck
emptyName
    pack Int
maxLen (t a
c:[t a]
cs)
      | Int
n forall a. Ord a => a -> a -> Bool
> Int
maxLen  = forall a b. a -> Either a b
Left PackageCheck
longName
      | Bool
otherwise   = forall a b. b -> Either a b
Right (forall {t :: * -> *} {a}.
Foldable t =>
Int -> Int -> [t a] -> [t a]
pack' Int
maxLen Int
n [t a]
cs)
      where n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
c

    pack' :: Int -> Int -> [t a] -> [t a]
pack' Int
maxLen Int
n (t a
c:[t a]
cs)
      | Int
n' forall a. Ord a => a -> a -> Bool
<= Int
maxLen = Int -> Int -> [t a] -> [t a]
pack' Int
maxLen Int
n' [t a]
cs
      where n' :: Int
n' = Int
n forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
c
    pack' Int
_     Int
_ [t a]
cs = [t a]
cs

    longPath :: PackageCheck
longPath = String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
         String
"The following file name is too long to store in a portable POSIX "
      forall a. [a] -> [a] -> [a]
++ String
"format tar archive. The maximum length is 255 ASCII characters.\n"
      forall a. [a] -> [a] -> [a]
++ String
"The file in question is:\n  " forall a. [a] -> [a] -> [a]
++ String
path
    longName :: PackageCheck
longName = String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
         String
"The following file name is too long to store in a portable POSIX "
      forall a. [a] -> [a] -> [a]
++ String
"format tar archive. The maximum length for the name part (including "
      forall a. [a] -> [a] -> [a]
++ String
"extension) is 100 ASCII characters. The maximum length for any "
      forall a. [a] -> [a] -> [a]
++ String
"individual directory component is 155.\n"
      forall a. [a] -> [a] -> [a]
++ String
"The file in question is:\n  " forall a. [a] -> [a] -> [a]
++ String
path
    noSplit :: PackageCheck
noSplit = String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
         String
"The following file name is too long to store in a portable POSIX "
      forall a. [a] -> [a] -> [a]
++ String
"format tar archive. While the total length is less than 255 ASCII "
      forall a. [a] -> [a] -> [a]
++ String
"characters, there are unfortunately further restrictions. It has to "
      forall a. [a] -> [a] -> [a]
++ String
"be possible to split the file path on a directory separator into "
      forall a. [a] -> [a] -> [a]
++ String
"two parts such that the first part fits in 155 characters or less "
      forall a. [a] -> [a] -> [a]
++ String
"and the second part fits in 100 characters or less. Basically you "
      forall a. [a] -> [a] -> [a]
++ String
"have to make the file name or directory names shorter, or you could "
      forall a. [a] -> [a] -> [a]
++ String
"split a long directory name into nested subdirectories with shorter "
      forall a. [a] -> [a] -> [a]
++ String
"names.\nThe file in question is:\n  " forall a. [a] -> [a] -> [a]
++ String
path
    emptyName :: PackageCheck
emptyName = String -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
         String
"Encountered a file with an empty name, something is very wrong! "
      forall a. [a] -> [a] -> [a]
++ String
"Files with an empty name cannot be stored in a tar archive or in "
      forall a. [a] -> [a] -> [a]
++ String
"standard file systems."

-- --------------------------------------------------------------
-- * Checks for missing content and other pre-distribution checks
-- --------------------------------------------------------------

-- | Similar to 'checkPackageContent', 'checkPackageFilesPreDistribution'
-- inspects the files included in the package, but is 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. Hence we can use IO, rather than needing
-- to pass a 'CheckPackageContentOps' dictionary around.
checkPackageFilesPreDistribution :: Verbosity -> PackageDescription -> FilePath -> IO [PackageCheck]
-- 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 run these tests, that will be a lie!
checkPackageFilesPreDistribution :: Verbosity -> PackageDescription -> String -> IO [PackageCheck]
checkPackageFilesPreDistribution = Verbosity -> PackageDescription -> String -> IO [PackageCheck]
checkGlobFiles

-- | Discover problems with the package's wildcards.
checkGlobFiles :: Verbosity
               -> PackageDescription
               -> FilePath
               -> IO [PackageCheck]
checkGlobFiles :: Verbosity -> PackageDescription -> String -> IO [PackageCheck]
checkGlobFiles Verbosity
verbosity PackageDescription
pkg String
root =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(String, String, String)]
allGlobs forall a b. (a -> b) -> a -> b
$ \(String
field, String
dir, String
glob) ->
    -- Note: we just skip over parse errors here; they're reported elsewhere.
    case CabalSpecVersion -> String -> Either GlobSyntaxError Glob
parseFileGlob (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg) String
glob of
      Left GlobSyntaxError
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return []
      Right Glob
parsedGlob -> do
        [GlobResult String]
results <- Verbosity -> String -> Glob -> IO [GlobResult String]
runDirFileGlob Verbosity
verbosity (String
root String -> ShowS
</> String
dir) Glob
parsedGlob
        let individualWarnings :: [PackageCheck]
individualWarnings = [GlobResult String]
results forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> String -> GlobResult String -> [PackageCheck]
getWarning String
field String
glob
            noMatchesWarning :: [PackageCheck]
noMatchesWarning =
              [ String -> PackageCheck
PackageDistSuspiciousWarn forall a b. (a -> b) -> a -> b
$
                     String
"In '" forall a. [a] -> [a] -> [a]
++ String
field forall a. [a] -> [a] -> [a]
++ String
"': the pattern '" forall a. [a] -> [a] -> [a]
++ String
glob forall a. [a] -> [a] -> [a]
++ String
"' does not"
                  forall a. [a] -> [a] -> [a]
++ String
" match any files."
              | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. GlobResult a -> Bool
suppressesNoMatchesWarning) [GlobResult String]
results
              ]
        forall (m :: * -> *) a. Monad m => a -> m a
return ([PackageCheck]
noMatchesWarning forall a. [a] -> [a] -> [a]
++ [PackageCheck]
individualWarnings)
  where
    adjustedDataDir :: String
adjustedDataDir = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageDescription -> String
dataDir PackageDescription
pkg) then String
"." else PackageDescription -> String
dataDir PackageDescription
pkg
    allGlobs :: [(String, String, String)]
allGlobs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ (,,) String
"extra-source-files" String
"." forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [String]
extraSrcFiles PackageDescription
pkg
      , (,,) String
"extra-doc-files" String
"." forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [String]
extraDocFiles PackageDescription
pkg
      , (,,) String
"data-files" String
adjustedDataDir forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [String]
dataFiles PackageDescription
pkg
      ]

    -- If there's a missing directory in play, since our globs 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, so sit on it.
    suppressesNoMatchesWarning :: GlobResult a -> Bool
suppressesNoMatchesWarning (GlobMatch a
_) = Bool
True
    suppressesNoMatchesWarning (GlobWarnMultiDot a
_) = Bool
False
    suppressesNoMatchesWarning (GlobMissingDirectory String
_) = Bool
True

    getWarning :: String -> FilePath -> GlobResult FilePath -> [PackageCheck]
    getWarning :: String -> String -> GlobResult String -> [PackageCheck]
getWarning String
_ String
_ (GlobMatch String
_) =
      []
    -- 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 String
field String
glob (GlobWarnMultiDot String
file) =
      [ String -> PackageCheck
PackageDistSuspiciousWarn forall a b. (a -> b) -> a -> b
$
             String
"In '" forall a. [a] -> [a] -> [a]
++ String
field forall a. [a] -> [a] -> [a]
++ String
"': the pattern '" forall a. [a] -> [a] -> [a]
++ String
glob forall a. [a] -> [a] -> [a]
++ String
"' does not"
          forall a. [a] -> [a] -> [a]
++ String
" match the file '" forall a. [a] -> [a] -> [a]
++ String
file forall a. [a] -> [a] -> [a]
++ String
"' because the extensions do not"
          forall a. [a] -> [a] -> [a]
++ String
" exactly match (e.g., foo.en.html does not exactly match *.html)."
          forall a. [a] -> [a] -> [a]
++ String
" To enable looser suffix-only matching, set 'cabal-version: 2.4' or higher."
      ]
    getWarning String
field String
glob (GlobMissingDirectory String
dir) =
      [ String -> PackageCheck
PackageDistSuspiciousWarn forall a b. (a -> b) -> a -> b
$
             String
"In '" forall a. [a] -> [a] -> [a]
++ String
field forall a. [a] -> [a] -> [a]
++ String
"': the pattern '" forall a. [a] -> [a] -> [a]
++ String
glob forall a. [a] -> [a] -> [a]
++ String
"' attempts to"
          forall a. [a] -> [a] -> [a]
++ String
" match files in the directory '" forall a. [a] -> [a] -> [a]
++ String
dir forall a. [a] -> [a] -> [a]
++ String
"', but there is no"
          forall a. [a] -> [a] -> [a]
++ String
" directory by that name."
      ]

-- ------------------------------------------------------------
-- * Utils
-- ------------------------------------------------------------

quote :: String -> String
quote :: ShowS
quote String
s = String
"'" forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
"'"

commaSep :: [String] -> String
commaSep :: [String] -> String
commaSep = forall a. [a] -> [[a]] -> [a]
intercalate String
", "

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

fileExtensionSupportedLanguage :: FilePath -> Bool
fileExtensionSupportedLanguage :: String -> Bool
fileExtensionSupportedLanguage String
path =
    Bool
isHaskell Bool -> Bool -> Bool
|| Bool
isC
  where
    extension :: String
extension = ShowS
takeExtension String
path
    isHaskell :: Bool
isHaskell = String
extension forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
".hs", String
".lhs"]
    isC :: Bool
isC       = forall a. Maybe a -> Bool
isJust (String -> Maybe (CDialect, Bool)
filenameCDialect String
extension)

-- | Whether a path is a good relative path.
--
-- >>> let test fp = putStrLn $ show (isGoodRelativeDirectoryPath fp) ++ "; " ++ show (isGoodRelativeFilePath fp)
--
-- >>> test "foo/bar/quu"
-- Nothing; Nothing
--
-- Trailing slash is not allowed for files, for directories it is ok.
--
-- >>> test "foo/"
-- Nothing; Just "trailing slash"
--
-- Leading @./@ is fine, but @.@ and @./@ are not valid files.
--
-- >>> traverse_ test [".", "./", "./foo/bar"]
-- Nothing; Just "trailing dot segment"
-- Nothing; Just "trailing slash"
-- Nothing; Nothing
--
-- Lastly, not good file nor directory cases:
--
-- >>> traverse_ test ["", "/tmp/src", "foo//bar", "foo/.", "foo/./bar", "foo/../bar", "foo*bar"]
-- Just "empty path"; Just "empty path"
-- Just "posix absolute path"; Just "posix absolute path"
-- Just "empty path segment"; Just "empty path segment"
-- Just "trailing same directory segment: ."; Just "trailing same directory segment: ."
-- Just "same directory segment: ."; Just "same directory segment: .."
-- Just "parent directory segment: .."; Just "parent directory segment: .."
-- Just "reserved character '*'"; Just "reserved character '*'"
--
-- For the last case, 'isGoodRelativeGlob' doesn't warn:
--
-- >>> traverse_ (print . isGoodRelativeGlob) ["foo/../bar", "foo*bar"]
-- Just "parent directory segment: .."
-- Nothing
--
isGoodRelativeFilePath :: FilePath -> Maybe String
isGoodRelativeFilePath :: String -> Maybe String
isGoodRelativeFilePath = String -> Maybe String
state0
  where
    -- Reserved characters
    -- https://docs.microsoft.com/en-us/windows/win32/fileio/naming-a-file
    isReserved :: Char -> Bool
isReserved Char
c = Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"<>:\"\\/|?*"

    -- initial state
    state0 :: String -> Maybe String
state0 []                    = forall a. a -> Maybe a
Just String
"empty path"
    state0 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state1 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = forall a. a -> Maybe a
Just String
"posix absolute path"
                  | Char -> Bool
isReserved Char
c = forall a. a -> Maybe a
Just (String
"reserved character " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
c)
                  | Bool
otherwise    = String -> Maybe String
state3 String
cs

    -- after .
    state1 :: String -> Maybe String
state1 []                    = forall a. a -> Maybe a
Just String
"trailing dot segment"
    state1 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state4 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = String -> Maybe String
state2 String
cs
                  | Char -> Bool
isReserved Char
c = forall a. a -> Maybe a
Just (String
"reserved character " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
c)
                  | Bool
otherwise    = String -> Maybe String
state5 String
cs

    -- after ./
    state2 :: String -> Maybe String
state2 []                    = forall a. a -> Maybe a
Just String
"trailing slash"
    state2 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state3 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = forall a. a -> Maybe a
Just String
"empty path segment"
                  | Char -> Bool
isReserved Char
c = forall a. a -> Maybe a
Just (String
"reserved character " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
c)
                  | Bool
otherwise    = String -> Maybe String
state5 String
cs

    -- after non-first segment's .
    state3 :: String -> Maybe String
state3 []                    = forall a. a -> Maybe a
Just String
"trailing same directory segment: ."
    state3 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state4 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = forall a. a -> Maybe a
Just String
"same directory segment: .."
                  | Char -> Bool
isReserved Char
c = forall a. a -> Maybe a
Just (String
"reserved character " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
c)
                  | Bool
otherwise    = String -> Maybe String
state5 String
cs

    -- after non-first segment's ..
    state4 :: String -> Maybe String
state4 []                    = forall a. a -> Maybe a
Just String
"trailing parent directory segment: .."
    state4 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state5 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = forall a. a -> Maybe a
Just String
"parent directory segment: .."
                  | Char -> Bool
isReserved Char
c = forall a. a -> Maybe a
Just (String
"reserved character " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
c)
                  | Bool
otherwise    = String -> Maybe String
state5 String
cs

    -- in a segment which is ok.
    state5 :: String -> Maybe String
state5 []                    = forall a. Maybe a
Nothing
    state5 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state3 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = String -> Maybe String
state2 String
cs
                  | Char -> Bool
isReserved Char
c = forall a. a -> Maybe a
Just (String
"reserved character " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
c)
                  | Bool
otherwise    = String -> Maybe String
state5 String
cs

-- | See 'isGoodRelativeFilePath'.
--
-- This is barebones function. We check whether the glob is a valid file
-- by replacing stars @*@ with @x@ses.
isGoodRelativeGlob :: FilePath -> Maybe String
isGoodRelativeGlob :: String -> Maybe String
isGoodRelativeGlob = String -> Maybe String
isGoodRelativeFilePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
f where
    f :: Char -> Char
f Char
'*' = Char
'x'
    f Char
c   = Char
c

-- | See 'isGoodRelativeFilePath'.
isGoodRelativeDirectoryPath :: FilePath -> Maybe String
isGoodRelativeDirectoryPath :: String -> Maybe String
isGoodRelativeDirectoryPath = String -> Maybe String
state0
  where
    -- Reserved characters
    -- https://docs.microsoft.com/en-us/windows/win32/fileio/naming-a-file
    isReserved :: Char -> Bool
isReserved Char
c = Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"<>:\"\\/|?*"

    -- initial state
    state0 :: String -> Maybe String
state0 []                    = forall a. a -> Maybe a
Just String
"empty path"
    state0 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state5 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = forall a. a -> Maybe a
Just String
"posix absolute path"
                  | Char -> Bool
isReserved Char
c = forall a. a -> Maybe a
Just (String
"reserved character " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
c)
                  | Bool
otherwise    = String -> Maybe String
state4 String
cs

    -- after ./
    state1 :: String -> Maybe String
state1 []                    = forall a. Maybe a
Nothing -- "./"
    state1 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state2 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = forall a. a -> Maybe a
Just String
"empty path segment"
                  | Char -> Bool
isReserved Char
c = forall a. a -> Maybe a
Just (String
"reserved character " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
c)
                  | Bool
otherwise    = String -> Maybe String
state4 String
cs

    -- after non-first setgment's .
    state2 :: String -> Maybe String
state2 []                    = forall a. a -> Maybe a
Just String
"trailing same directory segment: ."
    state2 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state3 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = forall a. a -> Maybe a
Just String
"same directory segment: ."
                  | Char -> Bool
isReserved Char
c = forall a. a -> Maybe a
Just (String
"reserved character " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
c)
                  | Bool
otherwise    = String -> Maybe String
state4 String
cs

    -- after non-first segment's ..
    state3 :: String -> Maybe String
state3 []                    = forall a. a -> Maybe a
Just String
"trailing parent directory segment: ."
    state3 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state4 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = forall a. a -> Maybe a
Just String
"parent directory segment: .."
                  | Char -> Bool
isReserved Char
c = forall a. a -> Maybe a
Just (String
"reserved character " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
c)
                  | Bool
otherwise    = String -> Maybe String
state4 String
cs

    -- in a segment which is ok.
    state4 :: String -> Maybe String
state4 []                    = forall a. Maybe a
Nothing
    state4 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state4 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = String -> Maybe String
state1 String
cs
                  | Char -> Bool
isReserved Char
c = forall a. a -> Maybe a
Just (String
"reserved character " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
c)
                  | Bool
otherwise    = String -> Maybe String
state4 String
cs

    -- after .
    state5 :: String -> Maybe String
state5 []                    = forall a. Maybe a
Nothing -- "."
    state5 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state3 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = String -> Maybe String
state1 String
cs
                  | Char -> Bool
isReserved Char
c = forall a. a -> Maybe a
Just (String
"reserved character " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
c)
                  | Bool
otherwise    = String -> Maybe String
state4 String
cs

-- [Note: Good relative paths]
--
-- Using @kleene@ we can define an extended regex:
--
-- @
-- import Algebra.Lattice
-- import Kleene
-- import Kleene.ERE (ERE (..), intersections)
--
-- data C = CDot | CSlash | COtherReserved | CChar
--   deriving (Eq, Ord, Enum, Bounded, Show)
--
-- reservedR :: ERE C
-- reservedR = notChar CSlash /\ notChar COtherReserved
--
-- pathPieceR :: ERE C
-- pathPieceR = intersections
--     [ plus reservedR
--     , ERENot (string [CDot])
--     , ERENot (string [CDot,CDot])
--     ]
--
-- filePathR :: ERE C
-- filePathR = optional (string [CDot, CSlash]) <> pathPieceR <> star (char CSlash <> pathPieceR)
--
-- dirPathR :: ERE C
-- dirPathR = (char CDot \/ filePathR) <> optional (char CSlash)
--
-- plus :: ERE C -> ERE C
-- plus r = r <> star r
--
-- optional :: ERE C -> ERE C
-- optional r = mempty \/ r
-- @
--
-- Results in following state machine for @filePathR@
--
-- @
-- 0 -> \x -> if
--     | x <= CDot           -> 1
--     | x <= COtherReserved -> 6
--     | otherwise           -> 5
-- 1 -> \x -> if
--     | x <= CDot           -> 4
--     | x <= CSlash         -> 2
--     | x <= COtherReserved -> 6
--     | otherwise           -> 5
-- 2 -> \x -> if
--     | x <= CDot           -> 3
--     | x <= COtherReserved -> 6
--     | otherwise           -> 5
-- 3 -> \x -> if
--     | x <= CDot           -> 4
--     | x <= COtherReserved -> 6
--     | otherwise           -> 5
-- 4 -> \x -> if
--     | x <= CDot           -> 5
--     | x <= COtherReserved -> 6
--     | otherwise           -> 5
-- 5+ -> \x -> if
--     | x <= CDot           -> 5
--     | x <= CSlash         -> 2
--     | x <= COtherReserved -> 6
--     | otherwise           -> 5
-- 6 -> \_ -> 6 -- black hole
-- @
--
-- and @dirPathR@:
--
-- @
-- 0 -> \x -> if
--     | x <= CDot           -> 5
--     | x <= COtherReserved -> 6
--     | otherwise           -> 4
-- 1+ -> \x -> if
--     | x <= CDot           -> 2
--     | x <= COtherReserved -> 6
--     | otherwise           -> 4
-- 2 -> \x -> if
--     | x <= CDot           -> 3
--     | x <= COtherReserved -> 6
--     | otherwise           -> 4
-- 3 -> \x -> if
--     | x <= CDot           -> 4
--     | x <= COtherReserved -> 6
--     | otherwise           -> 4
-- 4+ -> \x -> if
--     | x <= CDot           -> 4
--     | x <= CSlash         -> 1
--     | x <= COtherReserved -> 6
--     | otherwise           -> 4
-- 5+ -> \x -> if
--     | x <= CDot           -> 3
--     | x <= CSlash         -> 1
--     | x <= COtherReserved -> 6
--     | otherwise           -> 4
-- 6 -> \_ -> 6 -- black hole
-- @