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

-- | 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
    let ws' :: [PackageCheck]
ws' = forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> PWarning -> PackageCheck
wrapParseWarning FilePath
pdfile) [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 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
        -- xxx mapM_ o traverse?