From 87118d2f04f6d90192c818281a106ddfec454c34 Mon Sep 17 00:00:00 2001 From: Alexis Williams Date: Fri, 27 Jul 2018 01:32:03 -0700 Subject: [PATCH] Attempt to avoid Haddock errors, make them nonfatal anyway --- Cabal/ChangeLog.md | 7 ++++ Cabal/Distribution/Compat/Lens.hs | 28 +++++++++++++ Cabal/Distribution/Simple/Haddock.hs | 7 ++++ .../Types/PackageDescription/Lens.hs | 40 ++++++++++++++++--- .../Distribution/Client/ProjectBuilding.hs | 22 ++++++++-- .../Client/ProjectOrchestration.hs | 11 ++++- cabal-install/changelog | 5 ++- 7 files changed, 109 insertions(+), 11 deletions(-) diff --git a/Cabal/ChangeLog.md b/Cabal/ChangeLog.md index 25043ca6603..4240b45fcfc 100644 --- a/Cabal/ChangeLog.md +++ b/Cabal/ChangeLog.md @@ -1,4 +1,11 @@ # 2.4.0.0 (current development version) + * `Distribution.Simple.Haddock` now checks to ensure that it + does not erroneously call Haddock with no target modules. + ([#5232](https://github.com/haskell/cabal/issues/5232), + [#5459](https://github.com/haskell/cabal/issues/5459)). + * Add more Lens combinators (`to`, `traversed`, `filtered`, + `non`) and an optic to access the modules in a component + of a `PackageDescription` by the `ComponentName`. * Add `readGhcEnvironmentFile` to parse GHC environment files. * Drop support for GHC 7.4, since it is out of our support window (and has been for over a year!) diff --git a/Cabal/Distribution/Compat/Lens.hs b/Cabal/Distribution/Compat/Lens.hs index 90c02b39b65..0ff135b1ca7 100644 --- a/Cabal/Distribution/Compat/Lens.hs +++ b/Cabal/Distribution/Compat/Lens.hs @@ -21,6 +21,7 @@ module Distribution.Compat.Lens ( -- * Getter view, use, + to, -- * Setter set, over, @@ -28,9 +29,13 @@ module Distribution.Compat.Lens ( toDListOf, toListOf, toSetOf, + -- * Traversal + filtered, + traversed, -- * Lens cloneLens, aview, + non, -- * Common lenses _1, _2, -- * Operators @@ -52,6 +57,7 @@ import Distribution.Compat.Prelude import Control.Applicative (Const (..)) import Data.Functor.Identity (Identity (..)) import Control.Monad.State.Class (MonadState (..), gets, modify) +import Unsafe.Coerce import qualified Distribution.Compat.DList as DList import qualified Data.Set as Set @@ -89,6 +95,10 @@ use :: MonadState s m => Getting a s a -> m a use l = gets (view l) {-# INLINE use #-} +to :: (s -> a) -> AGetter s a +to k f = (unsafeCoerce :: Const t a -> Const t b) . f . k +{-# INLINE to #-} + ------------------------------------------------------------------------------- -- Setter ------------------------------------------------------------------------------- @@ -112,6 +122,18 @@ toListOf l = DList.runDList . toDListOf l toSetOf :: Getting (Set.Set a) s a -> s -> Set.Set a toSetOf l s = getConst (l (\x -> Const (Set.singleton x)) s) +------------------------------------------------------------------------------- +-- Traversal +------------------------------------------------------------------------------- + +filtered :: (a -> Bool) -> Traversal' a a +filtered p f s = if p s then f s else pure s +{-# INLINE filtered #-} + +traversed :: Traversable f => Traversal (f a) (f b) a b +traversed = traverse +{-# INLINE [0] traversed #-} + ------------------------------------------------------------------------------- -- Lens ------------------------------------------------------------------------------- @@ -119,11 +141,17 @@ toSetOf l s = getConst (l (\x -> Const (Set.singleton x)) s) aview :: ALens s t a b -> s -> a aview l = pretextPos . l pretextSell {-# INLINE aview #-} + {- lens :: (s -> a) -> (s -> a -> s) -> Lens' s a lens sa sbt afb s = sbt s <$> afb (sa s) -} +non :: Eq a => a -> Lens' (Maybe a) a +non x afb s = f <$> afb (fromMaybe x s) + where f y = if x == y then Nothing else Just y +{-# INLINE non #-} + ------------------------------------------------------------------------------- -- Common ------------------------------------------------------------------------------- diff --git a/Cabal/Distribution/Simple/Haddock.hs b/Cabal/Distribution/Simple/Haddock.hs index 13e79755a8c..18e825c4eca 100644 --- a/Cabal/Distribution/Simple/Haddock.hs +++ b/Cabal/Distribution/Simple/Haddock.hs @@ -148,6 +148,13 @@ haddock pkg_descr _ _ haddockFlags ++ "a library. Perhaps you want to use the --executables, --tests," ++ " --benchmarks or --foreign-libraries flags." +haddock _ _ _ haddockFlags + | null (argTargets haddockFlags) = warn verbosity $ + "Haddocks are being requested, but there aren't any modules given " + ++ "to create documentation for." + where + verbosity = fromFlag $ haddockVerbosity haddockFlags + haddock pkg_descr lbi suffixes flags' = do let verbosity = flag haddockVerbosity comp = compiler lbi diff --git a/Cabal/Distribution/Types/PackageDescription/Lens.hs b/Cabal/Distribution/Types/PackageDescription/Lens.hs index e08dbc45848..7c80b801582 100644 --- a/Cabal/Distribution/Types/PackageDescription/Lens.hs +++ b/Cabal/Distribution/Types/PackageDescription/Lens.hs @@ -9,16 +9,21 @@ import Prelude () import Distribution.Compiler (CompilerFlavor) import Distribution.License (License) -import Distribution.Types.Benchmark (Benchmark) +import Distribution.Types.Benchmark (Benchmark, benchmarkModules) +import Distribution.Types.Benchmark.Lens (benchmarkName) import Distribution.Types.BuildType (BuildType) -import Distribution.Types.Executable (Executable) -import Distribution.Types.ForeignLib (ForeignLib) -import Distribution.Types.Library (Library) +import Distribution.Types.Executable (Executable, exeModules) +import Distribution.Types.Executable.Lens (exeName) +import Distribution.Types.ForeignLib (ForeignLib, foreignLibModules) +import Distribution.Types.ForeignLib.Lens (foreignLibName) +import Distribution.Types.Library (Library, libModules) +import Distribution.Types.Library.Lens (libName) import Distribution.Types.PackageDescription (PackageDescription) import Distribution.Types.PackageId (PackageIdentifier) import Distribution.Types.SetupBuildInfo (SetupBuildInfo) import Distribution.Types.SourceRepo (SourceRepo) -import Distribution.Types.TestSuite (TestSuite) +import Distribution.Types.TestSuite (TestSuite, testModules) +import Distribution.Types.TestSuite.Lens (testName) import Distribution.Version (Version, VersionRange) import qualified Distribution.SPDX as SPDX @@ -143,3 +148,28 @@ extraTmpFiles f s = fmap (\x -> s { T.extraTmpFiles = x }) (f (T.extraTmpFiles s extraDocFiles :: Lens' PackageDescription [String] extraDocFiles f s = fmap (\x -> s { T.extraDocFiles = x }) (f (T.extraDocFiles s)) {-# INLINE extraDocFiles #-} + +componentModules :: ComponentName -> Traversal' PackageDescription [ModuleName] +componentModules cname = case cname of + CLibName -> library . traversed . to libModules + CSubLibName name -> + componentModules' name subLibraries (libName . non "") libModules + CFLibName name -> + componentModules' name foreignLibs foreignLibName foreignLibModules + CExeName name -> + componentModules' name executables exeName exeModules + CTestName name -> + componentModules' name testSuites testName testModules + CBenchName name -> + componentModules' name benchmarks benchmarkName benchmarkModules + where + componentModules' :: UnqualComponentName + -> Traversal' PackageDescription [a] + -> Traversal' a UnqualComponentName + -> (a -> [ModuleName]) + -> Traversal' PackageDescription BuildInfo + componentModules' name pdL nameL modules = + pdL + . traversed + . filtered ((== name) . view nameL) + . to modules diff --git a/cabal-install/Distribution/Client/ProjectBuilding.hs b/cabal-install/Distribution/Client/ProjectBuilding.hs index 6cfc401ab0f..f575787ea67 100644 --- a/cabal-install/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/Distribution/Client/ProjectBuilding.hs @@ -67,6 +67,7 @@ import Distribution.Client.SourceFiles import Distribution.Client.SrcDist (allPackageSourceFiles) import Distribution.Client.Utils (removeExistingFile) +import Distribution.Compat.Lens import Distribution.Package hiding (InstalledPackageId, installedPackageId) import qualified Distribution.PackageDescription as PD import Distribution.InstalledPackageInfo (InstalledPackageInfo) @@ -74,6 +75,7 @@ import qualified Distribution.InstalledPackageInfo as Installed import Distribution.Simple.BuildPaths (haddockDirName) import qualified Distribution.Simple.InstallDirs as InstallDirs import Distribution.Types.BuildType +import Distribution.Types.PackageDescription.Lens (componentModules) import Distribution.Simple.Program import qualified Distribution.Simple.Setup as Cabal import Distribution.Simple.Command (CommandUI) @@ -1049,8 +1051,8 @@ buildAndInstallUnpackedPackage verbosity isParallelBuild = buildSettingNumJobs >= 2 whenHaddock action - | elabBuildHaddocks pkg = action - | otherwise = return () + | hasValidHaddockTargets = action + | otherwise = return () configureCommand = Cabal.configureCommand defaultProgramDb configureFlags v = flip filterConfigureFlags v $ @@ -1115,6 +1117,18 @@ buildAndInstallUnpackedPackage verbosity Just logFile -> withFile logFile AppendMode (action . Just) +hasValidHaddockTargets :: ElaboratedConfiguredPackage -> Bool +hasValidHaddockTargets pkg + | not (elabBuildHaddocks pkg) = False + | otherwise = any componentHasHaddocks components + where + components = elabHaddockTargets pkg + pd = elabPkgDescription pkg + + componentHasHaddocks (ComponentTarget name _) = + not (null (pd ^. componentModules name)) + + buildInplaceUnpackedPackage :: Verbosity -> DistDirLayout -> BuildTimeSettings -> Lock -> Lock @@ -1285,8 +1299,8 @@ buildInplaceUnpackedPackage verbosity | otherwise = action whenHaddock action - | elabBuildHaddocks pkg = action - | otherwise = return () + | hasValidHaddockTargets = action + | otherwise = return () whenReRegister action = case buildStatus of diff --git a/cabal-install/Distribution/Client/ProjectOrchestration.hs b/cabal-install/Distribution/Client/ProjectOrchestration.hs index 8f3dd2939a1..5e56778ca49 100644 --- a/cabal-install/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/Distribution/Client/ProjectOrchestration.hs @@ -940,7 +940,7 @@ dieOnBuildFailures verbosity plan buildOutcomes -- For all failures, print either a short summary (if we showed the -- build log) or all details - die' verbosity $ unlines + fail' verbosity $ unlines [ case failureClassification of ShowBuildSummaryAndLog reason _ | verbosity > normal @@ -969,6 +969,15 @@ dieOnBuildFailures verbosity plan buildOutcomes maybeToList (InstallPlan.lookup plan pkgid) ] + fail' + | all isHaddockFailure failuresClassification = warn + | otherwise = die' + where + isHaddockFailure (_, ShowBuildSummaryOnly (HaddocksFailed _) ) = True + isHaddockFailure (_, ShowBuildSummaryAndLog (HaddocksFailed _) _) = True + isHaddockFailure _ = False + + classifyBuildFailure :: BuildFailure -> BuildFailurePresentation classifyBuildFailure BuildFailure { buildFailureReason = reason, diff --git a/cabal-install/changelog b/cabal-install/changelog index caf0bb0b176..fc57d2f23fa 100644 --- a/cabal-install/changelog +++ b/cabal-install/changelog @@ -1,7 +1,10 @@ -*-change-log-*- 2.4.0.0 (current development version) - * 'new-install' now supports installing libraries and local + * 'new-build' now treats Haddock errors non-fatally. In addition, + it attempts to avoid trying to generate Haddocks when there is + nothing to generate them from. (#5232, #5459) + * 'new-install' now supports installing libraries and local components. (#5399) * Drop support for GHC 7.4, since it is out of our support window (and has been for over a year!).