-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.PackageDescription.Check
-- Copyright   :  Lennart Kolmodin 2008
--
-- 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 check so we can see which ones are appropriate to report
-- in different situations. This code gets uses when configuring a package when
-- we consider only basic problems. The higher standard is uses when 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.

{- All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

    * Redistributions of source code must retain the above copyright
      notice, this list of conditions and the following disclaimer.

    * Redistributions in binary form must reproduce the above
      copyright notice, this list of conditions and the following
      disclaimer in the documentation and/or other materials provided
      with the distribution.

    * Neither the name of Isaac Jones nor the names of other
      contributors may be used to endorse or promote products derived
      from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}

module Distribution.PackageDescription.Check (
        -- * Package Checking
        PackageCheck(..),
        checkPackage,
        checkConfiguredPackage,

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

import Data.Maybe
         ( isNothing, isJust, catMaybes, maybeToList, fromMaybe )
import Data.List  (sort, group, isPrefixOf, nub, find)
import Control.Monad
         ( filterM, liftM )
import qualified System.Directory as System
         ( doesFileExist, doesDirectoryExist )

import Distribution.Package ( pkgName )
import Distribution.PackageDescription
import Distribution.PackageDescription.Configuration
         ( flattenPackageDescription, finalizePackageDescription )
import Distribution.Compiler
         ( CompilerFlavor(..), buildCompilerFlavor, CompilerId(..) )
import Distribution.System
         ( OS(..), Arch(..), buildPlatform )
import Distribution.License
         ( License(..), knownLicenses )
import Distribution.Simple.Utils
         ( cabalVersion, intercalate, parseFileGlob, FileGlob(..), lowercase )

import Distribution.Version
         ( Version(..)
         , VersionRange(..), foldVersionRange'
         , anyVersion, noVersion, thisVersion, laterVersion, earlierVersion
         , orLaterVersion, orEarlierVersion
         , unionVersionRanges, intersectVersionRanges
         , asVersionIntervals, UpperBound(..), isNoVersion )
import Distribution.Package
         ( PackageName(PackageName), packageName, packageVersion
         , Dependency(..) )

import Distribution.Text
         ( display, disp )
import qualified Text.PrettyPrint as Disp
import Text.PrettyPrint ((<>), (<+>))

import qualified Language.Haskell.Extension as Extension (deprecatedExtensions)
import Language.Haskell.Extension
         ( Language(UnknownLanguage), knownLanguages, Extension(..), KnownExtension(..) )
import System.FilePath
         ( (</>), takeExtension, isRelative, isAbsolute
         , splitDirectories,  splitPath )
import System.FilePath.Windows as FilePath.Windows
         ( isValid )

-- | 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 explanation :: StringPackageCheck =

       -- | 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 { 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 determental 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 }

       -- | 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 }

