Merge pull request #8162 from coot/coot/haddocks

Haddocks command

Cabal/src/Distribution/Simple/Setup.hs

@@ -43,6 +43,8 @@ module Distribution.Simple.Setup (
   InstallFlags(..),  emptyInstallFlags,  defaultInstallFlags,  installCommand,
   HaddockTarget(..),
   HaddockFlags(..),  emptyHaddockFlags,  defaultHaddockFlags,  haddockCommand,
+  Visibility(..),
+  HaddockProjectFlags(..), emptyHaddockProjectFlags, defaultHaddockProjectFlags, haddockProjectCommand,
   HscolourFlags(..), emptyHscolourFlags, defaultHscolourFlags, hscolourCommand,
   BuildFlags(..),    emptyBuildFlags,    defaultBuildFlags,    buildCommand,
   DumpBuildInfo(..),
@@ -58,7 +60,7 @@ module Distribution.Simple.Setup (
   defaultBenchmarkFlags, benchmarkCommand,
   CopyDest(..),
   configureArgs, configureOptions, configureCCompiler, configureLinker,
-  buildOptions, haddockOptions, installDirsOptions,
+  buildOptions, haddockOptions, haddockProjectOptions, installDirsOptions,
   testOptions', benchmarkOptions',
   programDbOptions, programDbPaths',
   programFlagsDescription,
@@ -1376,10 +1378,13 @@ data HaddockFlags = HaddockFlags {
     haddockQuickJump    :: Flag Bool,
     haddockHscolourCss  :: Flag FilePath,
     haddockContents     :: Flag PathTemplate,
+    haddockIndex        :: Flag PathTemplate,
     haddockDistPref     :: Flag FilePath,
     haddockKeepTempFiles:: Flag Bool,
     haddockVerbosity    :: Flag Verbosity,
     haddockCabalFilePath :: Flag FilePath,
+    haddockBaseUrl      :: Flag String,
+    haddockLib          :: Flag String,
     haddockArgs         :: [String]
   }
   deriving (Show, Generic, Typeable)
@@ -1406,6 +1411,9 @@ defaultHaddockFlags  = HaddockFlags {
     haddockKeepTempFiles= Flag False,
     haddockVerbosity    = Flag normal,
     haddockCabalFilePath = mempty,
+    haddockIndex        = NoFlag,
+    haddockBaseUrl      = NoFlag,
+    haddockLib          = NoFlag,
     haddockArgs         = mempty
   }
 
@@ -1533,6 +1541,23 @@ haddockOptions showOrParseArgs =
    (reqArg' "URL"
     (toFlag . toPathTemplate)
     (flagToList . fmap fromPathTemplate))
+
+  ,option "" ["index-location"]
+   "Use a separately-generated HTML index"
+   haddockIndex (\v flags -> flags { haddockIndex = v})
+   (reqArg' "URL"
+    (toFlag . toPathTemplate)
+    (flagToList . fmap fromPathTemplate))
+
+  ,option "" ["base-url"]
+   "Base URL for static files."
+   haddockBaseUrl (\v flags -> flags { haddockBaseUrl = v})
+   (reqArgFlag "URL")
+
+  ,option "" ["lib"]
+   "location of Haddocks static / auxiliary files"
+   haddockLib (\v flags -> flags { haddockLib = v})
+   (reqArgFlag "DIR")
   ]
 
 emptyHaddockFlags :: HaddockFlags
@@ -1545,6 +1570,245 @@ instance Monoid HaddockFlags where
 instance Semigroup HaddockFlags where
   (<>) = gmappend
 
+-- ------------------------------------------------------------
+-- * HaddocksFlags flags
+-- ------------------------------------------------------------
+
+-- | Governs whether modules from a given interface should be visible or
+-- hidden in the Haddock generated content page.  We don't expose this
+-- functionality to the user, but simply use 'Visible' for only local packages.
+-- Visibility of modules is available since @haddock-2.26.1@.
+--
+data Visibility = Visible | Hidden
+  deriving (Eq, Show)
+
+data HaddockProjectFlags = HaddockProjectFlags {
+    haddockProjectHackage      :: Flag Bool,
+    -- ^ a shortcut option which builds documentation linked to hackage.  It implies:
+    -- * `--html-location='https://hackage.haskell.org/package/$prg-$version/docs'
+    -- * `--quickjump`
+    -- * `--gen-index`
+    -- * `--gen-contents`
+    -- * `--hyperlinked-source`
+    haddockProjectLocal        :: Flag Bool,
+    -- ^ a shortcut option which builds self contained directory which contains
+    -- all the documentation, it implies:
+    -- * `--quickjump`
+    -- * `--gen-index`
+    -- * `--gen-contents`
+    -- * `--hyperlinked-source`
+    --
+    -- And it will also pass `--base-url` option to `haddock`.
+
+    -- options passed to @haddock@ via 'createHaddockIndex'
+    haddockProjectDir          :: Flag String,
+    -- ^ output directory of combined haddocks, the default is './haddocks'
+    haddockProjectPrologue     :: Flag String,
+    haddockProjectGenIndex     :: Flag Bool,
+    haddockProjectGenContents  :: Flag Bool,
+    haddockProjectInterfaces   :: Flag [(FilePath, Maybe FilePath, Maybe FilePath, Visibility)],
+    -- ^ 'haddocksInterfaces' is inferred by the 'haddocksAction'; currently not
+    -- exposed to the user.
+
+    -- options passed to @haddock@ via 'HaddockFlags' when building
+    -- documentation
+
+    haddockProjectProgramPaths :: [(String, FilePath)],
+    haddockProjectProgramArgs  :: [(String, [String])],
+    haddockProjectHoogle       :: Flag Bool,
+    -- haddockHtml is not supported
+    haddockProjectHtmlLocation :: Flag String,
+    -- haddockForHackage is not supported
+    haddockProjectExecutables  :: Flag Bool,
+    haddockProjectTestSuites   :: Flag Bool,
+    haddockProjectBenchmarks   :: Flag Bool,
+    haddockProjectForeignLibs  :: Flag Bool,
+    haddockProjectInternal     :: Flag Bool,
+    haddockProjectCss          :: Flag FilePath,
+    haddockProjectLinkedSource :: Flag Bool,
+    haddockProjectQuickJump    :: Flag Bool,
+    haddockProjectHscolourCss  :: Flag FilePath,
+    -- haddockContent is not supported, a fixed value is provided
+    -- haddockIndex is not supported, a fixed value is provided
+    -- haddockDistPerf is not supported, note: it changes location of the haddocks
+    haddockProjectKeepTempFiles:: Flag Bool,
+    haddockProjectVerbosity    :: Flag Verbosity,
+    -- haddockBaseUrl is not supported, a fixed value is provided
+    haddockProjectLib          :: Flag String
+  }
+  deriving (Show, Generic, Typeable)
+
+defaultHaddockProjectFlags :: HaddockProjectFlags
+defaultHaddockProjectFlags = HaddockProjectFlags {
+    haddockProjectHackage      = Flag False,
+    haddockProjectLocal        = Flag False,
+    haddockProjectDir          = Flag "./haddocks",
+    haddockProjectPrologue     = NoFlag,
+    haddockProjectGenIndex     = Flag False,
+    haddockProjectGenContents  = Flag False,
+    haddockProjectTestSuites   = Flag False,
+    haddockProjectProgramPaths = mempty,
+    haddockProjectProgramArgs  = mempty,
+    haddockProjectHoogle       = Flag False,
+    haddockProjectHtmlLocation = NoFlag,
+    haddockProjectExecutables  = Flag False,
+    haddockProjectBenchmarks   = Flag False,
+    haddockProjectForeignLibs  = Flag False,
+    haddockProjectInternal     = Flag False,
+    haddockProjectCss          = NoFlag,
+    haddockProjectLinkedSource = Flag False,
+    haddockProjectQuickJump    = Flag False,
+    haddockProjectHscolourCss  = NoFlag,
+    haddockProjectKeepTempFiles= Flag False,
+    haddockProjectVerbosity    = Flag normal,
+    haddockProjectLib          = NoFlag,
+    haddockProjectInterfaces   = NoFlag
+  }
+
+haddockProjectCommand :: CommandUI HaddockProjectFlags
+haddockProjectCommand = CommandUI
+  { commandName        = "v2-haddock-project"
+  , commandSynopsis    = "Generate Haddocks HTML documentation for the cabal project."
+  , commandDescription = Just $ \_ ->
+      "Require the programm haddock, version 2.26.\n"
+  , commandNotes       = Nothing
+  , commandUsage       = usageAlternatives "haddocks" $
+      [ "[FLAGS]"
+      , "COMPONENTS [FLAGS]"
+      ]
+  , commandDefaultFlags = defaultHaddockProjectFlags
+  , commandOptions      = \showOrParseArgs ->
+         haddockProjectOptions showOrParseArgs
+      ++ programDbPaths   progDb ParseArgs
+             haddockProjectProgramPaths (\v flags -> flags { haddockProjectProgramPaths = v})
+      ++ programDbOption  progDb showOrParseArgs
+             haddockProjectProgramArgs (\v fs -> fs { haddockProjectProgramArgs = v })
+      ++ programDbOptions progDb ParseArgs
+             haddockProjectProgramArgs  (\v flags -> flags { haddockProjectProgramArgs = v})
+  }
+  where
+    progDb = addKnownProgram haddockProgram
+             $ addKnownProgram ghcProgram
+             $ emptyProgramDb
+
+haddockProjectOptions :: ShowOrParseArgs -> [OptionField HaddockProjectFlags]
+haddockProjectOptions _showOrParseArgs =
+    [option "" ["hackage"]
+     (concat ["A short-cut option to build documentation linked to hackage; "
+             ,"it implies --quickjump, --gen-index, --gen-contents, "
+             ,"--hyperlinked-source and --html-location"
+             ])
+     haddockProjectHackage (\v flags -> flags { haddockProjectHackage = v })
+     trueArg
+
+    ,option "" ["local"]
+     (concat ["A short-cut option to build self contained documentation; "
+             ,"it implies  --quickjump, --gen-index, --gen-contents "
+             ,"and --hyperlinked-source."
+             ])
+     haddockProjectLocal (\v flags -> flags { haddockProjectLocal = v })
+     trueArg
+
+    ,option "" ["output"]
+      "Output directory"
+      haddockProjectDir (\v flags -> flags { haddockProjectDir = v })
+      (optArg' "DIRECTORY" maybeToFlag (fmap Just . flagToList))
+
+    ,option "" ["prologue"]
+     "File path to a prologue file in haddock format"
+     haddockProjectPrologue (\v flags -> flags { haddockProjectPrologue = v})
+     (optArg' "PATH" maybeToFlag (fmap Just . flagToList))
+
+    ,option "" ["gen-index"]
+     "Generate index"
+     haddockProjectGenIndex (\v flags -> flags { haddockProjectGenIndex = v})
+     trueArg
+
+    ,option "" ["gen-contents"]
+     "Generate contents"
+     haddockProjectGenContents (\v flags -> flags { haddockProjectGenContents = v})
+     trueArg
+
+    ,option "" ["hoogle"]
+     "Generate a hoogle database"
+     haddockProjectHoogle (\v flags -> flags { haddockProjectHoogle = v })
+     trueArg
+
+    ,option "" ["html-location"]
+     "Location of HTML documentation for pre-requisite packages"
+     haddockProjectHtmlLocation (\v flags -> flags { haddockProjectHtmlLocation = v })
+     (reqArgFlag "URL")
+
+    ,option "" ["executables"]
+     "Run haddock for Executables targets"
+     haddockProjectExecutables (\v flags -> flags { haddockProjectExecutables = v })
+     trueArg
+
+    ,option "" ["tests"]
+     "Run haddock for Test Suite targets"
+     haddockProjectTestSuites (\v flags -> flags { haddockProjectTestSuites = v })
+     trueArg
+
+    ,option "" ["benchmarks"]
+     "Run haddock for Benchmark targets"
+     haddockProjectBenchmarks (\v flags -> flags { haddockProjectBenchmarks = v })
+     trueArg
+
+    ,option "" ["foreign-libraries"]
+     "Run haddock for Foreign Library targets"
+     haddockProjectForeignLibs (\v flags -> flags { haddockProjectForeignLibs = v })
+     trueArg
+
+    ,option "" ["internal"]
+     "Run haddock for internal modules and include all symbols"
+     haddockProjectInternal (\v flags -> flags { haddockProjectInternal = v })
+     trueArg
+
+    ,option "" ["css"]
+     "Use PATH as the haddock stylesheet"
+     haddockProjectCss (\v flags -> flags { haddockProjectCss = v })
+     (reqArgFlag "PATH")
+
+    ,option "" ["hyperlink-source","hyperlink-sources","hyperlinked-source"]
+     "Hyperlink the documentation to the source code"
+     haddockProjectLinkedSource (\v flags -> flags { haddockProjectLinkedSource = v })
+     trueArg
+
+    ,option "" ["quickjump"]
+     "Generate an index for interactive documentation navigation"
+     haddockProjectQuickJump (\v flags -> flags { haddockProjectQuickJump = v })
+     trueArg
+
+    ,option "" ["hscolour-css"]
+     "Use PATH as the HsColour stylesheet"
+     haddockProjectHscolourCss (\v flags -> flags { haddockProjectHscolourCss = v })
+     (reqArgFlag "PATH")
+
+    ,option "" ["keep-temp-files"]
+     "Keep temporary files"
+     haddockProjectKeepTempFiles (\b flags -> flags { haddockProjectKeepTempFiles = b })
+     trueArg
+
+    ,optionVerbosity haddockProjectVerbosity
+     (\v flags -> flags { haddockProjectVerbosity = v })
+
+    ,option "" ["lib"]
+     "location of Haddocks static / auxiliary files"
+     haddockProjectLib (\v flags -> flags { haddockProjectLib = v})
+     (reqArgFlag "DIR")
+    ]
+
+
+emptyHaddockProjectFlags :: HaddockProjectFlags
+emptyHaddockProjectFlags = mempty
+
+instance Monoid HaddockProjectFlags where
+  mempty = gmempty
+  mappend = (<>)
+
+instance Semigroup HaddockProjectFlags where
+  (<>) = gmappend
+
 -- ------------------------------------------------------------
 -- * Clean flags
 -- ------------------------------------------------------------

cabal-install/cabal-install.cabal

@@ -83,6 +83,7 @@ library
         Distribution.Client.CmdExec
         Distribution.Client.CmdFreeze
         Distribution.Client.CmdHaddock
+        Distribution.Client.CmdHaddockProject
         Distribution.Client.CmdInstall
         Distribution.Client.CmdInstall.ClientInstallFlags
         Distribution.Client.CmdInstall.ClientInstallTargetSelector

cabal-install/main/Main.hs

@@ -78,6 +78,7 @@ import qualified Distribution.Client.CmdBuild     as CmdBuild
 import qualified Distribution.Client.CmdRepl      as CmdRepl
 import qualified Distribution.Client.CmdFreeze    as CmdFreeze
 import qualified Distribution.Client.CmdHaddock   as CmdHaddock
+import qualified Distribution.Client.CmdHaddockProject as CmdHaddockProject
 import qualified Distribution.Client.CmdInstall   as CmdInstall
 import qualified Distribution.Client.CmdRun       as CmdRun
 import qualified Distribution.Client.CmdTest      as CmdTest
@@ -257,6 +258,8 @@ mainWorker args = do
       , newCmd  CmdRepl.replCommand           CmdRepl.replAction
       , newCmd  CmdFreeze.freezeCommand       CmdFreeze.freezeAction
       , newCmd  CmdHaddock.haddockCommand     CmdHaddock.haddockAction
+      , newCmd  CmdHaddockProject.haddockProjectCommand
+                                              CmdHaddockProject.haddockProjectAction
       , newCmd  CmdInstall.installCommand     CmdInstall.installAction
       , newCmd  CmdRun.runCommand             CmdRun.runAction
       , newCmd  CmdTest.testCommand           CmdTest.testAction

cabal-install/src/Distribution/Client/CmdHaddock.hs

@@ -16,6 +16,8 @@ import Distribution.Client.Compat.Prelude
 import Prelude ()
 
 import Distribution.Client.ProjectOrchestration
+import Distribution.Client.ProjectPlanning
+         ( ElaboratedSharedConfig(..) )
 import Distribution.Client.CmdErrorMessages
 import Distribution.Client.TargetProblem
          ( TargetProblem (..), TargetProblem' )
@@ -27,6 +29,10 @@ import Distribution.Simple.Setup
          ( HaddockFlags(..), fromFlagOrDefault, trueArg )
 import Distribution.Simple.Command
          ( CommandUI(..), usageAlternatives, ShowOrParseArgs, OptionField, option )
+import Distribution.Simple.Program.Builtin
+         ( haddockProgram )
+import Distribution.Simple.Program.Db
+         ( addKnownProgram, reconfigurePrograms )
 import Distribution.Verbosity
          ( normal )
 import Distribution.Simple.Utils
@@ -118,8 +124,21 @@ haddockAction flags@NixStyleFlags {..} targetStrings globalFlags = do
 
     printPlan verbosity baseCtx buildCtx
 
-    buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx
-    runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes
+    progs <- reconfigurePrograms verbosity
+               (haddockProgramPaths haddockFlags)
+               (haddockProgramArgs haddockFlags)
+             -- we need to insert 'haddockProgram' before we reconfigure it,
+             -- otherwise 'set
+           . addKnownProgram haddockProgram
+           . pkgConfigCompilerProgs
+           . elaboratedShared
+           $ buildCtx
+    let buildCtx' = buildCtx { elaboratedShared =
+                               (elaboratedShared buildCtx)
+                               { pkgConfigCompilerProgs = progs } }
+
+    buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx'
+    runProjectPostBuildPhase verbosity baseCtx buildCtx' buildOutcomes
   where
     verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
     cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty -- ClientInstallFlags, not needed here