Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/f6ab0f6206ce23cc1bbbea53bcc5d4f927ea54f0 >--------------------------------------------------------------- commit f6ab0f6206ce23cc1bbbea53bcc5d4f927ea54f0 Author: Lennart Kolmodin <[email protected]> Date: Thu Feb 21 20:48:20 2008 +0000 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. >--------------------------------------------------------------- cabal-install/Hackage/Check.hs | 76 ++++++++++++++++++++++++++++++++++++++++ cabal-install/Hackage/Setup.hs | 11 ++++++ cabal-install/Main.hs | 13 ++++++- 3 files changed, 98 insertions(+), 2 deletions(-) diff --git a/cabal-install/Hackage/Check.hs b/cabal-install/Hackage/Check.hs new file mode 100644 index 0000000..9589de9 --- /dev/null +++ b/cabal-install/Hackage/Check.hs @@ -0,0 +1,76 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Hackage.Check +-- Copyright : (c) Lennart Kolmodin 2008 +-- License : BSD-like +-- +-- Maintainer : [email protected] +-- 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." diff --git a/cabal-install/Hackage/Setup.hs b/cabal-install/Hackage/Setup.hs index 5350f51..1115ae6 100644 --- a/cabal-install/Hackage/Setup.hs +++ b/cabal-install/Hackage/Setup.hs @@ -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 -- ------------------------------------------------------------ diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs index b6c0c98..6d222a2 100644 --- a/cabal-install/Main.hs +++ b/cabal-install/Main.hs @@ -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) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
