{-# 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.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)

-- | Note: must be called with the CWD set to the directory containing
-- the '.cabal' file.
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
    -- convert parse warnings into PackageChecks
    -- Note: we /could/ pick different levels, based on warning type.
    let ws' :: [PackageCheck]
ws' = [ FilePath -> PackageCheck
PackageDistSuspicious (FilePath -> PWarning -> FilePath
showPWarning FilePath
pdfile PWarning
w) | PWarning
w <- [PWarning]
ws ]
    -- flatten the generic package description into a regular package
    -- description
    -- TODO: this may give more warnings than it should give;
    --       consider two branches of a condition, one saying
    --          ghc-options: -Wall
    --       and the other
    --          ghc-options: -Werror
    --      joined into
    --          ghc-options: -Wall -Werror
    --      checkPackages will yield a warning on the last line, but it
    --      would not on each individual branch.
    --      However, this is the same way hackage does it, so we will yield
    --      the exact same errors as it will.
    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)