-- |
-- Module      :  Distribution.Client.Check
-- Copyright   :  (c) Lennart Kolmodin 2008
-- License     :  BSD-like
--
-- Maintainer  :  kolmodin@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- Check a package for common mistakes
module Distribution.Client.Check
  ( check
  ) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import Distribution.Client.Errors

import Distribution.Client.Errors.Parser
import Distribution.Fields.ParseResult
import Distribution.PackageDescription (GenericPackageDescription)
import Distribution.PackageDescription.Check
import Distribution.PackageDescription.Parsec
import Distribution.Parsec
import Distribution.Simple.Utils (defaultPackageDescCwd, dieWithException, notice, warn, warnError)
import Distribution.Utils.Path (getSymbolicPath)

import qualified Control.Monad as CM
import qualified Data.ByteString as BS
import qualified Data.Function as F
import qualified Data.List as L
import qualified Data.List.NonEmpty as NE
import qualified System.Directory as Dir

readGenericPackageDescriptionCheck :: Verbosity -> FilePath -> IO ([PWarningWithSource CabalFileSource], GenericPackageDescription)
readGenericPackageDescriptionCheck :: Verbosity
-> FilePath
-> IO
     ([PWarningWithSource CabalFileSource], GenericPackageDescription)
readGenericPackageDescriptionCheck Verbosity
verbosity FilePath
fpath = do
  exists <- FilePath -> IO Bool
Dir.doesFileExist FilePath
fpath
  unless exists $
    dieWithException verbosity $
      FileDoesntExist fpath
  bs <- BS.readFile fpath
  let (warnings, result) = runParseResult $ withSource (PCabalFile (fpath, bs)) (parseGenericPackageDescription bs)
  case result of
    Left (Maybe Version
mspecVersion, NonEmpty (PErrorWithSource CabalFileSource)
errors) -> do
      Verbosity
-> CabalInstallException
-> IO
     ([PWarningWithSource CabalFileSource], GenericPackageDescription)
forall a1 a.
(HasCallStack, Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalFileParseError -> CabalInstallException
CabalCheckParseError (FilePath
-> ByteString
-> NonEmpty (PErrorWithSource CabalFileSource)
-> Maybe Version
-> [PWarningWithSource CabalFileSource]
-> CabalFileParseError
CabalFileParseError FilePath
fpath ByteString
bs NonEmpty (PErrorWithSource CabalFileSource)
errors Maybe Version
mspecVersion [PWarningWithSource CabalFileSource]
warnings))
    Right GenericPackageDescription
x -> ([PWarningWithSource CabalFileSource], GenericPackageDescription)
-> IO
     ([PWarningWithSource CabalFileSource], GenericPackageDescription)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PWarningWithSource CabalFileSource]
warnings, GenericPackageDescription
x)

-- | Checks a package for common errors. Returns @True@ if the package
-- is fit to upload to Hackage, @False@ otherwise.
-- Note: must be called with the CWD set to the directory containing
-- the '.cabal' file.
check
  :: Verbosity
  -> [CheckExplanationIDString]
  -- ^ List of check-ids in String form
  -- (e.g. @invalid-path-win@) to ignore.
  -> IO Bool
check :: Verbosity -> [FilePath] -> IO Bool
check Verbosity
verbosity [FilePath]
ignores = do
  pdfile <- SymbolicPathX 'OnlyRelative Pkg 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath (SymbolicPathX 'OnlyRelative Pkg 'File -> FilePath)
-> IO (SymbolicPathX 'OnlyRelative Pkg 'File) -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity -> IO (SymbolicPathX 'OnlyRelative Pkg 'File)
defaultPackageDescCwd Verbosity
verbosity
  (ws, ppd) <- readGenericPackageDescriptionCheck verbosity pdfile
  -- convert parse warnings into PackageChecks
  let ws' = (PWarningWithSource CabalFileSource -> PackageCheck)
-> [PWarningWithSource CabalFileSource] -> [PackageCheck]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> PWarning -> PackageCheck
wrapParseWarning FilePath
pdfile (PWarning -> PackageCheck)
-> (PWarningWithSource CabalFileSource -> PWarning)
-> PWarningWithSource CabalFileSource
-> PackageCheck
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PWarningWithSource CabalFileSource -> PWarning
forall src. PWarningWithSource src -> PWarning
pwarning) [PWarningWithSource CabalFileSource]
ws
  ioChecks <- checkPackageFilesGPD verbosity ppd "."
  let packageChecksPrim = [PackageCheck]
