Commit f6ab0f62 authored by Lennart Kolmodin's avatar Lennart Kolmodin

Naive implementation of 'cabal check'

A naive implementation of 'cabal check'.
It will list the errors and warnings as implemented by Cabal, yielding them
in groups of severity. Currently ignores verbosity levels, no additional
arguments are understood. This addresses ticket #211.
parent ff10a391
-----------------------------------------------------------------------------
-- |
-- Module : Hackage.Check
-- Copyright : (c) Lennart Kolmodin 2008
-- License : BSD-like
--
-- Maintainer : kolmodin@haskell.org
-- Stability : provisional
-- Portability : portable
--
-- Check a package for common mistakes
--
-----------------------------------------------------------------------------
module Hackage.Check (
check
) where
import Control.Monad ( unless )
import Distribution.PackageDescription.Parse ( readPackageDescription )
import Distribution.PackageDescription.Check
import Distribution.PackageDescription.Configuration ( flattenPackageDescription )
import Distribution.Verbosity ( Verbosity )
import Distribution.Simple.Utils ( defaultPackageDesc )
check :: Verbosity -> IO ()
check verbosity = do
pdfile <- defaultPackageDesc verbosity
ppd <- readPackageDescription verbosity pdfile
-- 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.
-- Hovever, this is the same way hackage does it, so we will yield
-- the exact same errors as it will.
let pkg_desc = flattenPackageDescription ppd
ioChecks <- checkPackageFiles pkg_desc "."
let packageChecks = ioChecks ++ checkPackage pkg_desc
buildImpossible = [ x | x@PackageBuildImpossible {} <- packageChecks ]
buildWarning = [ x | x@PackageBuildWarning {} <- packageChecks ]
distSuspicious = [ x | x@PackageDistSuspicious {} <- packageChecks ]
distInexusable = [ x | x@PackageDistInexcusable {} <- packageChecks ]
unless (null buildImpossible) $ do
putStrLn "The package will not build sanely due to these errors:"
mapM_ (putStrLn . explanation) buildImpossible
putStrLn ""
unless (null buildWarning) $ do
putStrLn "The following warnings are likely affect your build negatively:"
mapM_ (putStrLn . explanation) buildWarning
putStrLn ""
unless (null distSuspicious) $ do
putStrLn "These warnings may cause trouble when distribution the package:"
mapM_ (putStrLn . explanation) distSuspicious
putStrLn ""
unless (null distInexusable) $ do
putStrLn "The following errors will cause portability problems on other environments:"
mapM_ (putStrLn . explanation) distInexusable
putStrLn ""
let isDistError (PackageDistSuspicious {}) = False
isDistError _ = True
errors = filter isDistError packageChecks
unless (null errors) $ do
putStrLn "Hackage would reject this package."
......@@ -19,6 +19,7 @@ module Hackage.Setup
, upgradeCommand
, infoCommand
, fetchCommand
, checkCommand
, uploadCommand, UploadFlags(..)
, parsePackageArgs
......@@ -134,6 +135,16 @@ infoCommand = CommandUI {
commandOptions = \_ -> [optionVerbose id const]
}
checkCommand :: CommandUI (Flag Verbosity)
checkCommand = CommandUI {
commandName = "check",
commandSynopsis = "Check the package for common mistakes",
commandDescription = Nothing,
commandUsage = \pname -> "Usage: " ++ pname ++ " check\n",
commandDefaultFlags = mempty,
commandOptions = mempty
}
-- ------------------------------------------------------------
-- * Upload flags
-- ------------------------------------------------------------
......
......@@ -31,8 +31,9 @@ import Hackage.Info (info)
import Hackage.Update (update)
import Hackage.Upgrade (upgrade)
import Hackage.Fetch (fetch)
import Hackage.Check as Check (check)
--import Hackage.Clean (clean)
import Hackage.Upload (upload, check)
import Hackage.Upload as Upload (upload, check)
import Distribution.Verbosity (Verbosity, normal)
import Distribution.Version (showVersion)
......@@ -42,6 +43,7 @@ import System.Environment (getArgs, getProgName)
import System.Exit (exitWith, ExitCode(..))
import Data.List (intersperse)
import Data.Monoid (Monoid(..))
import Control.Monad (unless)
-- | Entry point
--
......@@ -85,6 +87,7 @@ mainWorker args =
,upgradeCommand `commandAddAction` upgradeAction
,fetchCommand `commandAddAction` fetchAction
,uploadCommand `commandAddAction` uploadAction
,checkCommand `commandAddAction` checkAction
,wrapperAction (Cabal.buildCommand defaultProgramConfiguration)
,wrapperAction Cabal.copyCommand
......@@ -187,10 +190,16 @@ uploadAction flags extraArgs = do
-- FIXME: check that the .tar.gz files exist and report friendly error message if not
let tarfiles = extraArgs
if fromFlag (uploadCheck flags)
then check verbosity tarfiles
then Upload.check verbosity tarfiles
else upload verbosity
(flagToMaybe $ configUploadUsername config
`mappend` uploadUsername flags)
(flagToMaybe $ configUploadPassword config
`mappend` uploadPassword flags)
tarfiles
checkAction :: Flag Verbosity -> [String] -> IO ()
checkAction verbosityFlag extraArgs = do
unless (null extraArgs) $ do
die $ "'check' doesn't take any extra arguments: " ++ unwords extraArgs
Check.check (fromFlag verbosityFlag)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment