Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/1a247ede83dc0141fa9222e3e6cffc4cc99fa8c7 >--------------------------------------------------------------- commit 1a247ede83dc0141fa9222e3e6cffc4cc99fa8c7 Author: Duncan Coutts <[email protected]> Date: Wed Aug 6 17:58:34 2008 +0000 Add --enable/disable-documentation flag. This addresses most of ticket #206. >--------------------------------------------------------------- cabal-install/Distribution/Client/Install.hs | 10 +++++++--- cabal-install/Distribution/Client/Setup.hs | 18 +++++++++++++++--- 2 files changed, 22 insertions(+), 6 deletions(-) diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index 0a8cbbf..9502e68 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/cabal-install/Distribution/Client/Install.hs @@ -156,7 +156,7 @@ installWithPlanner planner verbosity packageDB repos comp conf configFlags insta installConfiguredPackage configFlags cpkg $ \configFlags' apkg -> installAvailablePackage verbosity apkg $ \pkg mpath -> installUnpackedPackage verbosity (setupScriptOptions installed) - miscOptions configFlags' + miscOptions configFlags' installFlags pkg mpath useLogFile writeInstallPlanBuildReports installPlan' writeInstallPlanBuildLog installPlan' @@ -364,11 +364,13 @@ installUnpackedPackage :: Verbosity -> SetupScriptOptions -> InstallMisc -> Cabal.ConfigFlags + -> InstallFlags -> GenericPackageDescription -> Maybe FilePath -- ^ Directory to change to before starting the installation. -> Maybe (PackageIdentifier -> FilePath) -- ^ File to log output to (if any) -> IO BuildResult -installUnpackedPackage verbosity scriptOptions miscOptions configFlags +installUnpackedPackage verbosity scriptOptions miscOptions + configFlags installConfigFlags pkg workingDir useLogFile = -- Configure phase @@ -380,7 +382,7 @@ installUnpackedPackage verbosity scriptOptions miscOptions configFlags setup buildCommand buildFlags -- Doc generation phase - docsResult <- if False --TODO: add flag to enable/disable haddock + docsResult <- if shouldHaddock then Exception.handle (\_ -> return DocsFailed) $ do setup Cabal.haddockCommand haddockFlags return DocsOk @@ -402,6 +404,8 @@ installUnpackedPackage verbosity scriptOptions miscOptions configFlags Cabal.buildDistPref = Cabal.configDistPref configFlags, Cabal.buildVerbosity = Cabal.toFlag verbosity } + shouldHaddock = Cabal.fromFlagOrDefault False + (installDocumentation installConfigFlags) haddockFlags _ = Cabal.emptyHaddockFlags { Cabal.haddockDistPref = Cabal.configDistPref configFlags, Cabal.haddockVerbosity = Cabal.toFlag verbosity diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index 2b0e0ec..2ddecba 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -30,12 +30,13 @@ import Distribution.Client.Types import Distribution.Simple.Program ( defaultProgramConfiguration ) -import Distribution.Simple.Command +import Distribution.Simple.Command hiding (boolOpt) +import qualified Distribution.Simple.Command as Command import qualified Distribution.Simple.Setup as Cabal ( GlobalFlags(..), globalCommand , ConfigFlags(..), configureCommand ) import Distribution.Simple.Setup - ( Flag(..), toFlag, flagToList, trueArg, optionVerbosity ) + ( Flag(..), toFlag, flagToList, flagToMaybe, trueArg, optionVerbosity ) import Distribution.Version ( Version(Version), VersionRange(..) ) import Distribution.Package @@ -197,6 +198,7 @@ instance Monoid ListFlags where -- | Install takes the same flags as configure along with a few extras. -- data InstallFlags = InstallFlags { + installDocumentation:: Flag Bool, installDryRun :: Flag Bool, installOnly :: Flag Bool, installRootCmd :: Flag String, @@ -207,6 +209,7 @@ data InstallFlags = InstallFlags { defaultInstallFlags :: InstallFlags defaultInstallFlags = InstallFlags { + installDocumentation= Flag False, installDryRun = Flag False, installOnly = Flag False, installRootCmd = mempty, @@ -224,7 +227,12 @@ installCommand = configureCommand { commandOptions = \showOrParseArgs -> liftOptionsFst (commandOptions configureCommand showOrParseArgs) ++ liftOptionsSnd - ([ option [] ["dry-run"] + ([ option "" ["documentation"] + "building of documentation" + installDocumentation (\v flags -> flags { installDocumentation = v }) + (boolOpt [] []) + + , option [] ["dry-run"] "Do not install anything, only print what would be installed." installDryRun (\v flags -> flags { installDryRun = v }) trueArg @@ -260,6 +268,7 @@ installCommand = configureCommand { instance Monoid InstallFlags where mempty = defaultInstallFlags mappend a b = InstallFlags { + installDocumentation= combine installDocumentation, installDryRun = combine installDryRun, installOnly = combine installOnly, installRootCmd = combine installRootCmd, @@ -339,6 +348,9 @@ instance Monoid UploadFlags where -- * GetOpt Utils -- ------------------------------------------------------------ +boolOpt :: SFlags -> SFlags -> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a +boolOpt = Command.boolOpt flagToMaybe Flag + liftOptionsFst :: [OptionField a] -> [OptionField (a,b)] liftOptionsFst = map (liftOption fst (\a (_,b) -> (a,b))) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