ioChecks [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ GenericPackageDescription -> [PackageCheck]
checkPackage GenericPackageDescription
ppd [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ [PackageCheck]
ws'
      (packageChecks, unrecs) = filterPackageChecksByIdString packageChecksPrim ignores

  CM.mapM_ (\FilePath
s -> Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath
"Unrecognised ignore \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\"")) unrecs

  CM.mapM_ (outputGroupCheck verbosity) (groupChecks packageChecks)

  let errors = (PackageCheck -> Bool) -> [PackageCheck] -> [PackageCheck]
forall a. (a -> Bool) -> [a] -> [a]
filter PackageCheck -> Bool
isHackageDistError [PackageCheck]
packageChecks

  unless (null errors) $
    warnError verbosity "Hackage would reject this package."

  when (null packageChecks) $
    notice verbosity "No errors or warnings could be found in the package."

  return (null errors)

-------------------------------------------------------------------------------
-- Grouping/displaying checks

-- Poor man’s “group checks by constructor”.
groupChecks :: [PackageCheck] -> [NE.NonEmpty PackageCheck]
groupChecks :: [PackageCheck] -> [NonEmpty PackageCheck]
groupChecks [PackageCheck]
ds =
  (PackageCheck -> PackageCheck -> Bool)
-> [PackageCheck] -> [NonEmpty PackageCheck]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy
    ((Int -> Int -> Bool)
-> (PackageCheck -> Int) -> PackageCheck -> PackageCheck -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
F.on Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) PackageCheck -> Int
constInt)
    ((PackageCheck -> PackageCheck -> Ordering)
-> [PackageCheck] -> [PackageCheck]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy ((Int -> Int -> Ordering)
-> (PackageCheck -> Int)
-> PackageCheck
-> PackageCheck
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
F.on Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare PackageCheck -> Int
constInt) [PackageCheck]
ds)
  where
    constInt :: PackageCheck -> Int
    constInt :: PackageCheck -> Int
constInt (PackageBuildImpossible{}) = Int
0
    constInt (PackageBuildWarning{}) = Int
1
    constInt (PackageDistSuspicious{}) = Int
2
    constInt (PackageDistSuspiciousWarn{}) = Int
3
    constInt (PackageDistInexcusable{}) = Int
4

groupExplanation :: PackageCheck -> String
groupExplanation :: PackageCheck -> FilePath
groupExplanation (PackageBuildImpossible{}) = FilePath
"The package will not build sanely due to these errors:"
groupExplanation (PackageBuildWarning{}) = FilePath
"The following errors are likely to affect your build negatively:"
groupExplanation (PackageDistSuspicious{}) = FilePath
"These warnings will likely cause trouble when distributing the package:"
groupExplanation (PackageDistSuspiciousWarn{}) = FilePath
"These warnings may cause trouble when distributing the package:"
groupExplanation (PackageDistInexcusable{}) = FilePath
"The following errors will cause portability problems on other environments:"

groupOutputFunction :: PackageCheck -> Verbosity -> String -> IO ()
groupOutputFunction :: PackageCheck -> Verbosity -> FilePath -> IO ()
groupOutputFunction (PackageBuildImpossible{}) Verbosity
ver = Verbosity -> FilePath -> IO ()
warnError Verbosity
ver
groupOutputFunction (PackageBuildWarning{}) Verbosity
ver = Verbosity -> FilePath -> IO ()
warnError Verbosity
ver
groupOutputFunction (PackageDistSuspicious{}) Verbosity
ver = Verbosity -> FilePath -> IO ()
warn Verbosity
ver
groupOutputFunction (PackageDistSuspiciousWarn{}) Verbosity
ver = Verbosity -> FilePath -> IO ()
warn Verbosity
ver
groupOutputFunction (PackageDistInexcusable{}) Verbosity
ver = Verbosity -> FilePath -> IO ()
warnError Verbosity
ver

outputGroupCheck :: Verbosity -> NE.NonEmpty PackageCheck -> IO ()
outputGroupCheck :: Verbosity -> NonEmpty PackageCheck -> IO ()
outputGroupCheck Verbosity
ver NonEmpty PackageCheck
pcs = do
  let hp :: PackageCheck
hp = NonEmpty PackageCheck -> PackageCheck
forall a. NonEmpty a -> a
NE.head NonEmpty PackageCheck
pcs
      outf :: FilePath -> IO ()
outf = PackageCheck -> Verbosity -> FilePath -> IO ()
groupOutputFunction PackageCheck
hp Verbosity
ver
  Verbosity -> FilePath -> IO ()
notice Verbosity
ver (PackageCheck -> FilePath
groupExplanation PackageCheck
hp)
  (PackageCheck -> IO ()) -> NonEmpty PackageCheck -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
CM.mapM_ (FilePath -> IO ()
outf (FilePath -> IO ())
-> (PackageCheck -> FilePath) -> PackageCheck -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageCheck -> FilePath
ppPackageCheck) NonEmpty PackageCheck
pcs