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

   1 {-# LANGUAGE RecordWildCards #-}
   2
   3 -- | cabal-install CLI command: haddock
   4 module Distribution.Client.CmdHaddock
   5   ( -- * The @haddock@ CLI and action
   6     haddockCommand
   7   , haddockAction
   8   , ClientHaddockFlags (..)
   9
  10     -- * Internals exposed for testing
  11   , selectPackageTargets
  12   , selectComponentTarget
  13   ) where
  14
  15 import Distribution.Client.Compat.Prelude
  16 import System.Directory (makeAbsolute)
  17 import Prelude ()
  18
  19 import Distribution.Client.CmdErrorMessages
  20 import Distribution.Client.NixStyleOptions
  21   ( NixStyleFlags (..)
  22   , defaultNixStyleFlags
  23   , nixStyleOptions
  24   )
  25 import Distribution.Client.ProjectConfig.Types
  26   ( PackageConfig (..)
  27   , ProjectConfig (..)
  28   )
  29 import Distribution.Client.ProjectOrchestration
  30 import Distribution.Client.ProjectPlanning
  31   ( ElaboratedSharedConfig (..)
  32   )
  33 import Distribution.Client.Setup
  34   ( ConfigFlags (..)
  35   , GlobalFlags
  36   , InstallFlags (..)
  37   )
  38 import Distribution.Client.TargetProblem
  39   ( TargetProblem (..)
  40   , TargetProblem'
  41   )
  42 import Distribution.Simple.Command
  43   ( CommandUI (..)
  44   , OptionField
  45   , ShowOrParseArgs
  46   , option
  47   , usageAlternatives
  48   )
  49 import Distribution.Simple.Flag (Flag (..))
  50 import Distribution.Simple.Program.Builtin
  51   ( haddockProgram
  52   )
  53 import Distribution.Simple.Program.Db
  54   ( addKnownProgram
  55   , reconfigurePrograms
  56   )
  57 import Distribution.Simple.Setup
  58   ( HaddockFlags (..)
  59   , fromFlagOrDefault
  60   , trueArg
  61   )
  62 import Distribution.Simple.Utils
  63   ( dieWithException
  64   , notice
  65   , wrapText
  66   )
  67 import Distribution.Verbosity
  68   ( normal
  69   )
  70
  71 import Distribution.Client.Errors
  72 import qualified System.Exit (exitSuccess)
  73
  74 newtype ClientHaddockFlags = ClientHaddockFlags {openInBrowser :: Flag Bool}
  75
  76 haddockCommand :: CommandUI (NixStyleFlags ClientHaddockFlags)
  77 haddockCommand =
  78   CommandUI
  79     { commandName = "v2-haddock"
  80     , commandSynopsis = "Build Haddock documentation."
  81     , commandUsage = usageAlternatives "v2-haddock" ["[FLAGS] TARGET"]
  82     , commandDescription = Just $ \_ ->
  83         wrapText $
  84           "Build Haddock documentation for the specified packages within the "
  85             ++ "project.\n\n"
  86             ++ "Any package in the project can be specified. If no package is "
  87             ++ "specified, the default is to build the documentation for the package "
  88             ++ "in the current directory. The default behaviour is to build "
  89             ++ "documentation for the exposed modules of the library component (if "
  90             ++ "any). This can be changed with the '--internal', '--executables', "
  91             ++ "'--tests', '--benchmarks' or '--all' flags.\n\n"
  92             ++ "Currently, documentation for dependencies is NOT built. This "
  93             ++ "behavior may change in future.\n\n"
  94             ++ "Additional configuration flags can be specified on the command line "
  95             ++ "and these extend the project configuration from the 'cabal.project', "
  96             ++ "'cabal.project.local' and other files."
  97     , commandNotes = Just $ \pname ->
  98         "Examples:\n"
  99           ++ "  "
 100           ++ pname
 101           ++ " v2-haddock pkgname"
 102           ++ "    Build documentation for the package named pkgname\n"
 103     , commandOptions = nixStyleOptions haddockOptions
 104     , commandDefaultFlags = defaultNixStyleFlags (ClientHaddockFlags (Flag False))
 105     }
 106
 107 -- TODO: [nice to have] support haddock on specific components, not just
 108 -- whole packages and the silly --executables etc modifiers.
 109
 110 haddockOptions :: ShowOrParseArgs -> [OptionField ClientHaddockFlags]
 111 haddockOptions _ =
 112   [ option
 113       []
 114       ["open"]
 115       "Open generated documentation in the browser"
 116       openInBrowser
 117       (\v f -> f{openInBrowser = v})
 118       trueArg
 119   ]
 120
 121 mkConfigAbsolute :: ProjectConfig -> IO ProjectConfig
 122 mkConfigAbsolute relConfig = do
 123   let relPackageConfig = projectConfigLocalPackages relConfig
 124   absHaddockOutputDir <- traverse makeAbsolute (packageConfigHaddockOutputDir relPackageConfig)
 125   return
 126     ( relConfig
 127         { projectConfigLocalPackages =
 128             relPackageConfig
 129               { packageConfigHaddockOutputDir = absHaddockOutputDir
 130               }
 131         }
 132     )
 133
 134 mkFlagsAbsolute :: NixStyleFlags ClientHaddockFlags -> IO (NixStyleFlags ClientHaddockFlags)
 135 mkFlagsAbsolute relFlags = do
 136   let relHaddockFlags = haddockFlags relFlags
 137   absHaddockOutputDir <- traverse makeAbsolute (haddockOutputDir relHaddockFlags)
 138   return (relFlags{haddockFlags = relHaddockFlags{haddockOutputDir = absHaddockOutputDir}})
 139
 140 -- | The @haddock@ command is TODO.
 141 --
 142 -- For more details on how this works, see the module
 143 -- "Distribution.Client.ProjectOrchestration"
 144 haddockAction :: NixStyleFlags ClientHaddockFlags -> [String] -> GlobalFlags -> IO ()
 145 haddockAction relFlags targetStrings globalFlags = do
 146   -- It's important to make --haddock-output-dir absolute since we change the working directory later.
 147   flags@NixStyleFlags{..} <- mkFlagsAbsolute relFlags
 148
 149   let
 150     verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
 151     installDoc = fromFlagOrDefault True (installDocumentation installFlags)
 152     flags' = flags{installFlags = installFlags{installDocumentation = Flag installDoc}}
 153     cliConfig = commandLineFlagsToProjectConfig globalFlags flags' mempty -- ClientInstallFlags, not needed here
 154   projCtx <- establishProjectBaseContext verbosity cliConfig HaddockCommand
 155
 156   let relBaseCtx@ProjectBaseContext{projectConfig = relProjectConfig}
 157         | fromFlagOrDefault False (openInBrowser extraFlags) =
 158             projCtx{buildSettings = (buildSettings projCtx){buildSettingHaddockOpen = True}}
 159         | otherwise =
 160             projCtx
 161   absProjectConfig <- mkConfigAbsolute relProjectConfig
 162   let baseCtx = relBaseCtx{projectConfig = absProjectConfig}
 163
 164   targetSelectors <-
 165     either (reportTargetSelectorProblems verbosity) return
 166       =<< readTargetSelectors (localPackages baseCtx) Nothing targetStrings
 167
 168   buildCtx <-
 169     runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do
 170       when (buildSettingOnlyDeps (buildSettings baseCtx)) $
 171         dieWithException verbosity HaddockCommandDoesn'tSupport
 172
 173       -- When we interpret the targets on the command line, interpret them as
 174       -- haddock targets
 175       targets <-
 176         either (reportBuildDocumentationTargetProblems verbosity) return $
 177           resolveTargets
 178             (selectPackageTargets haddockFlags)
 179             selectComponentTarget
 180             elaboratedPlan
 181             Nothing
 182             targetSelectors
 183
 184       let elaboratedPlan' =
 185             pruneInstallPlanToTargets
 186               TargetActionHaddock
 187               targets
 188               elaboratedPlan
 189       return (elaboratedPlan', targets)
 190
 191   printPlan verbosity baseCtx buildCtx
 192
 193   progs <-
 194     reconfigurePrograms
 195       verbosity
 196       (haddockProgramPaths haddockFlags)
 197       (haddockProgramArgs haddockFlags)
 198       -- we need to insert 'haddockProgram' before we reconfigure it,
 199       -- otherwise 'set
 200       . addKnownProgram haddockProgram
 201       . pkgConfigCompilerProgs
 202       . elaboratedShared
 203       $ buildCtx
 204   let buildCtx' =
 205         buildCtx
 206           { elaboratedShared =
 207               (elaboratedShared buildCtx)
 208                 { pkgConfigCompilerProgs = progs
 209                 }
 210           }
 211
 212   buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx'
 213   runProjectPostBuildPhase verbosity baseCtx buildCtx' buildOutcomes
 214
 215 -- | This defines what a 'TargetSelector' means for the @haddock@ command.
 216 -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to,
 217 -- or otherwise classifies the problem.
 218 --
 219 -- For the @haddock@ command we select all buildable libraries. Additionally,
 220 -- depending on the @--executables@ flag we also select all the buildable exes.
 221 -- We do similarly for test-suites, benchmarks and foreign libs.
 222 selectPackageTargets
 223   :: HaddockFlags
 224   -> TargetSelector
 225   -> [AvailableTarget k]
 226   -> Either TargetProblem' [k]
 227 selectPackageTargets haddockFlags targetSelector targets
 228   -- If there are any buildable targets then we select those
 229   | not (null targetsBuildable) =
 230       Right targetsBuildable
 231   -- If there are targets but none are buildable then we report those
 232   | not (null targets) =
 233       Left (TargetProblemNoneEnabled targetSelector targets')
 234   -- If there are no targets at all then we report that
 235   | otherwise =
 236       Left (TargetProblemNoTargets targetSelector)
 237   where
 238     targets' = forgetTargetsDetail (map disableNotRequested targets)
 239     targetsBuildable = selectBuildableTargets (map disableNotRequested targets)
 240
 241     -- When there's a target filter like "pkg:exes" then we do select exes,
 242     -- but if it's just a target like "pkg" then we don't build docs for exes
 243     -- unless they are requested by default (i.e. by using --executables)
 244     disableNotRequested t@(AvailableTarget _ cname (TargetBuildable _ _) _)
 245       | not (isRequested targetSelector (componentKind cname)) =
 246           t{availableTargetStatus = TargetDisabledByUser}
 247     disableNotRequested t = t
 248
 249     isRequested (TargetPackage _ _ (Just _)) _ = True
 250     isRequested (TargetAllPackages (Just _)) _ = True
 251     isRequested _ LibKind = True
 252     --  isRequested _ SubLibKind = True --TODO: what about sublibs?
 253
 254     -- TODO/HACK, we encode some defaults here as v2-haddock's logic;
 255     -- make sure this matches the defaults applied in
 256     -- "Distribution.Client.ProjectPlanning"; this may need more work
 257     -- to be done properly
 258     --
 259     -- See also https://github.com/haskell/cabal/pull/4886
 260     isRequested _ FLibKind = fromFlagOrDefault False (haddockForeignLibs haddockFlags)
 261     isRequested _ ExeKind = fromFlagOrDefault False (haddockExecutables haddockFlags)
 262     isRequested _ TestKind = fromFlagOrDefault False (haddockTestSuites haddockFlags)
 263     isRequested _ BenchKind = fromFlagOrDefault False (haddockBenchmarks haddockFlags)
 264
 265 -- | For a 'TargetComponent' 'TargetSelector', check if the component can be
 266 -- selected.
 267 --
 268 -- For the @haddock@ command we just need the basic checks on being buildable
 269 -- etc.
 270 selectComponentTarget
 271   :: SubComponentTarget
 272   -> AvailableTarget k
 273   -> Either TargetProblem' k
 274 selectComponentTarget = selectComponentTargetBasic
 275
 276 reportBuildDocumentationTargetProblems :: Verbosity -> [TargetProblem'] -> IO a
 277 reportBuildDocumentationTargetProblems verbosity problems =
 278   case problems of
 279     [TargetProblemNoneEnabled _ _] -> do
 280       notice verbosity $
 281         unwords
 282           [ "No documentation was generated as this package does not contain a library."
 283           , "Perhaps you want to use the --haddock-all flag, or one or more of the"
 284           , "--haddock-executables, --haddock-tests, --haddock-benchmarks or"
 285           , "--haddock-internal flags."
 286           ]
 287       System.Exit.exitSuccess
 288     _ -> reportTargetProblems verbosity "build documentation for" problems