{-# 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.Configuration (flattenPackageDescription)
import Distribution.PackageDescription.Parsec
(parseGenericPackageDescription, runParseResult)
import Distribution.Parsec (PWarning (..), showPError)
import Distribution.Simple.Utils (defaultPackageDesc, die', notice, warn)
import System.IO (hPutStr, stderr)
import qualified Data.ByteString as BS
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
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists forall a b. (a -> b) -> a -> b
$
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
FilePath
"Error Parsing: file \"" forall a. [a] -> [a] -> [a]
++ FilePath
fpath forall a. [a] -> [a] -> [a]
++ FilePath
"\" doesn't exist. Cannot continue."
ByteString
bs <- FilePath -> IO ByteString
BS.readFile FilePath
fpath
let ([PWarning]
warnings, Either (Maybe Version, NonEmpty PError) GenericPackageDescription
result) = 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
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity 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 forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> NonEmpty PError -> [PWarning] -> FilePath
renderParseError FilePath
fpath ByteString
bs NonEmpty PError
errors [PWarning]
warnings
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity FilePath
"parse error"
Right GenericPackageDescription
x -> forall (m :: * -> *) a. Monad m => a -> m a
return ([PWarning]
warnings, GenericPackageDescription
x)
check :: Verbosity -> IO Bool
check :: Verbosity -> IO Bool
check Verbosity
verbosity = do
FilePath
pdfile <- Verbosity -> IO FilePath
defaultPackageDesc Verbosity
verbosity
([PWarning]
ws, GenericPackageDescription
ppd) <- Verbosity -> FilePath -> IO ([PWarning], GenericPackageDescription)
readGenericPackageDescriptionCheck Verbosity
verbosity FilePath
pdfile
let ws' :: [PackageCheck]
ws' = forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> PWarning -> PackageCheck
wrapParseWarning FilePath
pdfile) [PWarning]
ws
let pkg_desc :: PackageDescription
pkg_desc = GenericPackageDescription -> PackageDescription
flattenPackageDescription GenericPackageDescription
ppd
[PackageCheck]
ioChecks <- Verbosity -> PackageDescription -> FilePath -> IO [PackageCheck]
checkPackageFiles Verbosity
verbosity PackageDescription
pkg_desc FilePath
"."
let packageChecks :: [PackageCheck]
packageChecks = [PackageCheck]
ioChecks forall a. [a] -> [a] -> [a]
++ GenericPackageDescription
-> Maybe PackageDescription -> [PackageCheck]
checkPackage GenericPackageDescription
ppd (forall a. a -> Maybe a
Just PackageDescription
pkg_desc) forall a. [a] -> [a] -> [a]
++ [PackageCheck]
ws'
buildImpossible :: [PackageCheck]
buildImpossible = [ PackageCheck
x | x :: PackageCheck
x@PackageBuildImpossible {} <- [PackageCheck]
packageChecks ]
buildWarning :: [PackageCheck]
buildWarning = [ PackageCheck
x | x :: PackageCheck
x@PackageBuildWarning {} <- [PackageCheck]
packageChecks ]
distSuspicious :: [PackageCheck]
distSuspicious = [ PackageCheck
x | x :: PackageCheck
x@PackageDistSuspicious {} <- [PackageCheck]
packageChecks ]
forall a. [a] -> [a] -> [a]
++ [ PackageCheck
x | x :: PackageCheck
x@PackageDistSuspiciousWarn {} <- [PackageCheck]
packageChecks ]
distInexusable :: [PackageCheck]
distInexusable = [ PackageCheck
x | x :: PackageCheck
x@PackageDistInexcusable {} <- [PackageCheck]
packageChecks ]
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageCheck]
buildImpossible) forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity FilePath
"The package will not build sanely due to these errors:"
[PackageCheck] -> IO ()
printCheckMessages [PackageCheck]
buildImpossible
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageCheck]
buildWarning) forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity FilePath
"The following warnings are likely to affect your build negatively:"
[PackageCheck] -> IO ()
printCheckMessages [PackageCheck]
buildWarning
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageCheck]
distSuspicious) forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity FilePath
"These warnings may cause trouble when distributing the package:"
[PackageCheck] -> IO ()
printCheckMessages [PackageCheck]
distSuspicious
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageCheck]
distInexusable) forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity FilePath
"The following errors will cause portability problems on other environments:"
[PackageCheck] -> IO ()
printCheckMessages [PackageCheck]
distInexusable
let isDistError :: PackageCheck -> Bool
isDistError (PackageDistSuspicious {}) = Bool
False
isDistError (PackageDistSuspiciousWarn {}) = Bool
False
isDistError PackageCheck
_ = Bool
True
isCheckError :: PackageCheck -> Bool
isCheckError (PackageDistSuspiciousWarn {}) = Bool
False
isCheckError PackageCheck
_ = Bool
True
errors :: [PackageCheck]
errors = forall a. (a -> Bool) -> [a] -> [a]
filter PackageCheck -> Bool
isDistError [PackageCheck]
packageChecks
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageCheck]
errors) forall a b. (a -> b) -> a -> b
$
Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity FilePath
"Hackage would reject this package."
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageCheck]
packageChecks) forall a b. (a -> b) -> a -> b
$
Verbosity -> FilePath -> IO ()
notice Verbosity
verbosity FilePath
"No errors or warnings could be found in the package."
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any PackageCheck -> Bool
isCheckError forall a b. (a -> b) -> a -> b
$ [PackageCheck]
packageChecks)
where
printCheckMessages :: [PackageCheck] -> IO ()
printCheckMessages :: [PackageCheck] -> IO ()
printCheckMessages = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> FilePath
show