{-# LANGUAGE CPP #-}

-----------------------------------------------------------------------------

-----------------------------------------------------------------------------

-- |
-- 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.Utils.Parsec (renderParseError)
import Distribution.PackageDescription (GenericPackageDescription)
import Distribution.PackageDescription.Check
import Distribution.PackageDescription.Parsec
  ( parseGenericPackageDescription
  , runParseResult
  )
import Distribution.Parsec (PWarning (..), showPError)
import Distribution.Simple.Utils (defaultPackageDesc, dieWithException, notice, warn, warnError)
import System.IO (hPutStr, stderr)

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 Distribution.Client.Errors
import qualified System.Directory as Dir

readGenericPackageDescriptionCheck :: Verbosity -> FilePath -> IO ([PWarning], GenericPackageDescription)
readGenericPackageDescriptionCheck :: Verbosity -> FilePath -> IO ([PWarning], GenericPackageDescription)
readGenericPackageDescriptionCheck Verbosity
verbosity FilePath
fpath = do
  Bool
exists <- FilePath -> IO Bool
Dir.doesFileExist FilePath
fpath
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Verbosity -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO ()) -> CabalInstallException -> IO ()
forall a b. (a -> b) -> a -> b
$
      FilePath -> CabalInstallException
FileDoesntExist FilePath
fpath
  ByteString
bs <- FilePath -> IO ByteString
BS.readFile FilePath
fpath
  let ([PWarning]
warnings, Either (Maybe Version, NonEmpty PError) GenericPackageDescription
result) = ParseResult GenericPackageDescription
-> ([PWarning],
    Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
forall a.
ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
runParseResult (ByteString -> ParseResult GenericPackageDescription
parseGenericPackageDescription ByteString
bs)
  case Either (Maybe Version, NonEmpty PError) GenericPackageDescription
result of
    Left (Maybe Version
_, NonEmpty PError
errors) -> do
      (PError -> IO ()) -> NonEmpty PError -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> (PError -> FilePath) -> PError -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> PError -> FilePath
showPError FilePath
fpath) NonEmpty PError
errors
      Handle -> FilePath -> IO ()
hPutStr Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> NonEmpty PError -> [PWarning] -> FilePath
renderParseError FilePath
fpath ByteString
bs NonEmpty PError
errors [PWarning]
warnings
      Verbosity
-> CabalInstallException
-> IO ([PWarning], GenericPackageDescription)
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalInstallException
ParseError
    Right GenericPackageDescription
x -> ([PWarning], GenericPackageDescription)
-> IO ([PWarning], GenericPackageDescription)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PWarning]
warnings, GenericPackageDescription
x)

-- | Checks a packge 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
  FilePath
pdfile <- Verbosity -> IO FilePath
defaultPackageDesc Verbosity
verbosity
  ([PWarning]
ws, GenericPackageDescription
ppd) <- Verbosity -> FilePath -> IO ([PWarning], GenericPackageDescription)
readGenericPackageDescriptionCheck Verbosity
verbosity FilePath
pdfile
  -- convert parse warnings into PackageChecks
  let ws' :: [PackageCheck]
ws' = (PWarning -> PackageCheck) -> [PWarning] -> [PackageCheck]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> PWarning -> PackageCheck
wrapParseWarning FilePath
pdfile) [PWarning]
ws
  [PackageCheck]
ioChecks <- Verbosity
-> GenericPackageDescription -> FilePath -> IO [PackageCheck]
checkPackageFilesGPD Verbosity
verbosity GenericPackageDescription
ppd FilePath
"."
  let packageChecksPrim :: [PackageCheck]
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'
      ([PackageCheck]
packageChecks, [FilePath]
unrecs) = [PackageCheck] -> [FilePath] -> ([PackageCheck], [FilePath])
filterPackageChecksByIdString [PackageCheck]
packageChecksPrim [FilePath]
ignores

  (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
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
"\"")) [FilePath]
unrecs

  (NonEmpty PackageCheck -> IO ())
-> [NonEmpty PackageCheck] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
CM.mapM_ (Verbosity -> NonEmpty PackageCheck -> IO ()
outputGroupCheck Verbosity
verbosity) ([PackageCheck] -> [NonEmpty PackageCheck]
groupChecks [PackageCheck]
packageChecks)

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

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([PackageCheck] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageCheck]
errors) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Verbosity -> FilePath -> IO ()
warnError Verbosity
verbosity FilePath
"Hackage would reject this package."

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([PackageCheck] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageCheck]
packageChecks) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Verbosity -> FilePath -> IO ()
notice Verbosity
verbosity FilePath
"No errors or warnings could be found in the package."

  Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PackageCheck] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageCheck]
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