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