instance D:Show ::
  (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> T:Show aShow PackageCheck where
    show notice = explanation :: PackageCheck -> Stringexplanation notice :: PackageChecknotice

check :: Bool -> PackageCheck -> Maybe PackageCheck
check False _  = Nothing :: Maybe aNothing
check True  pc = Just :: a -> Maybe aJust pc :: PackageCheckpc

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

-- | Check for common mistakes and problems in package descriptions.
--
-- This is the standard collection of checks covering all apsects 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 gpkg mpkg =
     checkConfiguredPackage :: PackageDescription -> [PackageCheck]checkConfiguredPackage pkg :: PackageDescriptionpkg
  (++) :: [a] -> [a] -> [a]++ checkConditionals :: GenericPackageDescription -> [PackageCheck]checkConditionals gpkg :: GenericPackageDescriptiongpkg
  (++) :: [a] -> [a] -> [a]++ checkPackageVersions :: GenericPackageDescription -> [PackageCheck]checkPackageVersions gpkg :: GenericPackageDescriptiongpkg
  where
    pkg = fromMaybe :: a -> Maybe a -> afromMaybe (flattenPackageDescription ::
  GenericPackageDescription -> PackageDescriptionflattenPackageDescription gpkg :: GenericPackageDescriptiongpkg) mpkg :: Maybe PackageDescriptionmpkg

--TODO: make this variant go away
--      we should alwaws know the GenericPackageDescription
checkConfiguredPackage :: PackageDescription -> [PackageCheck]
checkConfiguredPackage pkg =
    checkSanity :: PackageDescription -> [PackageCheck]checkSanity pkg :: PackageDescriptionpkg
 (++) :: [a] -> [a] -> [a]++ checkFields :: PackageDescription -> [PackageCheck]checkFields pkg :: PackageDescriptionpkg
 (++) :: [a] -> [a] -> [a]++ checkLicense :: PackageDescription -> [PackageCheck]checkLicense pkg :: PackageDescriptionpkg
 (++) :: [a] -> [a] -> [a]++ checkSourceRepos :: PackageDescription -> [PackageCheck]checkSourceRepos pkg :: PackageDescriptionpkg
 (++) :: [a] -> [a] -> [a]++ checkGhcOptions :: PackageDescription -> [PackageCheck]checkGhcOptions pkg :: PackageDescriptionpkg
 (++) :: [a] -> [a] -> [a]++ checkCCOptions :: PackageDescription -> [PackageCheck]checkCCOptions pkg :: PackageDescriptionpkg
 (++) :: [a] -> [a] -> [a]++ checkPaths :: PackageDescription -> [PackageCheck]checkPaths pkg :: PackageDescriptionpkg
 (++) :: [a] -> [a] -> [a]++ checkCabalVersion :: PackageDescription -> [PackageCheck]checkCabalVersion pkg :: PackageDescriptionpkg


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

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

    check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (null :: [a] -> Boolnull (.) :: (b -> c) -> (a -> b) -> a -> c. (\(PackageName n) -> n :: Stringn) (.) :: (b -> c) -> (a -> b) -> a -> c. packageName :: Package pkg => pkg -> PackageNamepackageName ($) :: (a -> b) -> a -> b$ pkg :: PackageDescriptionpkg) ($) :: (a -> b) -> a -> b$
      PackageBuildImpossible :: String -> PackageCheckPackageBuildImpossible "No 'name' field."

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (null :: [a] -> Boolnull (.) :: (b -> c) -> (a -> b) -> a -> c. versionBranch :: Version -> [Int]versionBranch (.) :: (b -> c) -> (a -> b) -> a -> c. packageVersion :: Package pkg => pkg -> VersionpackageVersion ($) :: (a -> b) -> a -> b$ pkg :: PackageDescriptionpkg) ($) :: (a -> b) -> a -> b$
      PackageBuildImpossible :: String -> PackageCheckPackageBuildImpossible "No 'version' field."

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (null :: [a] -> Boolnull (executables :: PackageDescription -> [Executable]executables pkg :: PackageDescriptionpkg) (&&) :: Bool -> Bool -> Bool&& isNothing :: Maybe a -> BoolisNothing (library :: PackageDescription -> Maybe Librarylibrary pkg :: PackageDescriptionpkg)) ($) :: (a -> b) -> a -> b$
      PackageBuildImpossible :: String -> PackageCheckPackageBuildImpossible
        "No executables and no library found. Nothing to do."

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (not :: Bool -> Boolnot (null :: [a] -> Boolnull exeDuplicates :: [String]exeDuplicates)) ($) :: (a -> b) -> a -> b$
      PackageBuildImpossible :: String -> PackageCheckPackageBuildImpossible ($) :: (a -> b) -> a -> b$ "Duplicate executable sections "
        (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep exeDuplicates :: [String]exeDuplicates
  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (not :: Bool -> Boolnot (null :: [a] -> Boolnull testDuplicates :: [String]testDuplicates)) ($) :: (a -> b) -> a -> b$
      PackageBuildImpossible :: String -> PackageCheckPackageBuildImpossible ($) :: (a -> b) -> a -> b$ "Duplicate test sections "
        (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep testDuplicates :: [String]testDuplicates

    --TODO: this seems to duplicate a check on the testsuites
  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (not :: Bool -> Boolnot (null :: [a] -> Boolnull testsThatAreExes :: [String]testsThatAreExes)) ($) :: (a -> b) -> a -> b$
      PackageBuildImpossible :: String -> PackageCheckPackageBuildImpossible ($) :: (a -> b) -> a -> b$ "These test sections share names with executable sections: "
        (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep testsThatAreExes :: [String]testsThatAreExes
  ]
  --TODO: check for name clashes case insensitively: windows file systems cannot cope.

  (++) :: [a] -> [a] -> [a]++ maybe :: b -> (a -> b) -> Maybe a -> bmaybe [] :: [a][]  checkLibrary :: Library -> [PackageCheck]checkLibrary    (library :: PackageDescription -> Maybe Librarylibrary pkg :: PackageDescriptionpkg)
  (++) :: [a] -> [a] -> [a]++ concatMap :: (a -> [b]) -> [a] -> [b]concatMap checkExecutable :: Executable -> [PackageCheck]checkExecutable (executables :: PackageDescription -> [Executable]executables pkg :: PackageDescriptionpkg)
  (++) :: [a] -> [a] -> [a]++ concatMap :: (a -> [b]) -> [a] -> [b]concatMap (checkTestSuite :: PackageDescription -> TestSuite -> [PackageCheck]checkTestSuite pkg :: PackageDescriptionpkg) (testSuites :: PackageDescription -> [TestSuite]testSuites pkg :: PackageDescriptionpkg)

  (++) :: [a] -> [a] -> [a]++ catMaybes :: [Maybe a] -> [a]catMaybes [

    check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (specVersion :: PackageDescription -> VersionspecVersion pkg :: PackageDescriptionpkg (>) :: Ord a => a -> a -> Bool> cabalVersion :: VersioncabalVersion) ($) :: (a -> b) -> a -> b$
      PackageBuildImpossible :: String -> PackageCheckPackageBuildImpossible ($) :: (a -> b) -> a -> b$
           "This package description follows version "
        (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay (specVersion :: PackageDescription -> VersionspecVersion pkg :: PackageDescriptionpkg) (++) :: [a] -> [a] -> [a]++ " of the Cabal specification. This "
        (++) :: [a] -> [a] -> [a]++ "tool only supports up to version " (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay cabalVersion :: VersioncabalVersion (++) :: [a] -> [a] -> [a]++ "."
  ]
  where
    exeNames = map :: (a -> b) -> [a] -> [b]map exeName :: Executable -> StringexeName ($) :: (a -> b) -> a -> b$ executables :: PackageDescription -> [Executable]executables pkg :: PackageDescriptionpkg
    testNames = map :: (a -> b) -> [a] -> [b]map testName :: TestSuite -> StringtestName ($) :: (a -> b) -> a -> b$ testSuites :: PackageDescription -> [TestSuite]testSuites pkg :: PackageDescriptionpkg
    exeDuplicates = dups :: Ord a => [a] -> [a]dups exeNames :: [String]exeNames
    testDuplicates = dups :: Ord a => [a] -> [a]dups testNames :: [String]testNames
    testsThatAreExes = filter :: (a -> Bool) -> [a] -> [a]filter (flip :: (a -> b -> c) -> b -> a -> cflip elem :: Eq a => a -> [a] -> Boolelem exeNames :: [String]exeNames) testNames :: [String]testNames

checkLibrary :: Library -> [PackageCheck]
checkLibrary lib =
  catMaybes :: [Maybe a] -> [a]catMaybes [

    check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (not :: Bool -> Boolnot (null :: [a] -> Boolnull moduleDuplicates :: [ModuleName]moduleDuplicates)) ($) :: (a -> b) -> a -> b$
       PackageBuildWarning :: String -> PackageCheckPackageBuildWarning ($) :: (a -> b) -> a -> b$
            "Duplicate modules in library: "
         (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep (map :: (a -> b) -> [a] -> [b]map display :: Text a => a -> Stringdisplay moduleDuplicates :: [ModuleName]moduleDuplicates)
  ]

  where
    moduleDuplicates = dups :: Ord a => [a] -> [a]dups (libModules :: Library -> [ModuleName]libModules lib :: [Char]lib)

checkExecutable :: Executable -> [PackageCheck]
checkExecutable exe =
  catMaybes :: [Maybe a] -> [a]catMaybes [

    check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (null :: [a] -> Boolnull (modulePath :: Executable -> FilePathmodulePath exe :: Executableexe)) ($) :: (a -> b) -> a -> b$
      PackageBuildImpossible :: String -> PackageCheckPackageBuildImpossible ($) :: (a -> b) -> a -> b$
        "No 'Main-Is' field found for executable " (++) :: [a] -> [a] -> [a]++ exeName :: Executable -> StringexeName exe :: Executableexe

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (not :: Bool -> Boolnot (null :: [a] -> Boolnull (modulePath :: Executable -> FilePathmodulePath exe :: Executableexe))
       (&&) :: Bool -> Bool -> Bool&& takeExtension :: FilePath -> StringtakeExtension (modulePath :: Executable -> FilePathmodulePath exe :: Executableexe) notElem :: Eq a => a -> [a] -> Bool`notElem` [".hs", ".lhs"]) ($) :: (a -> b) -> a -> b$
      PackageBuildImpossible :: String -> PackageCheckPackageBuildImpossible ($) :: (a -> b) -> a -> b$
           "The 'Main-Is' field must specify a '.hs' or '.lhs' file "
        (++) :: [a] -> [a] -> [a]++ "(even if it is generated by a preprocessor)."

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (not :: Bool -> Boolnot (null :: [a] -> Boolnull moduleDuplicates :: [ModuleName]moduleDuplicates)) ($) :: (a -> b) -> a -> b$
       PackageBuildWarning :: String -> PackageCheckPackageBuildWarning ($) :: (a -> b) -> a -> b$
            "Duplicate modules in executable '" (++) :: [a] -> [a] -> [a]++ exeName :: Executable -> StringexeName exe :: Executableexe (++) :: [a] -> [a] -> [a]++ "': "
         (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep (map :: (a -> b) -> [a] -> [b]map display :: Text a => a -> Stringdisplay moduleDuplicates :: [ModuleName]moduleDuplicates)
  ]
  where
    moduleDuplicates = dups :: Ord a => [a] -> [a]dups (exeModules :: Executable -> [ModuleName]exeModules exe :: Executableexe)

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

    case testInterface :: TestSuite -> TestSuiteInterfacetestInterface test :: TestSuitetest of
      TestSuiteUnsupported tt@(TestTypeUnknown _ _) -> Just :: a -> Maybe aJust ($) :: (a -> b) -> a -> b$
        PackageBuildWarning :: String -> PackageCheckPackageBuildWarning ($) :: (a -> b) -> a -> b$
             quote :: String -> Stringquote (display :: Text a => a -> Stringdisplay tt :: TestTypett) (++) :: [a] -> [a] -> [a]++ " is not a known type of test suite. "
          (++) :: [a] -> [a] -> [a]++ "The known test suite types are: "
          (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep (map :: (a -> b) -> [a] -> [b]map display :: Text a => a -> Stringdisplay knownTestTypes :: [TestType]knownTestTypes)

      TestSuiteUnsupported tt -> Just :: a -> Maybe aJust ($) :: (a -> b) -> a -> b$
        PackageBuildWarning :: String -> PackageCheckPackageBuildWarning ($) :: (a -> b) -> a -> b$
             quote :: String -> Stringquote (display :: Text a => a -> Stringdisplay tt :: TestTypett) (++) :: [a] -> [a] -> [a]++ " is not a supported test suite version. "
          (++) :: [a] -> [a] -> [a]++ "The known test suite types are: "
          (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep (map :: (a -> b) -> [a] -> [b]map display :: Text a => a -> Stringdisplay knownTestTypes :: [TestType]knownTestTypes)
      _ -> Nothing :: Maybe aNothing

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (not :: Bool -> Boolnot ($) :: (a -> b) -> a -> b$ null :: [a] -> Boolnull moduleDuplicates :: [ModuleName]moduleDuplicates) ($) :: (a -> b) -> a -> b$
      PackageBuildWarning :: String -> PackageCheckPackageBuildWarning ($) :: (a -> b) -> a -> b$
           "Duplicate modules in test suite '" (++) :: [a] -> [a] -> [a]++ testName :: TestSuite -> StringtestName test :: TestSuitetest (++) :: [a] -> [a] -> [a]++ "': "
        (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep (map :: (a -> b) -> [a] -> [b]map display :: Text a => a -> Stringdisplay moduleDuplicates :: [ModuleName]moduleDuplicates)

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

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck exeNameClash :: BoolexeNameClash ($) :: (a -> b) -> a -> b$
      PackageBuildImpossible :: String -> PackageCheckPackageBuildImpossible ($) :: (a -> b) -> a -> b$
           "The test suite " (++) :: [a] -> [a] -> [a]++ testName :: TestSuite -> StringtestName test :: TestSuitetest
        (++) :: [a] -> [a] -> [a]++ " has the same name as an executable."

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck libNameClash :: BoollibNameClash ($) :: (a -> b) -> a -> b$
      PackageBuildImpossible :: String -> PackageCheckPackageBuildImpossible ($) :: (a -> b) -> a -> b$
           "The test suite " (++) :: [a] -> [a] -> [a]++ testName :: TestSuite -> StringtestName test :: TestSuitetest
        (++) :: [a] -> [a] -> [a]++ " has the same name as the package."
  ]
  where
    moduleDuplicates = dups :: Ord a => [a] -> [a]dups ($) :: (a -> b) -> a -> b$ testModules :: TestSuite -> [ModuleName]testModules test :: TestSuitetest

    mainIsWrongExt = case testInterface :: TestSuite -> TestSuiteInterfacetestInterface test :: TestSuitetest of
      TestSuiteExeV10 _ f -> takeExtension :: FilePath -> StringtakeExtension f :: FilePathf notElem :: Eq a => a -> [a] -> Bool`notElem` [".hs", ".lhs"]
      _                   -> False :: BoolFalse

    exeNameClash = testName :: TestSuite -> StringtestName test :: TestSuitetest elem :: Eq a => a -> [a] -> Bool`elem` [ exeName :: Executable -> StringexeName exe :: Executableexe | exe <- executables :: PackageDescription -> [Executable]executables pkg :: PackageDescriptionpkg ]
    libNameClash = testName :: TestSuite -> StringtestName test :: TestSuitetest elem :: Eq a => a -> [a] -> Bool`elem` [ libName :: StringlibName
                                        | _lib <- maybeToList :: Maybe a -> [a]maybeToList (library :: PackageDescription -> Maybe Librarylibrary pkg :: PackageDescriptionpkg)
                                        , let PackageName libName =
                                                pkgName :: PackageIdentifier -> PackageNamepkgName (package :: PackageDescription -> PackageIdentifierpackage pkg :: PackageDescriptionpkg) ]

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

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

    check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (not :: Bool -> Boolnot (.) :: (b -> c) -> (a -> b) -> a -> c. isValid :: FilePath -> BoolFilePath.Windows.isValid (.) :: (b -> c) -> (a -> b) -> a -> c. display :: Text a => a -> Stringdisplay (.) :: (b -> c) -> (a -> b) -> a -> c. packageName :: Package pkg => pkg -> PackageNamepackageName ($) :: (a -> b) -> a -> b$ pkg :: PackageDescriptionpkg) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
           "Unfortunately, the package name '" (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay (packageName :: Package pkg => pkg -> PackageNamepackageName pkg :: PackageDescriptionpkg)
        (++) :: [a] -> [a] -> [a]++ "' is one of the reserved system file names on Windows. Many tools "
        (++) :: [a] -> [a] -> [a]++ "need to convert package names to file names so using this name "
        (++) :: [a] -> [a] -> [a]++ "would cause problems."

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (isNothing :: Maybe a -> BoolisNothing (buildType :: PackageDescription -> Maybe BuildTypebuildType pkg :: PackageDescriptionpkg)) ($) :: (a -> b) -> a -> b$
      PackageBuildWarning :: String -> PackageCheckPackageBuildWarning ($) :: (a -> b) -> a -> b$
           "No 'build-type' specified. If you do not need a custom Setup.hs or "
        (++) :: [a] -> [a] -> [a]++ "./configure script then use 'build-type: Simple'."

  , case buildType :: PackageDescription -> Maybe BuildTypebuildType pkg :: PackageDescriptionpkg of
      Just (UnknownBuildType unknown) -> Just :: a -> Maybe aJust ($) :: (a -> b) -> a -> b$
        PackageBuildWarning :: String -> PackageCheckPackageBuildWarning ($) :: (a -> b) -> a -> b$
             quote :: String -> Stringquote unknown :: Stringunknown (++) :: [a] -> [a] -> [a]++ " is not a known 'build-type'. "
          (++) :: [a] -> [a] -> [a]++ "The known build types are: "
          (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep (map :: (a -> b) -> [a] -> [b]map display :: Text a => a -> Stringdisplay knownBuildTypes :: [BuildType]knownBuildTypes)
      _ -> Nothing :: Maybe aNothing

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (not :: Bool -> Boolnot (null :: [a] -> Boolnull unknownCompilers :: [String]unknownCompilers)) ($) :: (a -> b) -> a -> b$
      PackageBuildWarning :: String -> PackageCheckPackageBuildWarning ($) :: (a -> b) -> a -> b$
        "Unknown compiler " (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep (map :: (a -> b) -> [a] -> [b]map quote :: String -> Stringquote unknownCompilers :: [String]unknownCompilers)
                            (++) :: [a] -> [a] -> [a]++ " in 'tested-with' field."

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (not :: Bool -> Boolnot (null :: [a] -> Boolnull unknownLanguages :: [String]unknownLanguages)) ($) :: (a -> b) -> a -> b$
      PackageBuildWarning :: String -> PackageCheckPackageBuildWarning ($) :: (a -> b) -> a -> b$
        "Unknown languages: " (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep unknownLanguages :: [String]unknownLanguages

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (not :: Bool -> Boolnot (null :: [a] -> Boolnull unknownExtensions :: [String]unknownExtensions)) ($) :: (a -> b) -> a -> b$
      PackageBuildWarning :: String -> PackageCheckPackageBuildWarning ($) :: (a -> b) -> a -> b$
        "Unknown extensions: " (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep unknownExtensions :: [String]unknownExtensions

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

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (not :: Bool -> Boolnot (null :: [a] -> Boolnull deprecatedExtensions :: [(Extension, Maybe Extension)]deprecatedExtensions)) ($) :: (a -> b) -> a -> b$
      PackageDistSuspicious :: String -> PackageCheckPackageDistSuspicious ($) :: (a -> b) -> a -> b$
           "Deprecated extensions: "
        (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep (map :: (a -> b) -> [a] -> [b]map (quote :: String -> Stringquote (.) :: (b -> c) -> (a -> b) -> a -> c. display :: Text a => a -> Stringdisplay (.) :: (b -> c) -> (a -> b) -> a -> c. fst :: (a, b) -> afst) deprecatedExtensions :: [(Extension, Maybe Extension)]deprecatedExtensions)
        (++) :: [a] -> [a] -> [a]++ ". " (++) :: [a] -> [a] -> [a]++ intercalate :: [a] -> [[a]] -> [a]intercalate " "
             [ "Instead of '" (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay ext :: Extensionext
            (++) :: [a] -> [a] -> [a]++ "' use '" (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay replacement :: Extensionreplacement (++) :: [a] -> [a] -> [a]++ "'."
             | (ext, Just replacement) <- deprecatedExtensions :: [(Extension, Maybe Extension)]deprecatedExtensions ]

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (null :: [a] -> Boolnull (category :: PackageDescription -> Stringcategory pkg :: PackageDescriptionpkg)) ($) :: (a -> b) -> a -> b$
      PackageDistSuspicious :: String -> PackageCheckPackageDistSuspicious "No 'category' field."

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (null :: [a] -> Boolnull (maintainer :: PackageDescription -> Stringmaintainer pkg :: PackageDescriptionpkg)) ($) :: (a -> b) -> a -> b$
      PackageDistSuspicious :: String -> PackageCheckPackageDistSuspicious "No 'maintainer' field."

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (null :: [a] -> Boolnull (synopsis :: PackageDescription -> Stringsynopsis pkg :: PackageDescriptionpkg) (&&) :: Bool -> Bool -> Bool&& null :: [a] -> Boolnull (description :: PackageDescription -> Stringdescription pkg :: PackageDescriptionpkg)) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$ "No 'synopsis' or 'description' field."

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (null :: [a] -> Boolnull (description :: PackageDescription -> Stringdescription pkg :: PackageDescriptionpkg) (&&) :: Bool -> Bool -> Bool&& not :: Bool -> Boolnot (null :: [a] -> Boolnull (synopsis :: PackageDescription -> Stringsynopsis pkg :: PackageDescriptionpkg))) ($) :: (a -> b) -> a -> b$
      PackageDistSuspicious :: String -> PackageCheckPackageDistSuspicious "No 'description' field."

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (null :: [a] -> Boolnull (synopsis :: PackageDescription -> Stringsynopsis pkg :: PackageDescriptionpkg) (&&) :: Bool -> Bool -> Bool&& not :: Bool -> Boolnot (null :: [a] -> Boolnull (description :: PackageDescription -> Stringdescription pkg :: PackageDescriptionpkg))) ($) :: (a -> b) -> a -> b$
      PackageDistSuspicious :: String -> PackageCheckPackageDistSuspicious "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

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (length :: [a] -> Intlength (synopsis :: PackageDescription -> Stringsynopsis pkg :: PackageDescriptionpkg) (>=) :: Ord a => a -> a -> Bool>= 80) ($) :: (a -> b) -> a -> b$
      PackageDistSuspicious :: String -> PackageCheckPackageDistSuspicious
        "The 'synopsis' field is rather long (max 80 chars is recommended)."

    -- check use of impossible constraints "tested-with: GHC== 6.10 && ==6.12"
  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (not :: Bool -> Boolnot (null :: [a] -> Boolnull testedWithImpossibleRanges :: [Dependency]testedWithImpossibleRanges)) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
           "Invalid 'tested-with' version range: "
        (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep (map :: (a -> b) -> [a] -> [b]map display :: Text a => a -> Stringdisplay testedWithImpossibleRanges :: [Dependency]testedWithImpossibleRanges)
        (++) :: [a] -> [a] -> [a]++ ". To indicate that you have tested a package with multiple "
        (++) :: [a] -> [a] -> [a]++ "different versions of the same compiler use multiple entries, "
        (++) :: [a] -> [a] -> [a]++ "for example 'tested-with: GHC==6.10.4, GHC==6.12.3' and not "
        (++) :: [a] -> [a] -> [a]++ "'tested-with: GHC==6.10.4 && ==6.12.3'."
  ]
  where
    unknownCompilers  = [ name :: PackageNamename | (OtherCompiler name, _) <- testedWith ::
  PackageDescription -> [(CompilerFlavor, VersionRange)]testedWith pkg :: PackageDescriptionpkg ]
    unknownLanguages  = [ name :: PackageNamename | bi <- allBuildInfo :: PackageDescription -> [BuildInfo]allBuildInfo pkg :: PackageDescriptionpkg
                               , UnknownLanguage name <- allLanguages :: BuildInfo -> [Language]allLanguages bi :: BuildInfobi ]
    unknownExtensions = [ name :: PackageNamename | bi <- allBuildInfo :: PackageDescription -> [BuildInfo]allBuildInfo pkg :: PackageDescriptionpkg
                               , UnknownExtension name <- allExtensions :: BuildInfo -> [Extension]allExtensions bi :: BuildInfobi
                               , name :: PackageNamename notElem :: Eq a => a -> [a] -> Bool`notElem` map :: (a -> b) -> [a] -> [b]map display :: Text a => a -> Stringdisplay knownLanguages :: [Language]knownLanguages ]
    deprecatedExtensions = nub :: Eq a => [a] -> [a]nub ($) :: (a -> b) -> a -> b$ catMaybes :: [Maybe a] -> [a]catMaybes
      [ find :: (a -> Bool) -> [a] -> Maybe afind (((==) :: Eq a => a -> a -> Bool==ext :: Extensionext) (.) :: (b -> c) -> (a -> b) -> a -> c. fst :: (a, b) -> afst) deprecatedExtensions :: [(Extension, Maybe Extension)]Extension.deprecatedExtensions
      | bi <- allBuildInfo :: PackageDescription -> [BuildInfo]allBuildInfo pkg :: PackageDescriptionpkg
      , ext <- allExtensions :: BuildInfo -> [Extension]allExtensions bi :: BuildInfobi ]
    languagesUsedAsExtensions =
      [ name :: PackageNamename | bi <- allBuildInfo :: PackageDescription -> [BuildInfo]allBuildInfo pkg :: PackageDescriptionpkg
             , UnknownExtension name <- allExtensions :: BuildInfo -> [Extension]allExtensions bi :: BuildInfobi
             , name :: PackageNamename elem :: Eq a => a -> [a] -> Bool`elem` map :: (a -> b) -> [a] -> [b]map display :: Text a => a -> Stringdisplay knownLanguages :: [Language]knownLanguages ]

    testedWithImpossibleRanges =
      [ Dependency :: PackageName -> VersionRange -> DependencyDependency (PackageName :: String -> PackageNamePackageName (display :: Text a => a -> Stringdisplay compiler :: CompilerFlavorcompiler)) vr :: VersionRangevr
      | (compiler, vr) <- testedWith ::
  PackageDescription -> [(CompilerFlavor, VersionRange)]testedWith pkg :: PackageDescriptionpkg
      , isNoVersion :: VersionRange -> BoolisNoVersion vr :: VersionRangevr ]


checkLicense :: PackageDescription -> [PackageCheck]
checkLicense pkg =
  catMaybes :: [Maybe a] -> [a]catMaybes [

    check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (license :: PackageDescription -> Licenselicense pkg :: PackageDescriptionpkg (==) :: Eq a => a -> a -> Bool== AllRightsReserved :: LicenseAllRightsReserved) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable
        "The 'license' field is missing or specified as AllRightsReserved."

  , case license :: PackageDescription -> Licenselicense pkg :: PackageDescriptionpkg of
      UnknownLicense l -> Just :: a -> Maybe aJust ($) :: (a -> b) -> a -> b$
        PackageBuildWarning :: String -> PackageCheckPackageBuildWarning ($) :: (a -> b) -> a -> b$
             quote :: String -> Stringquote ("license: " (++) :: [a] -> [a] -> [a]++ l :: Stringl) (++) :: [a] -> [a] -> [a]++ " is not a recognised license. The "
          (++) :: [a] -> [a] -> [a]++ "known licenses are: "
          (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep (map :: (a -> b) -> [a] -> [b]map display :: Text a => a -> Stringdisplay knownLicenses :: [License]knownLicenses)
      _ -> Nothing :: Maybe aNothing

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

  , case unknownLicenseVersion :: License -> Maybe [Version]unknownLicenseVersion (license :: PackageDescription -> Licenselicense pkg :: PackageDescriptionpkg) of
      Just knownVersions -> Just :: a -> Maybe aJust ($) :: (a -> b) -> a -> b$
        PackageDistSuspicious :: String -> PackageCheckPackageDistSuspicious ($) :: (a -> b) -> a -> b$
             "'license: " (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay (license :: PackageDescription -> Licenselicense pkg :: PackageDescriptionpkg) (++) :: [a] -> [a] -> [a]++ "' is not a known "
          (++) :: [a] -> [a] -> [a]++ "version of that license. The known versions are "
          (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep (map :: (a -> b) -> [a] -> [b]map display :: Text a => a -> Stringdisplay knownVersions :: [Version]knownVersions)
          (++) :: [a] -> [a] -> [a]++ ". If this is not a mistake and you think it should be a known "
          (++) :: [a] -> [a] -> [a]++ "version then please file a ticket."
      _ -> Nothing :: Maybe aNothing

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (license :: PackageDescription -> Licenselicense pkg :: PackageDescriptionpkg notElem :: Eq a => a -> [a] -> Bool`notElem` [AllRightsReserved :: LicenseAllRightsReserved, PublicDomain :: LicensePublicDomain]
           -- AllRightsReserved and PublicDomain are not strictly
           -- licenses so don't need license files.
        (&&) :: Bool -> Bool -> Bool&& null :: [a] -> Boolnull (licenseFile :: PackageDescription -> FilePathlicenseFile pkg :: PackageDescriptionpkg)) ($) :: (a -> b) -> a -> b$
      PackageDistSuspicious :: String -> PackageCheckPackageDistSuspicious "A 'license-file' is not specified."
  ]
  where
    unknownLicenseVersion (GPL  (Just v))
      | v :: tv notElem :: Eq a => a -> [a] -> Bool`notElem` knownVersions :: [Version]knownVersions = Just :: a -> Maybe aJust knownVersions :: [Version]knownVersions
      where knownVersions = [ v' :: Versionv' | GPL  (Just v') <- knownLicenses :: [License]knownLicenses ]
    unknownLicenseVersion (LGPL (Just v))
      | v :: tv notElem :: Eq a => a -> [a] -> Bool`notElem` knownVersions :: [Version]knownVersions = Just :: a -> Maybe aJust knownVersions :: [Version]knownVersions
      where knownVersions = [ v' :: Versionv' | LGPL (Just v') <- knownLicenses :: [License]knownLicenses ]
    unknownLicenseVersion _ = Nothing :: Maybe aNothing

checkSourceRepos :: PackageDescription -> [PackageCheck]
checkSourceRepos pkg =
  catMaybes :: [Maybe a] -> [a]catMaybes ($) :: (a -> b) -> a -> b$ concat :: [[a]] -> [a]concat [[

    case repoKind :: SourceRepo -> RepoKindrepoKind repo :: SourceReporepo of
      RepoKindUnknown kind -> Just :: a -> Maybe aJust ($) :: (a -> b) -> a -> b$ PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
        quote :: String -> Stringquote kind :: Stringkind (++) :: [a] -> [a] -> [a]++ " is not a recognised kind of source-repository. "
                   (++) :: [a] -> [a] -> [a]++ "The repo kind is usually 'head' or 'this'"
      _ -> Nothing :: Maybe aNothing

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (repoType :: SourceRepo -> Maybe RepoTyperepoType repo :: SourceReporepo (==) :: Eq a => a -> a -> Bool== Nothing :: Maybe aNothing) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable
        "The source-repository 'type' is a required field."

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (repoLocation :: SourceRepo -> Maybe StringrepoLocation repo :: SourceReporepo (==) :: Eq a => a -> a -> Bool== Nothing :: Maybe aNothing) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable
        "The source-repository 'location' is a required field."

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (repoType :: SourceRepo -> Maybe RepoTyperepoType repo :: SourceReporepo (==) :: Eq a => a -> a -> Bool== Just :: a -> Maybe aJust CVS :: RepoTypeCVS (&&) :: Bool -> Bool -> Bool&& repoModule :: SourceRepo -> Maybe StringrepoModule repo :: SourceReporepo (==) :: Eq a => a -> a -> Bool== Nothing :: Maybe aNothing) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable
        "For a CVS source-repository, the 'module' is a required field."

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

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (maybe :: b -> (a -> b) -> Maybe a -> bmaybe False :: BoolFalse isAbsolute :: FilePath -> BoolSystem.FilePath.isAbsolute (repoSubdir :: SourceRepo -> Maybe FilePathrepoSubdir repo :: SourceReporepo)) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable
        "The 'subdir' field of a source-repository must be a relative path."
  ]
  | repo <- sourceRepos :: PackageDescription -> [SourceRepo]sourceRepos pkg :: PackageDescriptionpkg ]

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

checkGhcOptions :: PackageDescription -> [PackageCheck]
checkGhcOptions pkg =
  catMaybes :: [Maybe a] -> [a]catMaybes [

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

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (not :: Bool -> Boolnot has_WerrorWall :: Boolhas_WerrorWall (&&) :: Bool -> Bool -> Bool&& has_Werror :: Boolhas_Werror) ($) :: (a -> b) -> a -> b$
      PackageDistSuspicious :: String -> PackageCheckPackageDistSuspicious ($) :: (a -> b) -> a -> b$
           "'ghc-options: -Werror' makes the package easy to "
        (++) :: [a] -> [a] -> [a]++ "break with future GHC versions because new GHC versions often "
        (++) :: [a] -> [a] -> [a]++ "add new warnings."

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

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

  , checkFlags :: [String] -> PackageCheck -> Maybe PackageCheckcheckFlags ["-fhpc"] ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
        "'ghc-options: -fhpc' is not appropriate for a distributed package."

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (any :: (a -> Bool) -> [a] -> Boolany ("-d" isPrefixOf :: Eq a => [a] -> [a] -> Bool`isPrefixOf`) all_ghc_options :: [String]all_ghc_options) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
        "'ghc-options: -d*' debug flags are not appropriate for a distributed package."

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

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

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

  , checkFlags :: [String] -> PackageCheck -> Maybe PackageCheckcheckFlags ["--make"] ($) :: (a -> b) -> a -> b$
      PackageBuildWarning :: String -> PackageCheckPackageBuildWarning ($) :: (a -> b) -> a -> b$
        "'ghc-options: --make' is never needed. Cabal uses this automatically."

  , checkFlags :: [String] -> PackageCheck -> Maybe PackageCheckcheckFlags ["-main-is"] ($) :: (a -> b) -> a -> b$
      PackageDistSuspicious :: String -> PackageCheckPackageDistSuspicious ($) :: (a -> b) -> a -> b$
           "'ghc-options: -main-is' is not portable."

  , checkFlags :: [String] -> PackageCheck -> Maybe PackageCheckcheckFlags ["-O0", "-Onot"] ($) :: (a -> b) -> a -> b$
      PackageDistSuspicious :: String -> PackageCheckPackageDistSuspicious ($) :: (a -> b) -> a -> b$
        "'ghc-options: -O0' is not needed. Use the --disable-optimization configure flag."

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

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

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

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

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

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck ("-threaded" elem :: Eq a => a -> [a] -> Bool`elem` lib_ghc_options :: [String]lib_ghc_options) ($) :: (a -> b) -> a -> b$
      PackageDistSuspicious :: String -> PackageCheckPackageDistSuspicious ($) :: (a -> b) -> a -> b$
           "'ghc-options: -threaded' has no effect for libraries. It should "
        (++) :: [a] -> [a] -> [a]++ "only be used for executables."

  , checkAlternatives ::
  String -> String -> [(String, String)] -> Maybe PackageCheckcheckAlternatives "ghc-options" "extensions"
      [ (flag :: Stringflag, display :: Text a => a -> Stringdisplay extension :: [Char]extension) | flag <- all_ghc_options :: [String]all_ghc_options
                                  , Just extension <- [ghcExtension :: [Char] -> Maybe ExtensionghcExtension flag :: Stringflag] ]

  , checkAlternatives ::
  String -> String -> [(String, String)] -> Maybe PackageCheckcheckAlternatives "ghc-options" "extensions"
      [ (flag :: Stringflag, extension :: [Char]extension) | flag@('-':'X':extension) <- all_ghc_options :: [String]all_ghc_options ]

  , checkAlternatives ::
  String -> String -> [(String, String)] -> Maybe PackageCheckcheckAlternatives "ghc-options" "cpp-options" ($) :: (a -> b) -> a -> b$
         [ (flag :: Stringflag, flag :: Stringflag) | flag@('-':'D':_) <- all_ghc_options :: [String]all_ghc_options ]
      (++) :: [a] -> [a] -> [a]++ [ (flag :: Stringflag, flag :: Stringflag) | flag@('-':'U':_) <- all_ghc_options :: [String]all_ghc_options ]

  , checkAlternatives ::
  String -> String -> [(String, String)] -> Maybe PackageCheckcheckAlternatives "ghc-options" "include-dirs"
      [ (flag :: Stringflag, dir :: [Char]dir) | flag@('-':'I':dir) <- all_ghc_options :: [String]all_ghc_options ]

  , checkAlternatives ::
  String -> String -> [(String, String)] -> Maybe PackageCheckcheckAlternatives "ghc-options" "extra-libraries"
      [ (flag :: Stringflag, lib :: [Char]lib) | flag@('-':'l':lib) <- all_ghc_options :: [String]all_ghc_options ]

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

  where
    has_WerrorWall = flip :: (a -> b -> c) -> b -> a -> cflip any :: (a -> Bool) -> [a] -> Boolany ghc_options :: [[String]]ghc_options ($) :: (a -> b) -> a -> b$ \opts ->
                               "-Werror" elem :: Eq a => a -> [a] -> Bool`elem` opts :: Stringopts
                           (&&) :: Bool -> Bool -> Bool&& ("-Wall"   elem :: Eq a => a -> [a] -> Bool`elem` opts :: Stringopts (||) :: Bool -> Bool -> Bool|| "-W" elem :: Eq a => a -> [a] -> Bool`elem` opts :: Stringopts)
    has_Werror     = any :: (a -> Bool) -> [a] -> Boolany (\opts -> "-Werror" elem :: Eq a => a -> [a] -> Bool`elem` opts :: Stringopts) ghc_options :: [[String]]ghc_options

    ghc_options = [ strs :: [String]strs | bi <- allBuildInfo :: PackageDescription -> [BuildInfo]allBuildInfo pkg :: PackageDescriptionpkg
                         , (GHC, strs) <- options :: BuildInfo -> [(CompilerFlavor, [String])]options bi :: BuildInfobi ]
    all_ghc_options = concat :: [[a]] -> [a]concat ghc_options :: [[String]]ghc_options
    lib_ghc_options = maybe :: b -> (a -> b) -> Maybe a -> bmaybe [] :: [a][] (hcOptions :: CompilerFlavor -> BuildInfo -> [String]hcOptions GHC :: CompilerFlavorGHC (.) :: (b -> c) -> (a -> b) -> a -> c. libBuildInfo :: Library -> BuildInfolibBuildInfo) (library :: PackageDescription -> Maybe Librarylibrary pkg :: PackageDescriptionpkg)

    checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
    checkFlags flags = check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (any :: (a -> Bool) -> [a] -> Boolany (elem :: Eq a => a -> [a] -> Bool`elem` flags :: [String]flags) all_ghc_options :: [String]all_ghc_options)

    ghcExtension ('-':'f':name) = case name :: PackageNamename of
      "allow-overlapping-instances"    -> Just :: a -> Maybe aJust (EnableExtension :: KnownExtension -> ExtensionEnableExtension  OverlappingInstances :: KnownExtensionOverlappingInstances)
      "no-allow-overlapping-instances" -> Just :: a -> Maybe aJust (DisableExtension :: KnownExtension -> ExtensionDisableExtension OverlappingInstances :: KnownExtensionOverlappingInstances)
      "th"                             -> Just :: a -> Maybe aJust (EnableExtension :: KnownExtension -> ExtensionEnableExtension  TemplateHaskell :: KnownExtensionTemplateHaskell)
      "no-th"                          -> Just :: a -> Maybe aJust (DisableExtension :: KnownExtension -> ExtensionDisableExtension TemplateHaskell :: KnownExtensionTemplateHaskell)
      "ffi"                            -> Just :: a -> Maybe aJust (EnableExtension :: KnownExtension -> ExtensionEnableExtension  ForeignFunctionInterface :: KnownExtensionForeignFunctionInterface)
      "no-ffi"                         -> Just :: a -> Maybe aJust (DisableExtension :: KnownExtension -> ExtensionDisableExtension ForeignFunctionInterface :: KnownExtensionForeignFunctionInterface)
      "fi"                             -> Just :: a -> Maybe aJust (EnableExtension :: KnownExtension -> ExtensionEnableExtension  ForeignFunctionInterface :: KnownExtensionForeignFunctionInterface)
      "no-fi"                          -> Just :: a -> Maybe aJust (DisableExtension :: KnownExtension -> ExtensionDisableExtension ForeignFunctionInterface :: KnownExtensionForeignFunctionInterface)
      "monomorphism-restriction"       -> Just :: a -> Maybe aJust (EnableExtension :: KnownExtension -> ExtensionEnableExtension  MonomorphismRestriction :: KnownExtensionMonomorphismRestriction)
      "no-monomorphism-restriction"    -> Just :: a -> Maybe aJust (DisableExtension :: KnownExtension -> ExtensionDisableExtension MonomorphismRestriction :: KnownExtensionMonomorphismRestriction)
      "mono-pat-binds"                 -> Just :: a -> Maybe aJust (EnableExtension :: KnownExtension -> ExtensionEnableExtension  MonoPatBinds :: KnownExtensionMonoPatBinds)
      "no-mono-pat-binds"              -> Just :: a -> Maybe aJust (DisableExtension :: KnownExtension -> ExtensionDisableExtension MonoPatBinds :: KnownExtensionMonoPatBinds)
      "allow-undecidable-instances"    -> Just :: a -> Maybe aJust (EnableExtension :: KnownExtension -> ExtensionEnableExtension  UndecidableInstances :: KnownExtensionUndecidableInstances)
      "no-allow-undecidable-instances" -> Just :: a -> Maybe aJust (DisableExtension :: KnownExtension -> ExtensionDisableExtension UndecidableInstances :: KnownExtensionUndecidableInstances)
      "allow-incoherent-instances"     -> Just :: a -> Maybe aJust (EnableExtension :: KnownExtension -> ExtensionEnableExtension  IncoherentInstances :: KnownExtensionIncoherentInstances)
      "no-allow-incoherent-instances"  -> Just :: a -> Maybe aJust (DisableExtension :: KnownExtension -> ExtensionDisableExtension IncoherentInstances :: KnownExtensionIncoherentInstances)
      "arrows"                         -> Just :: a -> Maybe aJust (EnableExtension :: KnownExtension -> ExtensionEnableExtension  Arrows :: KnownExtensionArrows)
      "no-arrows"                      -> Just :: a -> Maybe aJust (DisableExtension :: KnownExtension -> ExtensionDisableExtension Arrows :: KnownExtensionArrows)
      "generics"                       -> Just :: a -> Maybe aJust (EnableExtension :: KnownExtension -> ExtensionEnableExtension  Generics :: KnownExtensionGenerics)
      "no-generics"                    -> Just :: a -> Maybe aJust (DisableExtension :: KnownExtension -> ExtensionDisableExtension Generics :: KnownExtensionGenerics)
      "implicit-prelude"               -> Just :: a -> Maybe aJust (EnableExtension :: KnownExtension -> ExtensionEnableExtension  ImplicitPrelude :: KnownExtensionImplicitPrelude)
      "no-implicit-prelude"            -> Just :: a -> Maybe aJust (DisableExtension :: KnownExtension -> ExtensionDisableExtension ImplicitPrelude :: KnownExtensionImplicitPrelude)
      "implicit-params"                -> Just :: a -> Maybe aJust (EnableExtension :: KnownExtension -> ExtensionEnableExtension  ImplicitParams :: KnownExtensionImplicitParams)
      "no-implicit-params"             -> Just :: a -> Maybe aJust (DisableExtension :: KnownExtension -> ExtensionDisableExtension ImplicitParams :: KnownExtensionImplicitParams)
      "bang-patterns"                  -> Just :: a -> Maybe aJust (EnableExtension :: KnownExtension -> ExtensionEnableExtension  BangPatterns :: KnownExtensionBangPatterns)
      "no-bang-patterns"               -> Just :: a -> Maybe aJust (DisableExtension :: KnownExtension -> ExtensionDisableExtension BangPatterns :: KnownExtensionBangPatterns)
      "scoped-type-variables"          -> Just :: a -> Maybe aJust (EnableExtension :: KnownExtension -> ExtensionEnableExtension  ScopedTypeVariables :: KnownExtensionScopedTypeVariables)
      "no-scoped-type-variables"       -> Just :: a -> Maybe aJust (DisableExtension :: KnownExtension -> ExtensionDisableExtension ScopedTypeVariables :: KnownExtensionScopedTypeVariables)
      "extended-default-rules"         -> Just :: a -> Maybe aJust (EnableExtension :: KnownExtension -> ExtensionEnableExtension  ExtendedDefaultRules :: KnownExtensionExtendedDefaultRules)
      "no-extended-default-rules"      -> Just :: a -> Maybe aJust (DisableExtension :: KnownExtension -> ExtensionDisableExtension ExtendedDefaultRules :: KnownExtensionExtendedDefaultRules)
      _                                -> Nothing :: Maybe aNothing
    ghcExtension "-cpp"             = Just :: a -> Maybe aJust (EnableExtension :: KnownExtension -> ExtensionEnableExtension CPP :: KnownExtensionCPP)
    ghcExtension _                  = Nothing :: Maybe aNothing

checkCCOptions :: PackageDescription -> [PackageCheck]
checkCCOptions pkg =
  catMaybes :: [Maybe a] -> [a]catMaybes [

    checkAlternatives ::
  String -> String -> [(String, String)] -> Maybe PackageCheckcheckAlternatives "cc-options" "include-dirs"
      [ (flag :: Stringflag, dir :: [Char]dir) | flag@('-':'I':dir) <- all_ccOptions :: [String]all_ccOptions ]

  , checkAlternatives ::
  String -> String -> [(String, String)] -> Maybe PackageCheckcheckAlternatives "cc-options" "extra-libraries"
      [ (flag :: Stringflag, lib :: [Char]lib) | flag@('-':'l':lib) <- all_ccOptions :: [String]all_ccOptions ]

  , checkAlternatives ::
  String -> String -> [(String, String)] -> Maybe PackageCheckcheckAlternatives "cc-options" "extra-lib-dirs"
      [ (flag :: Stringflag, dir :: [Char]dir) | flag@('-':'L':dir) <- all_ccOptions :: [String]all_ccOptions ]

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

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

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

  where all_ccOptions = [ opts :: Stringopts | bi <- allBuildInfo :: PackageDescription -> [BuildInfo]allBuildInfo pkg :: PackageDescriptionpkg
                              , opts <- ccOptions :: BuildInfo -> [String]ccOptions bi :: BuildInfobi ]
        all_ldOptions = [ opts :: Stringopts | bi <- allBuildInfo :: PackageDescription -> [BuildInfo]allBuildInfo pkg :: PackageDescriptionpkg
                               , opts <- ldOptions :: BuildInfo -> [String]ldOptions bi :: BuildInfobi ]

        checkCCFlags :: [String] -> PackageCheck -> Maybe PackageCheck
        checkCCFlags flags = check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (any :: (a -> Bool) -> [a] -> Boolany (elem :: Eq a => a -> [a] -> Bool`elem` flags :: [String]flags) all_ccOptions :: [String]all_ccOptions)

checkAlternatives :: String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives badField goodField flags =
  check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (not :: Bool -> Boolnot (null :: [a] -> Boolnull badFlags :: [String]badFlags)) ($) :: (a -> b) -> a -> b$
    PackageBuildWarning :: String -> PackageCheckPackageBuildWarning ($) :: (a -> b) -> a -> b$
         "Instead of " (++) :: [a] -> [a] -> [a]++ quote :: String -> Stringquote (badField :: StringbadField (++) :: [a] -> [a] -> [a]++ ": " (++) :: [a] -> [a] -> [a]++ unwords :: [String] -> Stringunwords badFlags :: [String]badFlags)
      (++) :: [a] -> [a] -> [a]++ " use " (++) :: [a] -> [a] -> [a]++ quote :: String -> Stringquote (goodField :: StringgoodField (++) :: [a] -> [a] -> [a]++ ": " (++) :: [a] -> [a] -> [a]++ unwords :: [String] -> Stringunwords goodFlags :: [String]goodFlags)

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

checkPaths :: PackageDescription -> [PackageCheck]
checkPaths pkg =
  [ PackageBuildWarning :: String -> PackageCheckPackageBuildWarning ($) :: (a -> b) -> a -> b$
         quote :: String -> Stringquote (kind :: Stringkind (++) :: [a] -> [a] -> [a]++ ": " (++) :: [a] -> [a] -> [a]++ path :: FilePathpath)
      (++) :: [a] -> [a] -> [a]++ " is a relative path outside of the source tree. "
      (++) :: [a] -> [a] -> [a]++ "This will not work when generating a tarball with 'sdist'."
  | (path, kind) <- relPaths :: [(FilePath, [Char])]relPaths (++) :: [a] -> [a] -> [a]++ absPaths :: [(FilePath, [Char])]absPaths
  , isOutsideTree :: FilePath -> BoolisOutsideTree path :: FilePathpath ]
  (++) :: [a] -> [a] -> [a]++
  [ PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
      quote :: String -> Stringquote (kind :: Stringkind (++) :: [a] -> [a] -> [a]++ ": " (++) :: [a] -> [a] -> [a]++ path :: FilePathpath) (++) :: [a] -> [a] -> [a]++ " is an absolute directory."
  | (path, kind) <- relPaths :: [(FilePath, [Char])]relPaths
  , isAbsolute :: FilePath -> BoolisAbsolute path :: FilePathpath ]
  (++) :: [a] -> [a] -> [a]++
  [ PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
         quote :: String -> Stringquote (kind :: Stringkind (++) :: [a] -> [a] -> [a]++ ": " (++) :: [a] -> [a] -> [a]++ path :: FilePathpath) (++) :: [a] -> [a] -> [a]++ " points inside the 'dist' "
      (++) :: [a] -> [a] -> [a]++ "directory. This is not reliable because the location of this "
      (++) :: [a] -> [a] -> [a]++ "directory is configurable by the user (or package manager). In "
      (++) :: [a] -> [a] -> [a]++ "addition the layout of the 'dist' directory is subject to change "
      (++) :: [a] -> [a] -> [a]++ "in future versions of Cabal."
  | (path, kind) <- relPaths :: [(FilePath, [Char])]relPaths (++) :: [a] -> [a] -> [a]++ absPaths :: [(FilePath, [Char])]absPaths
  , isInsideDist :: FilePath -> BoolisInsideDist path :: FilePathpath ]
  (++) :: [a] -> [a] -> [a]++
  [ PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
         "The 'ghc-options' contains the path '" (++) :: [a] -> [a] -> [a]++ path :: FilePathpath (++) :: [a] -> [a] -> [a]++ "' which points "
      (++) :: [a] -> [a] -> [a]++ "inside the 'dist' directory. This is not reliable because the "
      (++) :: [a] -> [a] -> [a]++ "location of this directory is configurable by the user (or package "
      (++) :: [a] -> [a] -> [a]++ "manager). In addition the layout of the 'dist' directory is subject "
      (++) :: [a] -> [a] -> [a]++ "to change in future versions of Cabal."
  | bi <- allBuildInfo :: PackageDescription -> [BuildInfo]allBuildInfo pkg :: PackageDescriptionpkg
  , (GHC, flags) <- options :: BuildInfo -> [(CompilerFlavor, [String])]options bi :: BuildInfobi
  , path <- flags :: [String]flags
  , isInsideDist :: FilePath -> BoolisInsideDist path :: FilePathpath ]
  where
    isOutsideTree path = case splitDirectories :: FilePath -> [FilePath]splitDirectories path :: FilePathpath of
      "..":_     -> True :: BoolTrue
      ".":"..":_ -> True :: BoolTrue
      _          -> False :: BoolFalse
    isInsideDist path = case map :: (a -> b) -> [a] -> [b]map lowercase :: String -> Stringlowercase (splitDirectories :: FilePath -> [FilePath]splitDirectories path :: FilePathpath) of
      "dist"    :_ -> True :: BoolTrue
      ".":"dist":_ -> True :: BoolTrue
      _            -> False :: BoolFalse
    -- paths that must be relative
    relPaths =
         [ (path :: FilePathpath, "extra-src-files") | path <- extraSrcFiles :: PackageDescription -> [FilePath]extraSrcFiles pkg :: PackageDescriptionpkg ]
      (++) :: [a] -> [a] -> [a]++ [ (path :: FilePathpath, "extra-tmp-files") | path <- extraTmpFiles :: PackageDescription -> [FilePath]extraTmpFiles pkg :: PackageDescriptionpkg ]
      (++) :: [a] -> [a] -> [a]++ [ (path :: FilePathpath, "data-files")      | path <- dataFiles :: PackageDescription -> [FilePath]dataFiles     pkg :: PackageDescriptionpkg ]
      (++) :: [a] -> [a] -> [a]++ [ (path :: FilePathpath, "data-dir")        | path <- [dataDir :: PackageDescription -> FilePathdataDir      pkg :: PackageDescriptionpkg]]
      (++) :: [a] -> [a] -> [a]++ concat :: [[a]] -> [a]concat
         [    [ (path :: FilePathpath, "c-sources")        | path <- cSources :: BuildInfo -> [FilePath]cSources        bi :: BuildInfobi ]
           (++) :: [a] -> [a] -> [a]++ [ (path :: FilePathpath, "install-includes") | path <- installIncludes :: BuildInfo -> [FilePath]installIncludes bi :: BuildInfobi ]
           (++) :: [a] -> [a] -> [a]++ [ (path :: FilePathpath, "hs-source-dirs")   | path <- hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs    bi :: BuildInfobi ]
         | bi <- allBuildInfo :: PackageDescription -> [BuildInfo]allBuildInfo pkg :: PackageDescriptionpkg ]
    -- paths that are allowed to be absolute
    absPaths = concat :: [[a]] -> [a]concat
      [    [ (path :: FilePathpath, "includes")         | path <- includes :: BuildInfo -> [FilePath]includes        bi :: BuildInfobi ]
        (++) :: [a] -> [a] -> [a]++ [ (path :: FilePathpath, "include-dirs")     | path <- includeDirs :: BuildInfo -> [FilePath]includeDirs     bi :: BuildInfobi ]
        (++) :: [a] -> [a] -> [a]++ [ (path :: FilePathpath, "extra-lib-dirs")   | path <- extraLibDirs :: BuildInfo -> [String]extraLibDirs    bi :: BuildInfobi ]
      | bi <- allBuildInfo :: PackageDescription -> [BuildInfo]allBuildInfo pkg :: PackageDescriptionpkg ]

--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 pkg =
  catMaybes :: [Maybe a] -> [a]catMaybes [

    -- check syntax of cabal-version field
    check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (specVersion :: PackageDescription -> VersionspecVersion pkg :: PackageDescriptionpkg (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [1,10] [] :: [a][]
           (&&) :: Bool -> Bool -> Bool&& not :: Bool -> Boolnot simpleSpecVersionRangeSyntax :: BoolsimpleSpecVersionRangeSyntax) ($) :: (a -> b) -> a -> b$
      PackageBuildWarning :: String -> PackageCheckPackageBuildWarning ($) :: (a -> b) -> a -> b$
           "Packages relying on Cabal 1.10 or later must only specify a "
        (++) :: [a] -> [a] -> [a]++ "version range of the form 'cabal-version: >= x.y'. Use "
        (++) :: [a] -> [a] -> [a]++ "'cabal-version: >= " (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay (specVersion :: PackageDescription -> VersionspecVersion pkg :: PackageDescriptionpkg) (++) :: [a] -> [a] -> [a]++ "'."

    -- check syntax of cabal-version field
  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (specVersion :: PackageDescription -> VersionspecVersion pkg :: PackageDescriptionpkg (<) :: Ord a => a -> a -> Bool< Version :: [Int] -> [String] -> VersionVersion [1,9] [] :: [a][]
           (&&) :: Bool -> Bool -> Bool&& not :: Bool -> Boolnot simpleSpecVersionRangeSyntax :: BoolsimpleSpecVersionRangeSyntax) ($) :: (a -> b) -> a -> b$
      PackageDistSuspicious :: String -> PackageCheckPackageDistSuspicious ($) :: (a -> b) -> a -> b$
           "It is recommended that the 'cabal-version' field only specify a "
        (++) :: [a] -> [a] -> [a]++ "version range of the form '>= x.y'. Use "
        (++) :: [a] -> [a] -> [a]++ "'cabal-version: >= " (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay (specVersion :: PackageDescription -> VersionspecVersion pkg :: PackageDescriptionpkg) (++) :: [a] -> [a] -> [a]++ "'. "
        (++) :: [a] -> [a] -> [a]++ "Tools based on Cabal 1.10 and later will ignore upper bounds."

    -- check syntax of cabal-version field
  , checkVersion :: [Int] -> Bool -> PackageCheck -> Maybe PackageCheckcheckVersion [1,12] simpleSpecVersionSyntax :: BoolsimpleSpecVersionSyntax ($) :: (a -> b) -> a -> b$
      PackageBuildWarning :: String -> PackageCheckPackageBuildWarning ($) :: (a -> b) -> a -> b$
           "With Cabal 1.10 or earlier, the 'cabal-version' field must use "
        (++) :: [a] -> [a] -> [a]++ "range syntax rather than a simple version number. Use "
        (++) :: [a] -> [a] -> [a]++ "'cabal-version: >= " (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay (specVersion :: PackageDescription -> VersionspecVersion pkg :: PackageDescriptionpkg) (++) :: [a] -> [a] -> [a]++ "'."

    -- check use of test suite sections
  , checkVersion :: [Int] -> Bool -> PackageCheck -> Maybe PackageCheckcheckVersion [1,8] (not :: Bool -> Boolnot (null :: [a] -> Boolnull ($) :: (a -> b) -> a -> b$ testSuites :: PackageDescription -> [TestSuite]testSuites pkg :: PackageDescriptionpkg)) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
           "The 'test-suite' section is new in Cabal 1.10. "
        (++) :: [a] -> [a] -> [a]++ "Unfortunately it messes up the parser in older Cabal versions "
        (++) :: [a] -> [a] -> [a]++ "so you must specify at least 'cabal-version: >= 1.8', but note"
        (++) :: [a] -> [a] -> [a]++ "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
  , checkVersion :: [Int] -> Bool -> PackageCheck -> Maybe PackageCheckcheckVersion [1,10] (any :: (a -> Bool) -> [a] -> Boolany isJust :: Maybe a -> BoolisJust (buildInfoField :: (BuildInfo -> b) -> [b]buildInfoField defaultLanguage :: BuildInfo -> Maybe LanguagedefaultLanguage)) ($) :: (a -> b) -> a -> b$
      PackageBuildWarning :: String -> PackageCheckPackageBuildWarning ($) :: (a -> b) -> a -> b$
           "To use the 'default-language' field the package needs to specify "
        (++) :: [a] -> [a] -> [a]++ "at least 'cabal-version: >= 1.10'."

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (specVersion :: PackageDescription -> VersionspecVersion pkg :: PackageDescriptionpkg (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [1,10] [] :: [a][]
           (&&) :: Bool -> Bool -> Bool&& (any :: (a -> Bool) -> [a] -> Boolany isNothing :: Maybe a -> BoolisNothing (buildInfoField :: (BuildInfo -> b) -> [b]buildInfoField defaultLanguage :: BuildInfo -> Maybe LanguagedefaultLanguage))) ($) :: (a -> b) -> a -> b$
      PackageBuildWarning :: String -> PackageCheckPackageBuildWarning ($) :: (a -> b) -> a -> b$
           "Packages using 'cabal-version: >= 1.10' must specify the "
        (++) :: [a] -> [a] -> [a]++ "'default-language' field for each component (e.g. Haskell98 or "
        (++) :: [a] -> [a] -> [a]++ "Haskell2010). If a component uses different languages in "
        (++) :: [a] -> [a] -> [a]++ "different modules then list the other ones in the "
        (++) :: [a] -> [a] -> [a]++ "'other-languages' field."

    -- check use of default-extensions field
    -- don't need to do the equivalent check for other-extensions
  , checkVersion :: [Int] -> Bool -> PackageCheck -> Maybe PackageCheckcheckVersion [1,10] (any :: (a -> Bool) -> [a] -> Boolany (not :: Bool -> Boolnot (.) :: (b -> c) -> (a -> b) -> a -> c. null :: [a] -> Boolnull) (buildInfoField :: (BuildInfo -> b) -> [b]buildInfoField defaultExtensions :: BuildInfo -> [Extension]defaultExtensions)) ($) :: (a -> b) -> a -> b$
      PackageBuildWarning :: String -> PackageCheckPackageBuildWarning ($) :: (a -> b) -> a -> b$
           "To use the 'default-extensions' field the package needs to specify "
        (++) :: [a] -> [a] -> [a]++ "at least 'cabal-version: >= 1.10'."

    -- check use of extensions field
  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (specVersion :: PackageDescription -> VersionspecVersion pkg :: PackageDescriptionpkg (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [1,10] [] :: [a][]
           (&&) :: Bool -> Bool -> Bool&& (any :: (a -> Bool) -> [a] -> Boolany (not :: Bool -> Boolnot (.) :: (b -> c) -> (a -> b) -> a -> c. null :: [a] -> Boolnull) (buildInfoField :: (BuildInfo -> b) -> [b]buildInfoField oldExtensions :: BuildInfo -> [Extension]oldExtensions))) ($) :: (a -> b) -> a -> b$
      PackageBuildWarning :: String -> PackageCheckPackageBuildWarning ($) :: (a -> b) -> a -> b$
           "For packages using 'cabal-version: >= 1.10' the 'extensions' "
        (++) :: [a] -> [a] -> [a]++ "field is deprecated. The new 'default-extensions' field lists "
        (++) :: [a] -> [a] -> [a]++ "extensions that are used in all modules in the component, while "
        (++) :: [a] -> [a] -> [a]++ "the 'other-extensions' field lists extensions that are used in "
        (++) :: [a] -> [a] -> [a]++ "some modules, e.g. via the {-# LANGUAGE #-} pragma."

    -- check use of "foo (>= 1.0 && < 1.4) || >=1.8 " version-range syntax
  , checkVersion :: [Int] -> Bool -> PackageCheck -> Maybe PackageCheckcheckVersion [1,8] (not :: Bool -> Boolnot (null :: [a] -> Boolnull versionRangeExpressions :: [Dependency]versionRangeExpressions)) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
           "The package uses full version-range expressions "
        (++) :: [a] -> [a] -> [a]++ "in a 'build-depends' field: "
        (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep (map :: (a -> b) -> [a] -> [b]map displayRawDependency :: Dependency -> StringdisplayRawDependency versionRangeExpressions :: [Dependency]versionRangeExpressions)
        (++) :: [a] -> [a] -> [a]++ ". To use this new syntax the package needs to specify at least "
        (++) :: [a] -> [a] -> [a]++ "'cabal-version: >= 1.8'. Alternatively, if broader compatibility "
        (++) :: [a] -> [a] -> [a]++ "is important, then convert to conjunctive normal form, and use "
        (++) :: [a] -> [a] -> [a]++ "multiple 'build-depends:' lines, one conjunct per line."

    -- check use of "build-depends: foo == 1.*" syntax
  , checkVersion :: [Int] -> Bool -> PackageCheck -> Maybe PackageCheckcheckVersion [1,6] (not :: Bool -> Boolnot (null :: [a] -> Boolnull depsUsingWildcardSyntax :: [Dependency]depsUsingWildcardSyntax)) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
           "The package uses wildcard syntax in the 'build-depends' field: "
        (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep (map :: (a -> b) -> [a] -> [b]map display :: Text a => a -> Stringdisplay depsUsingWildcardSyntax :: [Dependency]depsUsingWildcardSyntax)
        (++) :: [a] -> [a] -> [a]++ ". To use this new syntax the package need to specify at least "
        (++) :: [a] -> [a] -> [a]++ "'cabal-version: >= 1.6'. Alternatively, if broader compatability "
        (++) :: [a] -> [a] -> [a]++ "is important then use: " (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep
           [ display :: Text a => a -> Stringdisplay (Dependency :: PackageName -> VersionRange -> DependencyDependency name :: PackageNamename (eliminateWildcardSyntax :: VersionRange -> VersionRangeeliminateWildcardSyntax versionRange :: VersionRangeversionRange))
           | Dependency name versionRange <- depsUsingWildcardSyntax :: [Dependency]depsUsingWildcardSyntax ]

    -- check use of "tested-with: GHC (>= 1.0 && < 1.4) || >=1.8 " syntax
  , checkVersion :: [Int] -> Bool -> PackageCheck -> Maybe PackageCheckcheckVersion [1,8] (not :: Bool -> Boolnot (null :: [a] -> Boolnull testedWithVersionRangeExpressions :: [Dependency]testedWithVersionRangeExpressions)) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
           "The package uses full version-range expressions "
        (++) :: [a] -> [a] -> [a]++ "in a 'tested-with' field: "
        (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep (map :: (a -> b) -> [a] -> [b]map displayRawDependency :: Dependency -> StringdisplayRawDependency testedWithVersionRangeExpressions :: [Dependency]testedWithVersionRangeExpressions)
        (++) :: [a] -> [a] -> [a]++ ". To use this new syntax the package needs to specify at least "
        (++) :: [a] -> [a] -> [a]++ "'cabal-version: >= 1.8'."

    -- check use of "tested-with: GHC == 6.12.*" syntax
  , checkVersion :: [Int] -> Bool -> PackageCheck -> Maybe PackageCheckcheckVersion [1,6] (not :: Bool -> Boolnot (null :: [a] -> Boolnull testedWithUsingWildcardSyntax :: [Dependency]testedWithUsingWildcardSyntax)) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
           "The package uses wildcard syntax in the 'tested-with' field: "
        (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep (map :: (a -> b) -> [a] -> [b]map display :: Text a => a -> Stringdisplay testedWithUsingWildcardSyntax :: [Dependency]testedWithUsingWildcardSyntax)
        (++) :: [a] -> [a] -> [a]++ ". To use this new syntax the package need to specify at least "
        (++) :: [a] -> [a] -> [a]++ "'cabal-version: >= 1.6'. Alternatively, if broader compatability "
        (++) :: [a] -> [a] -> [a]++ "is important then use: " (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep
           [ display :: Text a => a -> Stringdisplay (Dependency :: PackageName -> VersionRange -> DependencyDependency name :: PackageNamename (eliminateWildcardSyntax :: VersionRange -> VersionRangeeliminateWildcardSyntax versionRange :: VersionRangeversionRange))
           | Dependency name versionRange <- testedWithUsingWildcardSyntax :: [Dependency]testedWithUsingWildcardSyntax ]

    -- check use of "data-files: data/*.txt" syntax
  , checkVersion :: [Int] -> Bool -> PackageCheck -> Maybe PackageCheckcheckVersion [1,6] (not :: Bool -> Boolnot (null :: [a] -> Boolnull dataFilesUsingGlobSyntax :: [FilePath]dataFilesUsingGlobSyntax)) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
           "Using wildcards like "
        (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep (map :: (a -> b) -> [a] -> [b]map quote :: String -> Stringquote ($) :: (a -> b) -> a -> b$ take :: Int -> [a] -> [a]take 3 dataFilesUsingGlobSyntax :: [FilePath]dataFilesUsingGlobSyntax)
        (++) :: [a] -> [a] -> [a]++ " in the 'data-files' field requires 'cabal-version: >= 1.6'. "
        (++) :: [a] -> [a] -> [a]++ "Alternatively if you require compatability with earlier Cabal "
        (++) :: [a] -> [a] -> [a]++ "versions then list all the files explicitly."

    -- check use of "extra-source-files: mk/*.in" syntax
  , checkVersion :: [Int] -> Bool -> PackageCheck -> Maybe PackageCheckcheckVersion [1,6] (not :: Bool -> Boolnot (null :: [a] -> Boolnull extraSrcFilesUsingGlobSyntax :: [FilePath]extraSrcFilesUsingGlobSyntax)) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
           "Using wildcards like "
        (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep (map :: (a -> b) -> [a] -> [b]map quote :: String -> Stringquote ($) :: (a -> b) -> a -> b$ take :: Int -> [a] -> [a]take 3 extraSrcFilesUsingGlobSyntax :: [FilePath]extraSrcFilesUsingGlobSyntax)
        (++) :: [a] -> [a] -> [a]++ " in the 'extra-source-files' field requires "
        (++) :: [a] -> [a] -> [a]++ "'cabal-version: >= 1.6'. Alternatively if you require "
        (++) :: [a] -> [a] -> [a]++ "compatability with earlier Cabal versions then list all the files "
        (++) :: [a] -> [a] -> [a]++ "explicitly."

    -- check use of "source-repository" section
  , checkVersion :: [Int] -> Bool -> PackageCheck -> Maybe PackageCheckcheckVersion [1,6] (not :: Bool -> Boolnot (null :: [a] -> Boolnull (sourceRepos :: PackageDescription -> [SourceRepo]sourceRepos pkg :: PackageDescriptionpkg))) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
           "The 'source-repository' section is new in Cabal 1.6. "
        (++) :: [a] -> [a] -> [a]++ "Unfortunately it messes up the parser in earlier Cabal versions "
        (++) :: [a] -> [a] -> [a]++ "so you need to specify 'cabal-version: >= 1.6'."

    -- check for new licenses
  , checkVersion :: [Int] -> Bool -> PackageCheck -> Maybe PackageCheckcheckVersion [1,4] (license :: PackageDescription -> Licenselicense pkg :: PackageDescriptionpkg notElem :: Eq a => a -> [a] -> Bool`notElem` compatLicenses :: [License]compatLicenses) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
           "Unfortunately the license " (++) :: [a] -> [a] -> [a]++ quote :: String -> Stringquote (display :: Text a => a -> Stringdisplay (license :: PackageDescription -> Licenselicense pkg :: PackageDescriptionpkg))
        (++) :: [a] -> [a] -> [a]++ " messes up the parser in earlier Cabal versions so you need to "
        (++) :: [a] -> [a] -> [a]++ "specify 'cabal-version: >= 1.4'. Alternatively if you require "
        (++) :: [a] -> [a] -> [a]++ "compatability with earlier Cabal versions then use 'OtherLicense'."

    -- check for new language extensions
  , checkVersion :: [Int] -> Bool -> PackageCheck -> Maybe PackageCheckcheckVersion [1,2,3] (not :: Bool -> Boolnot (null :: [a] -> Boolnull mentionedExtensionsThatNeedCabal12 :: [Extension]mentionedExtensionsThatNeedCabal12)) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
           "Unfortunately the language extensions "
        (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep (map :: (a -> b) -> [a] -> [b]map (quote :: String -> Stringquote (.) :: (b -> c) -> (a -> b) -> a -> c. display :: Text a => a -> Stringdisplay) mentionedExtensionsThatNeedCabal12 :: [Extension]mentionedExtensionsThatNeedCabal12)
        (++) :: [a] -> [a] -> [a]++ " break the parser in earlier Cabal versions so you need to "
        (++) :: [a] -> [a] -> [a]++ "specify 'cabal-version: >= 1.2.3'. Alternatively if you require "
        (++) :: [a] -> [a] -> [a]++ "compatability with earlier Cabal versions then you may be able to "
        (++) :: [a] -> [a] -> [a]++ "use an equivalent compiler-specific flag."

  , checkVersion :: [Int] -> Bool -> PackageCheck -> Maybe PackageCheckcheckVersion [1,4] (not :: Bool -> Boolnot (null :: [a] -> Boolnull mentionedExtensionsThatNeedCabal14 :: [Extension]mentionedExtensionsThatNeedCabal14)) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
           "Unfortunately the language extensions "
        (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep (map :: (a -> b) -> [a] -> [b]map (quote :: String -> Stringquote (.) :: (b -> c) -> (a -> b) -> a -> c. display :: Text a => a -> Stringdisplay) mentionedExtensionsThatNeedCabal14 :: [Extension]mentionedExtensionsThatNeedCabal14)
        (++) :: [a] -> [a] -> [a]++ " break the parser in earlier Cabal versions so you need to "
        (++) :: [a] -> [a] -> [a]++ "specify 'cabal-version: >= 1.4'. Alternatively if you require "
        (++) :: [a] -> [a] -> [a]++ "compatability with earlier Cabal versions then you may be able to "
        (++) :: [a] -> [a] -> [a]++ "use an equivalent compiler-specific flag."
  ]
  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 :: [Int] -> Bool -> PackageCheck -> Maybe PackageCheck
    checkVersion ver cond pc
      | specVersion :: PackageDescription -> VersionspecVersion pkg :: PackageDescriptionpkg (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion ver :: [Int]ver [] :: [a][]      = Nothing :: Maybe aNothing
      | otherwise :: Boolotherwise                              = check :: Bool -> PackageCheck -> Maybe PackageCheckcheck cond :: Boolcond pc :: PackageCheckpc

    buildInfoField field         = map :: (a -> b) -> [a] -> [b]map field :: BuildInfo -> bfield (allBuildInfo :: PackageDescription -> [BuildInfo]allBuildInfo pkg :: PackageDescriptionpkg)
    dataFilesUsingGlobSyntax     = filter :: (a -> Bool) -> [a] -> [a]filter usesGlobSyntax :: FilePath -> BoolusesGlobSyntax (dataFiles :: PackageDescription -> [FilePath]dataFiles pkg :: PackageDescriptionpkg)
    extraSrcFilesUsingGlobSyntax = filter :: (a -> Bool) -> [a] -> [a]filter usesGlobSyntax :: FilePath -> BoolusesGlobSyntax (extraSrcFiles :: PackageDescription -> [FilePath]extraSrcFiles pkg :: PackageDescriptionpkg)
    usesGlobSyntax str = case parseFileGlob :: FilePath -> Maybe FileGlobparseFileGlob str :: FilePathstr of
      Just (FileGlob _ _) -> True :: BoolTrue
      _                   -> False :: BoolFalse

    versionRangeExpressions =
        [ dep :: Dependencydep | dep@(Dependency _ vr) <- buildDepends :: PackageDescription -> [Dependency]buildDepends pkg :: PackageDescriptionpkg
              , usesNewVersionRangeSyntax :: VersionRange -> BoolusesNewVersionRangeSyntax vr :: VersionRangevr ]

    testedWithVersionRangeExpressions =
        [ Dependency :: PackageName -> VersionRange -> DependencyDependency (PackageName :: String -> PackageNamePackageName (display :: Text a => a -> Stringdisplay compiler :: CompilerFlavorcompiler)) vr :: VersionRangevr
        | (compiler, vr) <- testedWith ::
  PackageDescription -> [(CompilerFlavor, VersionRange)]testedWith pkg :: PackageDescriptionpkg
        , usesNewVersionRangeSyntax :: VersionRange -> BoolusesNewVersionRangeSyntax vr :: VersionRangevr ]

    simpleSpecVersionRangeSyntax =
        either :: (a -> c) -> (b -> c) -> Either a b -> ceither (const :: a -> b -> aconst True :: BoolTrue)
               (foldVersionRange' ::
  a
  -> (Version -> a)
  -> (Version -> a)
  -> (Version -> a)
  -> (Version -> a)
  -> (Version -> a)
  -> (Version -> Version -> a)
  -> (a -> a -> a)
  -> (a -> a -> a)
  -> (a -> a)
  -> VersionRange
  -> afoldVersionRange'
                      True :: BoolTrue
                      (\_ -> False :: BoolFalse)
                      (\_ -> False :: BoolFalse) (\_ -> False :: BoolFalse)
                      (\_ -> True :: BoolTrue)  -- >=
                      (\_ -> False :: BoolFalse)
                      (\_ _ -> False :: BoolFalse)
                      (\_ _ -> False :: BoolFalse) (\_ _ -> False :: BoolFalse)
                      id :: a -> aid)
               (specVersionRaw :: PackageDescription -> Either Version VersionRangespecVersionRaw pkg :: PackageDescriptionpkg)

    -- is the cabal-version field a simple version number, rather than a range
    simpleSpecVersionSyntax =
      either :: (a -> c) -> (b -> c) -> Either a b -> ceither (const :: a -> b -> aconst True :: BoolTrue) (const :: a -> b -> aconst False :: BoolFalse) (specVersionRaw :: PackageDescription -> Either Version VersionRangespecVersionRaw pkg :: PackageDescriptionpkg)

    usesNewVersionRangeSyntax :: VersionRange -> Bool
    usesNewVersionRangeSyntax =
        ((>) :: Ord a => a -> a -> Bool> 2) -- uses the new syntax if depth is more than 2
      (.) :: (b -> c) -> (a -> b) -> a -> c. foldVersionRange' ::
  a
  -> (Version -> a)
  -> (Version -> a)
  -> (Version -> a)
  -> (Version -> a)
  -> (Version -> a)
  -> (Version -> Version -> a)
  -> (a -> a -> a)
  -> (a -> a -> a)
  -> (a -> a)
  -> VersionRange
  -> afoldVersionRange'
          (1 :: Int)
          (const :: a -> b -> aconst 1)
          (const :: a -> b -> aconst 1) (const :: a -> b -> aconst 1)
          (const :: a -> b -> aconst 1) (const :: a -> b -> aconst 1)
          (const :: a -> b -> aconst (const :: a -> b -> aconst 1))
          (+) :: Num a => a -> a -> a(+) (+) :: Num a => a -> a -> a(+)
          (const :: a -> b -> aconst 3) -- uses new ()'s syntax

    depsUsingWildcardSyntax = [ dep :: Dependencydep | dep@(Dependency _ vr) <- buildDepends :: PackageDescription -> [Dependency]buildDepends pkg :: PackageDescriptionpkg
                                    , usesWildcardSyntax :: VersionRange -> BoolusesWildcardSyntax vr :: VersionRangevr ]

    testedWithUsingWildcardSyntax = [ Dependency :: PackageName -> VersionRange -> DependencyDependency (PackageName :: String -> PackageNamePackageName (display :: Text a => a -> Stringdisplay compiler :: CompilerFlavorcompiler)) vr :: VersionRangevr
                                    | (compiler, vr) <- testedWith ::
  PackageDescription -> [(CompilerFlavor, VersionRange)]testedWith pkg :: PackageDescriptionpkg
                                    , usesWildcardSyntax :: VersionRange -> BoolusesWildcardSyntax vr :: VersionRangevr ]

    usesWildcardSyntax :: VersionRange -> Bool
    usesWildcardSyntax =
      foldVersionRange' ::
  a
  -> (Version -> a)
  -> (Version -> a)
  -> (Version -> a)
  -> (Version -> a)
  -> (Version -> a)
  -> (Version -> Version -> a)
  -> (a -> a -> a)
  -> (a -> a -> a)
  -> (a -> a)
  -> VersionRange
  -> afoldVersionRange'
        False :: BoolFalse (const :: a -> b -> aconst False :: BoolFalse)
        (const :: a -> b -> aconst False :: BoolFalse) (const :: a -> b -> aconst False :: BoolFalse)
        (const :: a -> b -> aconst False :: BoolFalse) (const :: a -> b -> aconst False :: BoolFalse)
        (\_ _ -> True :: BoolTrue) -- the wildcard case
        (||) :: Bool -> Bool -> Bool(||) (||) :: Bool -> Bool -> Bool(||) id :: a -> aid

    eliminateWildcardSyntax =
      foldVersionRange' ::
  a
  -> (Version -> a)
  -> (Version -> a)
  -> (Version -> a)
  -> (Version -> a)
  -> (Version -> a)
  -> (Version -> Version -> a)
  -> (a -> a -> a)
  -> (a -> a -> a)
  -> (a -> a)
  -> VersionRange
  -> afoldVersionRange'
        anyVersion :: VersionRangeanyVersion thisVersion :: Version -> VersionRangethisVersion
        laterVersion :: Version -> VersionRangelaterVersion earlierVersion :: Version -> VersionRangeearlierVersion
        orLaterVersion :: Version -> VersionRangeorLaterVersion orEarlierVersion :: Version -> VersionRangeorEarlierVersion
        (\v v' -> intersectVersionRanges ::
  VersionRange -> VersionRange -> VersionRangeintersectVersionRanges (orLaterVersion :: Version -> VersionRangeorLaterVersion v :: tv) (earlierVersion :: Version -> VersionRangeearlierVersion v' :: Versionv'))
        intersectVersionRanges ::
  VersionRange -> VersionRange -> VersionRangeintersectVersionRanges unionVersionRanges :: VersionRange -> VersionRange -> VersionRangeunionVersionRanges id :: a -> aid

    compatLicenses = [ GPL :: Maybe Version -> LicenseGPL Nothing :: Maybe aNothing, LGPL :: Maybe Version -> LicenseLGPL Nothing :: Maybe aNothing, BSD3 :: LicenseBSD3, BSD4 :: LicenseBSD4
                     , PublicDomain :: LicensePublicDomain, AllRightsReserved :: LicenseAllRightsReserved, OtherLicense :: LicenseOtherLicense ]

    mentionedExtensions = [ ext :: Extensionext | bi <- allBuildInfo :: PackageDescription -> [BuildInfo]allBuildInfo pkg :: PackageDescriptionpkg
                                , ext <- allExtensions :: BuildInfo -> [Extension]allExtensions bi :: BuildInfobi ]
    mentionedExtensionsThatNeedCabal12 =
      nub :: Eq a => [a] -> [a]nub (filter :: (a -> Bool) -> [a] -> [a]filter (elem :: Eq a => a -> [a] -> Bool`elem` compatExtensionsExtra :: [Extension]compatExtensionsExtra) mentionedExtensions :: [Extension]mentionedExtensions)

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

    -- The known extensions in Cabal-1.2.3
    compatExtensions =
      map :: (a -> b) -> [a] -> [b]map EnableExtension :: KnownExtension -> ExtensionEnableExtension
      [ OverlappingInstances :: KnownExtensionOverlappingInstances, UndecidableInstances :: KnownExtensionUndecidableInstances, IncoherentInstances :: KnownExtensionIncoherentInstances
      , RecursiveDo :: KnownExtensionRecursiveDo, ParallelListComp :: KnownExtensionParallelListComp, MultiParamTypeClasses :: KnownExtensionMultiParamTypeClasses
      , FunctionalDependencies :: KnownExtensionFunctionalDependencies, Rank2Types :: KnownExtensionRank2Types
      , RankNTypes :: KnownExtensionRankNTypes, PolymorphicComponents :: KnownExtensionPolymorphicComponents, ExistentialQuantification :: KnownExtensionExistentialQuantification
      , ScopedTypeVariables :: KnownExtensionScopedTypeVariables, ImplicitParams :: KnownExtensionImplicitParams, FlexibleContexts :: KnownExtensionFlexibleContexts
      , FlexibleInstances :: KnownExtensionFlexibleInstances, EmptyDataDecls :: KnownExtensionEmptyDataDecls, CPP :: KnownExtensionCPP, BangPatterns :: KnownExtensionBangPatterns
      , TypeSynonymInstances :: KnownExtensionTypeSynonymInstances, TemplateHaskell :: KnownExtensionTemplateHaskell, ForeignFunctionInterface :: KnownExtensionForeignFunctionInterface
      , Arrows :: KnownExtensionArrows, Generics :: KnownExtensionGenerics, NamedFieldPuns :: KnownExtensionNamedFieldPuns, PatternGuards :: KnownExtensionPatternGuards
      , GeneralizedNewtypeDeriving :: KnownExtensionGeneralizedNewtypeDeriving, ExtensibleRecords :: KnownExtensionExtensibleRecords, RestrictedTypeSynonyms :: KnownExtensionRestrictedTypeSynonyms
      , HereDocuments :: KnownExtensionHereDocuments] (++) :: [a] -> [a] -> [a]++
      map :: (a -> b) -> [a] -> [b]map DisableExtension :: KnownExtension -> ExtensionDisableExtension
      [MonomorphismRestriction :: KnownExtensionMonomorphismRestriction, ImplicitPrelude :: KnownExtensionImplicitPrelude] (++) :: [a] -> [a] -> [a]++
      compatExtensionsExtra :: [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 =
      map :: (a -> b) -> [a] -> [b]map EnableExtension :: KnownExtension -> ExtensionEnableExtension
      [ KindSignatures :: KnownExtensionKindSignatures, MagicHash :: KnownExtensionMagicHash, TypeFamilies :: KnownExtensionTypeFamilies, StandaloneDeriving :: KnownExtensionStandaloneDeriving
      , UnicodeSyntax :: KnownExtensionUnicodeSyntax, PatternSignatures :: KnownExtensionPatternSignatures, UnliftedFFITypes :: KnownExtensionUnliftedFFITypes, LiberalTypeSynonyms :: KnownExtensionLiberalTypeSynonyms
      , TypeOperators :: KnownExtensionTypeOperators, RecordWildCards :: KnownExtensionRecordWildCards, RecordPuns :: KnownExtensionRecordPuns, DisambiguateRecordFields :: KnownExtensionDisambiguateRecordFields
      , OverloadedStrings :: KnownExtensionOverloadedStrings, GADTs :: KnownExtensionGADTs, RelaxedPolyRec :: KnownExtensionRelaxedPolyRec
      , ExtendedDefaultRules :: KnownExtensionExtendedDefaultRules, UnboxedTuples :: KnownExtensionUnboxedTuples, DeriveDataTypeable :: KnownExtensionDeriveDataTypeable
      , ConstrainedClassMethods :: KnownExtensionConstrainedClassMethods
      ] (++) :: [a] -> [a] -> [a]++
      map :: (a -> b) -> [a] -> [b]map DisableExtension :: KnownExtension -> ExtensionDisableExtension
      [MonoPatBinds :: KnownExtensionMonoPatBinds]

-- | A variation on the normal 'Text' instance, shows any ()'s in the original
-- textual syntax. We need to show these otherwise it's confusing to users when
-- we complain of their presense but do not pretty print them!
--
displayRawVersionRange :: VersionRange -> String
displayRawVersionRange =
   render :: Doc -> StringDisp.render
 (.) :: (b -> c) -> (a -> b) -> a -> c. fst :: (a, b) -> afst
 (.) :: (b -> c) -> (a -> b) -> a -> c. foldVersionRange' ::
  a
  -> (Version -> a)
  -> (Version -> a)
  -> (Version -> a)
  -> (Version -> a)
  -> (Version -> a)
  -> (Version -> Version -> a)
  -> (a -> a -> a)
  -> (a -> a -> a)
  -> (a -> a)
  -> VersionRange
  -> afoldVersionRange'                         -- precedence:
     -- All the same as the usual pretty printer, except for the parens
     (         text :: String -> DocDisp.text "-any"                           , 0 :: Int)
     (\v   -> (text :: String -> DocDisp.text "==" (<>) :: Doc -> Doc -> Doc<> disp :: Text a => a -> Docdisp v :: tv                   , 0))
     (\v   -> (char :: Char -> DocDisp.char '>'  (<>) :: Doc -> Doc -> Doc<> disp :: Text a => a -> Docdisp v :: tv                   , 0))
     (\v   -> (char :: Char -> DocDisp.char '<'  (<>) :: Doc -> Doc -> Doc<> disp :: Text a => a -> Docdisp v :: tv                   , 0))
     (\v   -> (text :: String -> DocDisp.text ">=" (<>) :: Doc -> Doc -> Doc<> disp :: Text a => a -> Docdisp v :: tv                   , 0))
     (\v   -> (text :: String -> DocDisp.text "<=" (<>) :: Doc -> Doc -> Doc<> disp :: Text a => a -> Docdisp v :: tv                   , 0))
     (\v _ -> (text :: String -> DocDisp.text "==" (<>) :: Doc -> Doc -> Doc<> dispWild :: Version -> DocdispWild v :: tv               , 0))
     (\(r1, p1) (r2, p2) -> (punct :: a -> a -> Doc -> Docpunct 2 p1 :: Intp1 r1 :: Docr1 (<+>) :: Doc -> Doc -> Doc<+> text :: String -> DocDisp.text "||" (<+>) :: Doc -> Doc -> Doc<+> punct :: a -> a -> Doc -> Docpunct 2 p2 :: Intp2 r2 :: Docr2 , 2))
     (\(r1, p1) (r2, p2) -> (punct :: a -> a -> Doc -> Docpunct 1 p1 :: Intp1 r1 :: Docr1 (<+>) :: Doc -> Doc -> Doc<+> text :: String -> DocDisp.text "&&" (<+>) :: Doc -> Doc -> Doc<+> punct :: a -> a -> Doc -> Docpunct 1 p2 :: Intp2 r2 :: Docr2 , 1))
     (\(r,  _ )          -> (parens :: Doc -> DocDisp.parens r :: Docr, 0)) -- parens

  where
    dispWild (Version b _) =
           hcat :: [Doc] -> DocDisp.hcat (punctuate :: Doc -> [Doc] -> [Doc]Disp.punctuate (char :: Char -> DocDisp.char '.') (map :: (a -> b) -> [a] -> [b]map int :: Int -> DocDisp.int b :: [Int]b))
        (<>) :: Doc -> Doc -> Doc<> text :: String -> DocDisp.text ".*"
    punct p p' | p :: ap (<) :: Ord a => a -> a -> Bool< p' :: ap'    = parens :: Doc -> DocDisp.parens
               | otherwise :: Boolotherwise = id :: a -> aid

displayRawDependency :: Dependency -> String
displayRawDependency (Dependency pkg vr) =
  display :: Text a => a -> Stringdisplay pkg :: PackageDescriptionpkg (++) :: [a] -> [a] -> [a]++ " " (++) :: [a] -> [a] -> [a]++ displayRawVersionRange :: VersionRange -> StringdisplayRawVersionRange vr :: VersionRangevr


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

-- | Check the build-depends fields for any weirdness or bad practise.
--
checkPackageVersions :: GenericPackageDescription -> [PackageCheck]
checkPackageVersions pkg =
  catMaybes :: [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.*"
    check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (not :: Bool -> Boolnot (boundedAbove :: VersionRange -> BoolboundedAbove baseDependency :: VersionRangebaseDependency)) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
           "The dependency 'build-depends: base' does not specify an upper "
        (++) :: [a] -> [a] -> [a]++ "bound on the version number. Each major release of the 'base' "
        (++) :: [a] -> [a] -> [a]++ "package changes the API in various ways and most packages will "
        (++) :: [a] -> [a] -> [a]++ "need some changes to compile with it. The recommended practise "
        (++) :: [a] -> [a] -> [a]++ "is to specify an upper bound on the version of the 'base' "
        (++) :: [a] -> [a] -> [a]++ "package. This ensures your package will continue to build when a "
        (++) :: [a] -> [a] -> [a]++ "new major version of the 'base' package is released. If you are "
        (++) :: [a] -> [a] -> [a]++ "not sure what upper bound to use then use the next  major "
        (++) :: [a] -> [a] -> [a]++ "version. For example if you have tested your package with 'base' "
        (++) :: [a] -> [a] -> [a]++ "version 2 and 3 then use 'build-depends: base >= 2 && < 4'."

  ]
  where
    -- TODO: What we really want to do is test if there exists any
    -- configuration in which the base version is unboudned 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 = finalizePackageDescription ::
  FlagAssignment
  -> (Dependency -> Bool)
  -> Platform
  -> CompilerId
  -> [Dependency]
  -> GenericPackageDescription
  -> Either [Dependency] (PackageDescription, FlagAssignment)finalizePackageDescription
                              [] :: [a][] (const :: a -> b -> aconst True :: BoolTrue) buildPlatform :: PlatformbuildPlatform
                              (CompilerId :: CompilerFlavor -> Version -> CompilerIdCompilerId buildCompilerFlavor :: CompilerFlavorbuildCompilerFlavor (Version :: [Int] -> [String] -> VersionVersion [] :: [a][] [] :: [a][]))
                              [] :: [a][] pkg :: PackageDescriptionpkg
    baseDependency = case finalised ::
  Either [Dependency] (PackageDescription, FlagAssignment)finalised of
      Right (pkg', _) | not :: Bool -> Boolnot (null :: [a] -> Boolnull baseDeps :: [VersionRange]baseDeps) ->
          foldr :: (a -> b -> b) -> b -> [a] -> bfoldr intersectVersionRanges ::
  VersionRange -> VersionRange -> VersionRangeintersectVersionRanges anyVersion :: VersionRangeanyVersion baseDeps :: [VersionRange]baseDeps
        where
          baseDeps =
            [ vr :: VersionRangevr | Dependency (PackageName "base") vr <- buildDepends :: PackageDescription -> [Dependency]buildDepends pkg' :: PackageDescriptionpkg' ]

      -- Just in case finalizePackageDescription 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
      _          -> noVersion :: VersionRangenoVersion

    boundedAbove :: VersionRange -> Bool
    boundedAbove vr = case asVersionIntervals :: VersionRange -> [VersionInterval]asVersionIntervals vr :: VersionRangevr of
      []        -> True :: BoolTrue -- this is the inconsistent version range.
      intervals -> case last :: [a] -> alast intervals :: [VersionInterval]intervals of
        (_,   UpperBound _ _) -> True :: BoolTrue
        (_, NoUpperBound    ) -> False :: BoolFalse


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

    check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (not :: Bool -> Boolnot ($) :: (a -> b) -> a -> b$ null :: [a] -> Boolnull unknownOSs :: [String]unknownOSs) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
           "Unknown operating system name "
        (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep (map :: (a -> b) -> [a] -> [b]map quote :: String -> Stringquote unknownOSs :: [String]unknownOSs)

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (not :: Bool -> Boolnot ($) :: (a -> b) -> a -> b$ null :: [a] -> Boolnull unknownArches :: [String]unknownArches) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
           "Unknown architecture name "
        (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep (map :: (a -> b) -> [a] -> [b]map quote :: String -> Stringquote unknownArches :: [String]unknownArches)

  , check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (not :: Bool -> Boolnot ($) :: (a -> b) -> a -> b$ null :: [a] -> Boolnull unknownImpls :: [String]unknownImpls) ($) :: (a -> b) -> a -> b$
      PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
           "Unknown compiler name "
        (++) :: [a] -> [a] -> [a]++ commaSep :: [String] -> StringcommaSep (map :: (a -> b) -> [a] -> [b]map quote :: String -> Stringquote unknownImpls :: [String]unknownImpls)
  ]
  where
    unknownOSs    = [ os :: Stringos   | OS   (OtherOS os)           <- conditions :: [ConfVar]conditions ]
    unknownArches = [ arch :: Stringarch | Arch (OtherArch arch)       <- conditions :: [ConfVar]conditions ]
    unknownImpls  = [ impl :: Stringimpl | Impl (OtherCompiler impl) _ <- conditions :: [ConfVar]conditions ]
    conditions = maybe :: b -> (a -> b) -> Maybe a -> bmaybe [] :: [a][] freeVars :: CondTree b t t1 -> [b]freeVars (condLibrary ::
  GenericPackageDescription
  -> Maybe (CondTree ConfVar [Dependency] Library)condLibrary pkg :: PackageDescriptionpkg)
              (++) :: [a] -> [a] -> [a]++ concatMap :: (a -> [b]) -> [a] -> [b]concatMap (freeVars :: CondTree b t t1 -> [b]freeVars (.) :: (b -> c) -> (a -> b) -> a -> c. snd :: (a, b) -> bsnd) (condExecutables ::
  GenericPackageDescription
  -> [(String, CondTree ConfVar [Dependency] Executable)]condExecutables pkg :: PackageDescriptionpkg)
    freeVars (CondNode _ _ ifs) = concatMap :: (a -> [b]) -> [a] -> [b]concatMap compfv ::
  (Condition b, CondTree b t t, Maybe (CondTree b t t)) -> [b]compfv ifs :: [(Condition b, CondTree b t t, Maybe (CondTree b t t))]ifs
    compfv (c, ct, mct) = condfv :: Condition t -> [t]condfv c :: Condition bc (++) :: [a] -> [a] -> [a]++ freeVars :: CondTree b t t1 -> [b]freeVars ct :: CondTree b t tct (++) :: [a] -> [a] -> [a]++ maybe :: b -> (a -> b) -> Maybe a -> bmaybe [] :: [a][] freeVars :: CondTree b t t1 -> [b]freeVars mct :: Maybe (CondTree b t t)mct
    condfv c = case c :: Condition bc of
      Var v      -> [v :: tv]
      Lit _      -> [] :: [a][]
      CNot c1    -> condfv :: Condition t -> [t]condfv c1 :: Condition tc1
      COr  c1 c2 -> condfv :: Condition t -> [t]condfv c1 :: Condition tc1 (++) :: [a] -> [a] -> [a]++ condfv :: Condition t -> [t]condfv c2 :: Condition tc2
      CAnd c1 c2 -> condfv :: Condition t -> [t]condfv c1 :: Condition tc1 (++) :: [a] -> [a] -> [a]++ condfv :: Condition t -> [t]condfv c2 :: Condition tc2

-- ------------------------------------------------------------
-- * 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 filepath.
--
checkPackageFiles :: PackageDescription -> FilePath -> IO [PackageCheck]
checkPackageFiles pkg root = checkPackageContent ::
  Monad m =>
  CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]checkPackageContent checkFilesIO :: CheckPackageContentOps IOcheckFilesIO pkg :: PackageDescriptionpkg
  where
    checkFilesIO = CheckPackageContentOps {
      doesFileExist      = doesFileExist :: FilePath -> IO BoolSystem.doesFileExist      (.) :: (b -> c) -> (a -> b) -> a -> c. relative :: FilePath -> FilePathrelative,
      doesDirectoryExist = doesDirectoryExist :: FilePath -> IO BoolSystem.doesDirectoryExist (.) :: (b -> c) -> (a -> b) -> a -> c. relative :: FilePath -> FilePathrelative
    }
    relative path = root :: FilePathroot (</>) :: FilePath -> FilePath -> FilePath</> path :: FilePathpath

-- | A record of operations needed to check the contents of packages.
-- Used by 'checkPackageContent'.
--
data doesDirectoryExist :: FilePath -> m BoolCheckPackageContentOps m = CheckPackageContentOps {
    doesFileExist      :: FilePath -> m Bool,
    doesDirectoryExist :: FilePath -> m Bool
  }

-- | Sanity check things that requires looking at files in the package.
-- This is a generalised version of 'checkPackageFiles' that can work in any
-- monad for which you can provide 'CheckPackageContentOps' operations.
--
-- The point of this extra generality is to allow doing checks in some virtual
-- file system, for example a tarball in memory.
--
checkPackageContent :: Monad m => CheckPackageContentOps m
                    -> PackageDescription
                    -> m [PackageCheck]
checkPackageContent ops pkg = do
  licenseError    <- checkLicenseExists ::
  Monad m =>
  CheckPackageContentOps m
  -> PackageDescription
  -> m (Maybe PackageCheck)checkLicenseExists   ops :: CheckPackageContentOps mops pkg :: PackageDescriptionpkg
  setupError      <- checkSetupExists ::
  Monad m =>
  CheckPackageContentOps m
  -> PackageDescription
  -> m (Maybe PackageCheck)checkSetupExists     ops :: CheckPackageContentOps mops pkg :: PackageDescriptionpkg
  configureError  <- checkConfigureExists ::
  Monad m =>
  CheckPackageContentOps m
  -> PackageDescription
  -> m (Maybe PackageCheck)checkConfigureExists ops :: CheckPackageContentOps mops pkg :: PackageDescriptionpkg
  localPathErrors <- checkLocalPathsExist ::
  Monad m =>
  CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]checkLocalPathsExist ops :: CheckPackageContentOps mops pkg :: PackageDescriptionpkg
  vcsLocation     <- checkMissingVcsInfo ::
  Monad m =>
  CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]checkMissingVcsInfo  ops :: CheckPackageContentOps mops pkg :: PackageDescriptionpkg

  return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ catMaybes :: [Maybe a] -> [a]catMaybes [licenseError :: Maybe PackageChecklicenseError, setupError :: Maybe PackageChecksetupError, configureError :: Maybe PackageCheckconfigureError]
        (++) :: [a] -> [a] -> [a]++ localPathErrors :: [PackageCheck]localPathErrors
        (++) :: [a] -> [a] -> [a]++ vcsLocation :: [PackageCheck]vcsLocation

checkLicenseExists :: Monad m => CheckPackageContentOps m
                   -> PackageDescription
                   -> m (Maybe PackageCheck)
checkLicenseExists ops pkg
  | null :: [a] -> Boolnull (licenseFile :: PackageDescription -> FilePathlicenseFile pkg :: PackageDescriptionpkg) = return :: Monad m => forall a. a -> m areturn Nothing :: Maybe aNothing
  | otherwise :: Boolotherwise = do
    exists <- doesFileExist :: CheckPackageContentOps m -> FilePath -> m BooldoesFileExist ops :: CheckPackageContentOps mops file :: FilePathfile
    return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (not :: Bool -> Boolnot exists :: Boolexists) ($) :: (a -> b) -> a -> b$
      PackageBuildWarning :: String -> PackageCheckPackageBuildWarning ($) :: (a -> b) -> a -> b$
           "The 'license-file' field refers to the file " (++) :: [a] -> [a] -> [a]++ quote :: String -> Stringquote file :: FilePathfile
        (++) :: [a] -> [a] -> [a]++ " which does not exist."

  where
    file = licenseFile :: PackageDescription -> FilePathlicenseFile pkg :: PackageDescriptionpkg

checkSetupExists :: Monad m => CheckPackageContentOps m
                 -> PackageDescription
                 -> m (Maybe PackageCheck)
checkSetupExists ops _ = do
  hsexists  <- doesFileExist :: CheckPackageContentOps m -> FilePath -> m BooldoesFileExist ops :: CheckPackageContentOps mops "Setup.hs"
  lhsexists <- doesFileExist :: CheckPackageContentOps m -> FilePath -> m BooldoesFileExist ops :: CheckPackageContentOps mops "Setup.lhs"
  return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (not :: Bool -> Boolnot hsexists :: Boolhsexists (&&) :: Bool -> Bool -> Bool&& not :: Bool -> Boolnot lhsexists :: Boollhsexists) ($) :: (a -> b) -> a -> b$
    PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
      "The package is missing a Setup.hs or Setup.lhs script."

checkConfigureExists :: Monad m => CheckPackageContentOps m
                     -> PackageDescription
                     -> m (Maybe PackageCheck)
checkConfigureExists ops PackageDescription { buildType = Just Configure } = do
  exists <- doesFileExist :: CheckPackageContentOps m -> FilePath -> m BooldoesFileExist ops :: CheckPackageContentOps mops "configure"
  return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (not :: Bool -> Boolnot exists :: Boolexists) ($) :: (a -> b) -> a -> b$
    PackageBuildWarning :: String -> PackageCheckPackageBuildWarning ($) :: (a -> b) -> a -> b$
      "The 'build-type' is 'Configure' but there is no 'configure' script."
checkConfigureExists _ _ = return :: Monad m => forall a. a -> m areturn Nothing :: Maybe aNothing

checkLocalPathsExist :: Monad m => CheckPackageContentOps m
                     -> PackageDescription
                     -> m [PackageCheck]
checkLocalPathsExist ops pkg = do
  let dirs = [ (dir :: [Char]dir, kind :: Stringkind)
             | bi <- allBuildInfo :: PackageDescription -> [BuildInfo]allBuildInfo pkg :: PackageDescriptionpkg
             , (dir, kind) <-
                  [ (dir :: [Char]dir, "extra-lib-dirs") | dir <- extraLibDirs :: BuildInfo -> [String]extraLibDirs bi :: BuildInfobi ]
               (++) :: [a] -> [a] -> [a]++ [ (dir :: [Char]dir, "include-dirs")   | dir <- includeDirs :: BuildInfo -> [FilePath]includeDirs  bi :: BuildInfobi ]
               (++) :: [a] -> [a] -> [a]++ [ (dir :: [Char]dir, "hs-source-dirs") | dir <- hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs bi :: BuildInfobi ]
             , isRelative :: FilePath -> BoolisRelative dir :: [Char]dir ]
  missing <- filterM :: Monad m => (a -> m Bool) -> [a] -> m [a]filterM (liftM :: Monad m => (a1 -> r) -> m a1 -> m rliftM not :: Bool -> Boolnot (.) :: (b -> c) -> (a -> b) -> a -> c. doesDirectoryExist ::
  CheckPackageContentOps m -> FilePath -> m BooldoesDirectoryExist ops :: CheckPackageContentOps mops (.) :: (b -> c) -> (a -> b) -> a -> c. fst :: (a, b) -> afst) dirs :: [(String, [Char])]dirs
  return :: Monad m => forall a. a -> m areturn [ PackageBuildWarning {
             explanation = quote :: String -> Stringquote (kind :: Stringkind (++) :: [a] -> [a] -> [a]++ ": " (++) :: [a] -> [a] -> [a]++ dir :: [Char]dir)
                        (++) :: [a] -> [a] -> [a]++ " directory does not exist."
           }
         | (dir, kind) <- missing :: [(FilePath, [Char])]missing ]

checkMissingVcsInfo :: Monad m => CheckPackageContentOps m
                    -> PackageDescription
                    -> m [PackageCheck]
checkMissingVcsInfo ops pkg | null :: [a] -> Boolnull (sourceRepos :: PackageDescription -> [SourceRepo]sourceRepos pkg :: PackageDescriptionpkg) = do
    vcsInUse <- liftM :: Monad m => (a1 -> r) -> m a1 -> m rliftM or :: [Bool] -> Boolor ($) :: (a -> b) -> a -> b$ mapM :: Monad m => (a -> m b) -> [a] -> m [b]mapM (doesDirectoryExist ::
  CheckPackageContentOps m -> FilePath -> m BooldoesDirectoryExist ops :: CheckPackageContentOps mops) repoDirnames :: [FilePath]repoDirnames
    if vcsInUse :: BoolvcsInUse
      then return :: Monad m => forall a. a -> m areturn [ PackageDistSuspicious :: String -> PackageCheckPackageDistSuspicious message :: [Char]message ]
      else return :: Monad m => forall a. a -> m areturn [] :: [a][]
  where
    repoDirnames = [ dirname :: FilePathdirname | repo    <- knownRepoTypes :: [RepoType]knownRepoTypes
                             , dirname <- repoTypeDirname :: RepoType -> [FilePath]repoTypeDirname repo :: SourceReporepo ]
    message  = "When distributing packages it is encouraged to specify source "
            (++) :: [a] -> [a] -> [a]++ "control information in the .cabal file using one or more "
            (++) :: [a] -> [a] -> [a]++ "'source-repository' sections. See the Cabal user guide for "
            (++) :: [a] -> [a] -> [a]++ "details."

checkMissingVcsInfo _ _ = return :: Monad m => forall a. a -> m areturn [] :: [a][]

repoTypeDirname :: RepoType -> [FilePath]
repoTypeDirname Darcs      = ["_darcs"]
repoTypeDirname Git        = [".git"]
repoTypeDirname SVN        = [".svn"]
repoTypeDirname CVS        = ["CVS"]
repoTypeDirname Mercurial  = [".hg"]
repoTypeDirname GnuArch    = [".arch-params"]
repoTypeDirname Bazaar     = [".bzr"]
repoTypeDirname Monotone   = ["_MTN"]
repoTypeDirname _          = [] :: [a][]

-- ------------------------------------------------------------
-- * 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 files =
     (take :: Int -> [a] -> [a]take 1 (.) :: (b -> c) -> (a -> b) -> a -> c. catMaybes :: [Maybe a] -> [a]catMaybes (.) :: (b -> c) -> (a -> b) -> a -> c. map :: (a -> b) -> [a] -> [b]map checkWindowsPath :: FilePath -> Maybe PackageCheckcheckWindowsPath ($) :: (a -> b) -> a -> b$ files :: [FilePath]files)
  (++) :: [a] -> [a] -> [a]++ (take :: Int -> [a] -> [a]take 1 (.) :: (b -> c) -> (a -> b) -> a -> c. catMaybes :: [Maybe a] -> [a]catMaybes (.) :: (b -> c) -> (a -> b) -> a -> c. map :: (a -> b) -> [a] -> [b]map checkTarPath :: FilePath -> Maybe PackageCheckcheckTarPath     ($) :: (a -> b) -> a -> b$ files :: [FilePath]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 path =
  check :: Bool -> PackageCheck -> Maybe PackageCheckcheck (not :: Bool -> Boolnot ($) :: (a -> b) -> a -> b$ isValid :: FilePath -> BoolFilePath.Windows.isValid path' :: [Char]path') ($) :: (a -> b) -> a -> b$
    PackageDistInexcusable :: String -> PackageCheckPackageDistInexcusable ($) :: (a -> b) -> a -> b$
         "Unfortunately, the file " (++) :: [a] -> [a] -> [a]++ quote :: String -> Stringquote path :: FilePathpath (++) :: [a] -> [a] -> [a]++ " is not a valid file "
      (++) :: [a] -> [a] -> [a]++ "name on Windows which would cause portability problems for this "
      (++) :: [a] -> [a] -> [a]++ "package. Windows file names cannot contain any of the characters "
      (++) :: [a] -> [a] -> [a]++ "\":*?<>|\" and there are a few reserved names including \"aux\", "
      (++) :: [a] -> [a] -> [a]++ "\"nul\", \"con\", \"prn\", \"com1-9\", \"lpt1-9\" and \"clock$\"."
  where
    path' = ".\\" (++) :: [a] -> [a] -> [a]++ path :: FilePathpath
    -- 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 path
  | length :: [a] -> Intlength path :: FilePathpath (>) :: Ord a => a -> a -> Bool> 255   = Just :: a -> Maybe aJust longPath :: PackageChecklongPath
  | otherwise :: Boolotherwise = case pack :: Int -> [[a]] -> Either PackageCheck [[a]]pack nameMax :: IntnameMax (reverse :: [a] -> [a]reverse (splitPath :: FilePath -> [FilePath]splitPath path :: FilePathpath)) of
    Left err           -> Just :: a -> Maybe aJust err :: PackageCheckerr
    Right []           -> Nothing :: Maybe aNothing
    Right (first:rest) -> case pack :: Int -> [[a]] -> Either PackageCheck [[a]]pack prefixMax :: IntprefixMax remainder :: [[Char]]remainder of
      Left err         -> Just :: a -> Maybe aJust err :: PackageCheckerr
      Right []         -> Nothing :: Maybe aNothing
      Right (_:_)      -> Just :: a -> Maybe aJust noSplit :: PackageChecknoSplit
     where
        -- drop the '/' between the name and prefix:
        remainder = init :: [a] -> [a]init first :: [Char]first (:) :: a -> [a] -> [a]: rest :: [[Char]]rest

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

    pack _   []     = Left :: a -> Either a bLeft emptyName :: PackageCheckemptyName
    pack maxLen (c:cs)
      | n :: Stringn (>) :: Ord a => a -> a -> Bool> maxLen :: IntmaxLen  = Left :: a -> Either a bLeft longName :: PackageChecklongName
      | otherwise :: Boolotherwise   = Right :: b -> Either a bRight (pack' :: Int -> Int -> [[a]] -> [[a]]pack' maxLen :: IntmaxLen n :: Stringn cs :: [[a]]cs)
      where n = length :: [a] -> Intlength c :: Condition bc

    pack' maxLen n (c:cs)
      | n' :: Intn' (<=) :: Ord a => a -> a -> Bool<= maxLen :: IntmaxLen = pack' :: Int -> Int -> [[a]] -> [[a]]pack' maxLen :: IntmaxLen n' :: Intn' cs :: [[a]]cs
      where n' = n :: Stringn (+) :: Num a => a -> a -> a+ length :: [a] -> Intlength c :: Condition bc
    pack' _     _ cs = cs :: [[a]]cs

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

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

quote :: String -> String
quote s = "'" (++) :: [a] -> [a] -> [a]++ s :: Strings (++) :: [a] -> [a] -> [a]++ "'"

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

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