{-# 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, showPWarning)
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
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 -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"Error Parsing: file \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fpath FilePath -> FilePath -> FilePath
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) = 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 -> FilePath -> IO ([PWarning], GenericPackageDescription)
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity FilePath
"parse error"
Right GenericPackageDescription
x -> ([PWarning], GenericPackageDescription)
-> IO ([PWarning], GenericPackageDescription)
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' = [ FilePath -> PackageCheck
PackageDistSuspicious (FilePath -> PWarning -> FilePath
showPWarning FilePath
pdfile PWarning
w) | PWarning
w <- [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 [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ GenericPackageDescription
-> Maybe PackageDescription -> [PackageCheck]
checkPackage GenericPackageDescription
ppd (PackageDescription -> Maybe PackageDescription
forall a. a -> Maybe a
Just PackageDescription
pkg_desc) [PackageCheck] -> [PackageCheck] -> [PackageCheck]
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 ]
[PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ [ PackageCheck
x | x :: PackageCheck
x@PackageDistSuspiciousWarn {} <- [PackageCheck]
packageChecks ]
distInexusable :: [PackageCheck]
distInexusable = [ PackageCheck
x | x :: PackageCheck
x@PackageDistInexcusable {} <- [PackageCheck]
packageChecks ]
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([PackageCheck] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageCheck]
buildImpossible) (IO () -> IO ()) -> IO () -> IO ()
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
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([PackageCheck] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageCheck]
buildWarning) (IO () -> IO ()) -> IO () -> IO ()
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
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([PackageCheck] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageCheck]
distSuspicious) (IO () -> IO ()) -> IO () -> IO ()
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
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([PackageCheck] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageCheck]
distInexusable) (IO () -> IO ()) -> IO () -> IO ()
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 = (PackageCheck -> Bool) -> [PackageCheck] -> [PackageCheck]
forall a. (a -> Bool) -> [a] -> [a]
filter PackageCheck -> Bool
isDistError [PackageCheck]
packageChecks
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([PackageCheck] -> 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 ()
warn Verbosity
verbosity FilePath
"Hackage would reject this package."
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([PackageCheck] -> 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 (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool
not (Bool -> Bool)
-> ([PackageCheck] -> Bool) -> [PackageCheck] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageCheck -> Bool) -> [PackageCheck] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any PackageCheck -> Bool
isCheckError ([PackageCheck] -> Bool) -> [PackageCheck] -> Bool
forall a b. (a -> b) -> a -> b
$ [PackageCheck]
packageChecks)
where
printCheckMessages :: [PackageCheck] -> IO ()
printCheckMessages = (PackageCheck -> IO ()) -> [PackageCheck] -> 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 ())
-> (PackageCheck -> FilePath) -> PackageCheck -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageCheck -> FilePath
explanation)