{-# LANGUAGE CPP #-}
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
exists <- FilePath -> IO Bool
Dir.doesFileExist FilePath
fpath
unless exists $
dieWithException verbosity $
FileDoesntExist fpath
bs <- BS.readFile fpath
let (warnings, result) = runParseResult (parseGenericPackageDescription bs)
case 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)
check
:: Verbosity
-> [CheckExplanationIDString]
-> IO Bool
check :: Verbosity -> [FilePath] -> IO Bool
check Verbosity
verbosity [FilePath]
ignores = do
pdfile <- Verbosity -> IO FilePath
defaultPackageDesc Verbosity
verbosity
(ws, ppd) <- readGenericPackageDescriptionCheck verbosity pdfile
let ws' = (PWarning -> PackageCheck) -> [PWarning] -> [PackageCheck]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> PWarning -> PackageCheck
wrapParseWarning FilePath
pdfile) [PWarning]
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)
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