Cabal/src/Distribution/Simple/Haddock.hs

   1 {-# LANGUAGE DeriveGeneric #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE NamedFieldPuns #-}
   4 {-# LANGUAGE RankNTypes #-}
   5
   6 -----------------------------------------------------------------------------
   7
   8 -- |
   9 -- Module      :  Distribution.Simple.Haddock
  10 -- Copyright   :  Isaac Jones 2003-2005
  11 -- License     :  BSD3
  12 --
  13 -- Maintainer  :  cabal-devel@haskell.org
  14 -- Portability :  portable
  15 --
  16 -- This module deals with the @haddock@ and @hscolour@ commands.
  17 -- It uses information about installed packages (from @ghc-pkg@) to find the
  18 -- locations of documentation for dependent packages, so it can create links.
  19 --
  20 -- The @hscolour@ support allows generating HTML versions of the original
  21 -- source, with coloured syntax highlighting.
  22 module Distribution.Simple.Haddock
  23   ( haddock
  24   , createHaddockIndex
  25   , hscolour
  26   , haddockPackagePaths
  27   , Visibility (..)
  28   ) where
  29
  30 import Distribution.Compat.Prelude
  31 import Prelude ()
  32
  33 import qualified Distribution.Simple.GHC as GHC
  34 import qualified Distribution.Simple.GHCJS as GHCJS
  35
  36 -- local
  37
  38 import Distribution.Backpack (OpenModule)
  39 import Distribution.Backpack.DescribeUnitId
  40 import Distribution.InstalledPackageInfo (InstalledPackageInfo)
  41 import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
  42 import qualified Distribution.ModuleName as ModuleName
  43 import Distribution.Package
  44 import Distribution.PackageDescription
  45 import Distribution.Parsec (simpleParsec)
  46 import Distribution.Pretty
  47 import Distribution.Simple.Build
  48 import Distribution.Simple.BuildPaths
  49 import Distribution.Simple.BuildTarget
  50 import Distribution.Simple.Compiler
  51 import Distribution.Simple.Flag
  52 import Distribution.Simple.Glob
  53 import Distribution.Simple.InstallDirs
  54 import Distribution.Simple.LocalBuildInfo hiding (substPathTemplate)
  55 import qualified Distribution.Simple.PackageIndex as PackageIndex
  56 import Distribution.Simple.PreProcess
  57 import Distribution.Simple.Program
  58 import Distribution.Simple.Program.GHC
  59 import qualified Distribution.Simple.Program.HcPkg as HcPkg
  60 import Distribution.Simple.Program.ResponseFile
  61 import Distribution.Simple.Register
  62 import Distribution.Simple.Setup.Haddock
  63 import Distribution.Simple.Setup.Hscolour
  64 import Distribution.Simple.Utils
  65 import Distribution.System
  66 import Distribution.Types.ComponentLocalBuildInfo
  67 import Distribution.Types.ExposedModule
  68 import Distribution.Types.LocalBuildInfo
  69 import Distribution.Types.TargetInfo
  70 import Distribution.Utils.NubList
  71 import qualified Distribution.Utils.ShortText as ShortText
  72 import Distribution.Version
  73
  74 import Distribution.Verbosity
  75 import Language.Haskell.Extension
  76
  77 import Distribution.Compat.Semigroup (All (..), Any (..))
  78
  79 import Control.Monad
  80 import Data.Either (rights)
  81
  82 import Distribution.Simple.Errors
  83 import System.Directory (doesDirectoryExist, doesFileExist, getCurrentDirectory)
  84 import System.FilePath (isAbsolute, normalise, (<.>), (</>))
  85 import System.IO (hClose, hPutStrLn, hSetEncoding, utf8)
  86
  87 -- ------------------------------------------------------------------------------
  88 -- Types
  89
  90 -- | A record that represents the arguments to the haddock executable, a product
  91 -- monoid.
  92 data HaddockArgs = HaddockArgs
  93   { argInterfaceFile :: Flag FilePath
  94   -- ^ Path to the interface file, relative to argOutputDir, required.
  95   , argPackageName :: Flag PackageIdentifier
  96   -- ^ Package name, required.
  97   , argHideModules :: (All, [ModuleName.ModuleName])
  98   -- ^ (Hide modules ?, modules to hide)
  99   , argIgnoreExports :: Any
 100   -- ^ Ignore export lists in modules?
 101   , argLinkSource :: Flag (Template, Template, Template)
 102   -- ^ (Template for modules, template for symbols, template for lines).
 103   , argLinkedSource :: Flag Bool
 104   -- ^ Generate hyperlinked sources
 105   , argQuickJump :: Flag Bool
 106   -- ^ Generate quickjump index
 107   , argCssFile :: Flag FilePath
 108   -- ^ Optional custom CSS file.
 109   , argContents :: Flag String
 110   -- ^ Optional URL to contents page.
 111   , argGenContents :: Flag Bool
 112   -- ^ Generate contents
 113   , argIndex :: Flag String
 114   -- ^ Optional URL to index page.
 115   , argGenIndex :: Flag Bool
 116   -- ^ Generate index
 117   , argBaseUrl :: Flag String
 118   -- ^ Optional base url from which static files will be loaded.
 119   , argVerbose :: Any
 120   , argOutput :: Flag [Output]
 121   -- ^ HTML or Hoogle doc or both? Required.
 122   , argInterfaces :: [(FilePath, Maybe String, Maybe String, Visibility)]
 123   -- ^ [(Interface file, URL to the HTML docs and hyperlinked-source for links)].
 124   , argOutputDir :: Directory
 125   -- ^ Where to generate the documentation.
 126   , argTitle :: Flag String
 127   -- ^ Page title, required.
 128   , argPrologue :: Flag String
 129   -- ^ Prologue text, required for 'haddock', ignored by 'haddocks'.
 130   , argPrologueFile :: Flag FilePath
 131   -- ^ Prologue file name, ignored by 'haddock', optional for 'haddocks'.
 132   , argGhcOptions :: GhcOptions
 133   -- ^ Additional flags to pass to GHC.
 134   , argGhcLibDir :: Flag FilePath
 135   -- ^ To find the correct GHC, required.
 136   , argReexports :: [OpenModule]
 137   -- ^ Re-exported modules
 138   , argTargets :: [FilePath]
 139   -- ^ Modules to process.
 140   , argLib :: Flag String
 141   -- ^ haddock's static \/ auxiliary files.
 142   }
 143   deriving (Generic)
 144
 145 -- | The FilePath of a directory, it's a monoid under '(</>)'.
 146 newtype Directory = Dir {unDir' :: FilePath} deriving (Read, Show, Eq, Ord)
 147
 148 unDir :: Directory -> FilePath
 149 unDir = normalise . unDir'
 150
 151 type Template = String
 152
 153 data Output = Html | Hoogle
 154   deriving (Eq)
 155
 156 -- ------------------------------------------------------------------------------
 157 -- Haddock support
 158
 159 -- | Get Haddock program and check if it matches the request
 160 getHaddockProg
 161   :: Verbosity
 162   -> ProgramDb
 163   -> Compiler
 164   -> HaddockArgs
 165   -> Flag Bool
 166   -- ^ quickjump feature
 167   -> IO (ConfiguredProgram, Version)
 168 getHaddockProg verbosity programDb comp args quickJumpFlag = do
 169   let HaddockArgs
 170         { argQuickJump
 171         , argOutput
 172         } = args
 173       hoogle = Hoogle `elem` fromFlagOrDefault [] argOutput
 174
 175   (haddockProg, version, _) <-
 176     requireProgramVersion
 177       verbosity
 178       haddockProgram
 179       (orLaterVersion (mkVersion [2, 0]))
 180       programDb
 181
 182   -- various sanity checks
 183   when (hoogle && version < mkVersion [2, 2]) $
 184     dieWithException verbosity NoSupportForHoogle
 185
 186   when (fromFlag argQuickJump && version < mkVersion [2, 19]) $ do
 187     let msg = "Haddock prior to 2.19 does not support the --quickjump flag."
 188         alt = "The generated documentation won't have the QuickJump feature."
 189     if Flag True == quickJumpFlag
 190       then dieWithException verbosity NoSupportForQuickJumpFlag
 191       else warn verbosity (msg ++ "\n" ++ alt)
 192
 193   haddockGhcVersionStr <-
 194     getProgramOutput
 195       verbosity
 196       haddockProg
 197       ["--ghc-version"]
 198   case (simpleParsec haddockGhcVersionStr, compilerCompatVersion GHC comp) of
 199     (Nothing, _) -> dieWithException verbosity NoGHCVersionFromHaddock
 200     (_, Nothing) -> dieWithException verbosity NoGHCVersionFromCompiler
 201     (Just haddockGhcVersion, Just ghcVersion)
 202       | haddockGhcVersion == ghcVersion -> return ()
 203       | otherwise -> dieWithException verbosity $ HaddockAndGHCVersionDoesntMatch ghcVersion haddockGhcVersion
 204
 205   return (haddockProg, version)
 206
 207 haddock
 208   :: PackageDescription
 209   -> LocalBuildInfo
 210   -> [PPSuffixHandler]
 211   -> HaddockFlags
 212   -> IO ()
 213 haddock pkg_descr _ _ haddockFlags
 214   | not (hasLibs pkg_descr)
 215       && not (fromFlag $ haddockExecutables haddockFlags)
 216       && not (fromFlag $ haddockTestSuites haddockFlags)
 217       && not (fromFlag $ haddockBenchmarks haddockFlags)
 218       && not (fromFlag $ haddockForeignLibs haddockFlags) =
 219       warn (fromFlag $ haddockVerbosity haddockFlags) $
 220         "No documentation was generated as this package does not contain "
 221           ++ "a library. Perhaps you want to use the --executables, --tests,"
 222           ++ " --benchmarks or --foreign-libraries flags."
 223 haddock pkg_descr lbi suffixes flags' = do
 224   let verbosity = flag haddockVerbosity
 225       comp = compiler lbi
 226       platform = hostPlatform lbi
 227
 228       quickJmpFlag = haddockQuickJump flags'
 229       flags = case haddockTarget of
 230         ForDevelopment -> flags'
 231         ForHackage ->
 232           flags'
 233             { haddockHoogle = Flag True
 234             , haddockHtml = Flag True
 235             , haddockHtmlLocation = Flag (pkg_url ++ "/docs")
 236             , haddockContents = Flag (toPathTemplate pkg_url)
 237             , haddockLinkedSource = Flag True
 238             , haddockQuickJump = Flag True
 239             }
 240       pkg_url = "/package/$pkg-$version"
 241       flag f = fromFlag $ f flags
 242
 243       tmpFileOpts =
 244         defaultTempFileOptions
 245           { optKeepTempFiles = flag haddockKeepTempFiles
 246           }
 247       htmlTemplate =
 248         fmap toPathTemplate . flagToMaybe . haddockHtmlLocation $
 249           flags
 250       haddockTarget =
 251         fromFlagOrDefault ForDevelopment (haddockForHackage flags')
 252
 253   libdirArgs <- getGhcLibDir verbosity lbi
 254   -- The haddock-output-dir flag overrides any other documentation placement concerns.
 255   -- The point is to give the user full freedom over the location if they need it.
 256   let overrideWithOutputDir args = case haddockOutputDir flags of
 257         NoFlag -> args
 258         Flag dir -> args{argOutputDir = Dir dir}
 259   let commonArgs =
 260         overrideWithOutputDir $
 261           mconcat
 262             [ libdirArgs
 263             , fromFlags (haddockTemplateEnv lbi (packageId pkg_descr)) flags
 264             , fromPackageDescription haddockTarget pkg_descr
 265             ]
 266
 267   (haddockProg, version) <-
 268     getHaddockProg verbosity (withPrograms lbi) comp commonArgs quickJmpFlag
 269
 270   -- We fall back to using HsColour only for versions of Haddock which don't
 271   -- support '--hyperlinked-sources'.
 272   when (flag haddockLinkedSource && version < mkVersion [2, 17]) $
 273     hscolour'
 274       (warn verbosity)
 275       haddockTarget
 276       pkg_descr
 277       lbi
 278       suffixes
 279       (defaultHscolourFlags `mappend` haddockToHscolour flags)
 280
 281   targets <- readTargetInfos verbosity pkg_descr lbi (haddockArgs flags)
 282
 283   let
 284     targets' =
 285       case targets of
 286         [] -> allTargetsInBuildOrder' pkg_descr lbi
 287         _ -> targets
 288
 289   internalPackageDB <-
 290     createInternalPackageDB verbosity lbi (flag haddockDistPref)
 291
 292   (\f -> foldM_ f (installedPkgs lbi) targets') $ \index target -> do
 293     let component = targetComponent target
 294         clbi = targetCLBI target
 295
 296     componentInitialBuildSteps (flag haddockDistPref) pkg_descr lbi clbi verbosity
 297
 298     let
 299       lbi' =
 300         lbi
 301           { withPackageDB = withPackageDB lbi ++ [internalPackageDB]
 302           , installedPkgs = index
 303           }
 304
 305     preprocessComponent pkg_descr component lbi' clbi False verbosity suffixes
 306     let
 307       doExe com = case (compToExe com) of
 308         Just exe -> do
 309           withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi') "tmp" $
 310             \tmp -> do
 311               exeArgs <-
 312                 fromExecutable
 313                   verbosity
 314                   tmp
 315                   lbi'
 316                   clbi
 317                   htmlTemplate
 318                   version
 319                   exe
 320               let exeArgs' = commonArgs `mappend` exeArgs
 321               runHaddock
 322                 verbosity
 323                 tmpFileOpts
 324                 comp
 325                 platform
 326                 haddockProg
 327                 True
 328                 exeArgs'
 329         Nothing -> do
 330           warn
 331             (fromFlag $ haddockVerbosity flags)
 332             "Unsupported component, skipping..."
 333           return ()
 334       -- We define 'smsg' once and then reuse it inside the case, so that
 335       -- we don't say we are running Haddock when we actually aren't
 336       -- (e.g., Haddock is not run on non-libraries)
 337       smsg :: IO ()
 338       smsg =
 339         setupMessage'
 340           verbosity
 341           "Running Haddock on"
 342           (packageId pkg_descr)
 343           (componentLocalName clbi)
 344           (maybeComponentInstantiatedWith clbi)
 345     case component of
 346       CLib lib -> do
 347         withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi) "tmp" $
 348           \tmp -> do
 349             smsg
 350             libArgs <-
 351               fromLibrary
 352                 verbosity
 353                 tmp
 354                 lbi'
 355                 clbi
 356                 htmlTemplate
 357                 version
 358                 lib
 359             let libArgs' = commonArgs `mappend` libArgs
 360             runHaddock verbosity tmpFileOpts comp platform haddockProg True libArgs'
 361
 362             pwd <- getCurrentDirectory
 363
 364             let
 365               ipi =
 366                 inplaceInstalledPackageInfo
 367                   pwd
 368                   (flag haddockDistPref)
 369                   pkg_descr
 370                   (mkAbiHash "inplace")
 371                   lib
 372                   lbi'
 373                   clbi
 374
 375             debug verbosity $
 376               "Registering inplace:\n"
 377                 ++ (InstalledPackageInfo.showInstalledPackageInfo ipi)
 378
 379             registerPackage
 380               verbosity
 381               (compiler lbi')
 382               (withPrograms lbi')
 383               (withPackageDB lbi')
 384               ipi
 385               HcPkg.defaultRegisterOptions
 386                 { HcPkg.registerMultiInstance = True
 387                 }
 388
 389             return $ PackageIndex.insert ipi index
 390       CFLib flib ->
 391         when
 392           (flag haddockForeignLibs)
 393           ( do
 394               withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi') "tmp" $
 395                 \tmp -> do
 396                   smsg
 397                   flibArgs <-
 398                     fromForeignLib
 399                       verbosity
 400                       tmp
 401                       lbi'
 402                       clbi
 403                       htmlTemplate
 404                       version
 405                       flib
 406                   let libArgs' = commonArgs `mappend` flibArgs
 407                   runHaddock verbosity tmpFileOpts comp platform haddockProg True libArgs'
 408           )
 409           >> return index
 410       CExe _ -> when (flag haddockExecutables) (smsg >> doExe component) >> return index
 411       CTest _ -> when (flag haddockTestSuites) (smsg >> doExe component) >> return index
 412       CBench _ -> when (flag haddockBenchmarks) (smsg >> doExe component) >> return index
 413
 414   for_ (extraDocFiles pkg_descr) $ \fpath -> do
 415     files <- matchDirFileGlob verbosity (specVersion pkg_descr) "." fpath
 416     for_ files $ copyFileTo verbosity (unDir $ argOutputDir commonArgs)
 417
 418 -- | Execute 'Haddock' configured with 'HaddocksFlags'.  It is used to build
 419 -- index and contents for documentation of multiple packages.
 420 createHaddockIndex
 421   :: Verbosity
 422   -> ProgramDb
 423   -> Compiler
 424   -> Platform
 425   -> HaddockProjectFlags
 426   -> IO ()
 427 createHaddockIndex verbosity programDb comp platform flags = do
 428   let args = fromHaddockProjectFlags flags
 429   (haddockProg, _version) <-
 430     getHaddockProg verbosity programDb comp args (Flag True)
 431   runHaddock verbosity defaultTempFileOptions comp platform haddockProg False args
 432
 433 -- ------------------------------------------------------------------------------
 434 -- Contributions to HaddockArgs (see also Doctest.hs for very similar code).
 435
 436 fromFlags :: PathTemplateEnv -> HaddockFlags -> HaddockArgs
 437 fromFlags env flags =
 438   mempty
 439     { argHideModules =
 440         ( maybe mempty (All . not) $
 441             flagToMaybe (haddockInternal flags)
 442         , mempty
 443         )
 444     , argLinkSource =
 445         if fromFlag (haddockLinkedSource flags)
 446           then
 447             Flag
 448               ( "src/%{MODULE/./-}.html"
 449               , "src/%{MODULE/./-}.html#%{NAME}"
 450               , "src/%{MODULE/./-}.html#line-%{LINE}"
 451               )
 452           else NoFlag
 453     , argLinkedSource = haddockLinkedSource flags
 454     , argQuickJump = haddockQuickJump flags
 455     , argCssFile = haddockCss flags
 456     , argContents =
 457         fmap
 458           (fromPathTemplate . substPathTemplate env)
 459           (haddockContents flags)
 460     , argGenContents = Flag False
 461     , argIndex =
 462         fmap
 463           (fromPathTemplate . substPathTemplate env)
 464           (haddockIndex flags)
 465     , argGenIndex = Flag False
 466     , argBaseUrl = haddockBaseUrl flags
 467     , argLib = haddockLib flags
 468     , argVerbose =
 469         maybe mempty (Any . (>= deafening))
 470           . flagToMaybe
 471           $ haddockVerbosity flags
 472     , argOutput =
 473         Flag $ case [Html | Flag True <- [haddockHtml flags]]
 474           ++ [Hoogle | Flag True <- [haddockHoogle flags]] of
 475           [] -> [Html]
 476           os -> os
 477     , argOutputDir = maybe mempty Dir . flagToMaybe $ haddockDistPref flags
 478     , argGhcOptions = mempty{ghcOptExtra = ghcArgs}
 479     }
 480   where
 481     ghcArgs = fromMaybe [] . lookup "ghc" . haddockProgramArgs $ flags
 482
 483 fromHaddockProjectFlags :: HaddockProjectFlags -> HaddockArgs
 484 fromHaddockProjectFlags flags =
 485   mempty
 486     { argOutputDir = Dir (fromFlag $ haddockProjectDir flags)
 487     , argQuickJump = Flag True
 488     , argGenContents = Flag True
 489     , argGenIndex = Flag True
 490     , argPrologueFile = haddockProjectPrologue flags
 491     , argInterfaces = fromFlagOrDefault [] (haddockProjectInterfaces flags)
 492     , argLinkedSource = Flag True
 493     , argLib = haddockProjectLib flags
 494     }
 495
 496 fromPackageDescription :: HaddockTarget -> PackageDescription -> HaddockArgs
 497 fromPackageDescription haddockTarget pkg_descr =
 498   mempty
 499     { argInterfaceFile = Flag $ haddockName pkg_descr
 500     , argPackageName = Flag $ packageId $ pkg_descr
 501     , argOutputDir =
 502         Dir $
 503           "doc" </> "html" </> haddockDirName haddockTarget pkg_descr
 504     , argPrologue =
 505         Flag $
 506           ShortText.fromShortText $
 507             if ShortText.null desc
 508               then synopsis pkg_descr
 509               else desc
 510     , argTitle = Flag $ showPkg ++ subtitle
 511     }
 512   where
 513     desc = description pkg_descr
 514     showPkg = prettyShow (packageId pkg_descr)
 515     subtitle
 516       | ShortText.null (synopsis pkg_descr) = ""
 517       | otherwise = ": " ++ ShortText.fromShortText (synopsis pkg_descr)
 518
 519 componentGhcOptions
 520   :: Verbosity
 521   -> LocalBuildInfo
 522   -> BuildInfo
 523   -> ComponentLocalBuildInfo
 524   -> FilePath
 525   -> GhcOptions
 526 componentGhcOptions verbosity lbi bi clbi odir =
 527   let f = case compilerFlavor (compiler lbi) of
 528         GHC -> GHC.componentGhcOptions
 529         GHCJS -> GHCJS.componentGhcOptions
 530         _ ->
 531           error $
 532             "Distribution.Simple.Haddock.componentGhcOptions:"
 533               ++ "haddock only supports GHC and GHCJS"
 534    in f verbosity lbi bi clbi odir
 535
 536 mkHaddockArgs
 537   :: Verbosity
 538   -> FilePath
 539   -> LocalBuildInfo
 540   -> ComponentLocalBuildInfo
 541   -> Maybe PathTemplate
 542   -- ^ template for HTML location
 543   -> Version
 544   -> [FilePath]
 545   -> BuildInfo
 546   -> IO HaddockArgs
 547 mkHaddockArgs verbosity tmp lbi clbi htmlTemplate haddockVersion inFiles bi = do
 548   ifaceArgs <- getInterfaces verbosity lbi clbi htmlTemplate
 549   let vanillaOpts =
 550         (componentGhcOptions normal lbi bi clbi (buildDir lbi))
 551           { -- Noooooooooo!!!!!111
 552             -- haddock stomps on our precious .hi
 553             -- and .o files. Workaround by telling
 554             -- haddock to write them elsewhere.
 555             ghcOptObjDir = toFlag tmp
 556           , ghcOptHiDir = toFlag tmp
 557           , ghcOptStubDir = toFlag tmp
 558           }
 559           `mappend` getGhcCppOpts haddockVersion bi
 560       sharedOpts =
 561         vanillaOpts
 562           { ghcOptDynLinkMode = toFlag GhcDynamicOnly
 563           , ghcOptFPic = toFlag True
 564           , ghcOptHiSuffix = toFlag "dyn_hi"
 565           , ghcOptObjSuffix = toFlag "dyn_o"
 566           , ghcOptExtra = hcSharedOptions GHC bi
 567           }
 568   opts <-
 569     if withVanillaLib lbi
 570       then return vanillaOpts
 571       else
 572         if withSharedLib lbi
 573           then return sharedOpts
 574           else dieWithException verbosity MustHaveSharedLibraries
 575
 576   return
 577     ifaceArgs
 578       { argGhcOptions = opts
 579       , argTargets = inFiles
 580       , argReexports = getReexports clbi
 581       }
 582
 583 fromLibrary
 584   :: Verbosity
 585   -> FilePath
 586   -> LocalBuildInfo
 587   -> ComponentLocalBuildInfo
 588   -> Maybe PathTemplate
 589   -- ^ template for HTML location
 590   -> Version
 591   -> Library
 592   -> IO HaddockArgs
 593 fromLibrary verbosity tmp lbi clbi htmlTemplate haddockVersion lib = do
 594   inFiles <- map snd `fmap` getLibSourceFiles verbosity lbi lib clbi
 595   args <-
 596     mkHaddockArgs
 597       verbosity
 598       tmp
 599       lbi
 600       clbi
 601       htmlTemplate
 602       haddockVersion
 603       inFiles
 604       (libBuildInfo lib)
 605   return
 606     args
 607       { argHideModules = (mempty, otherModules (libBuildInfo lib))
 608       }
 609
 610 fromExecutable
 611   :: Verbosity
 612   -> FilePath
 613   -> LocalBuildInfo
 614   -> ComponentLocalBuildInfo
 615   -> Maybe PathTemplate
 616   -- ^ template for HTML location
 617   -> Version
 618   -> Executable
 619   -> IO HaddockArgs
 620 fromExecutable verbosity tmp lbi clbi htmlTemplate haddockVersion exe = do
 621   inFiles <- map snd `fmap` getExeSourceFiles verbosity lbi exe clbi
 622   args <-
 623     mkHaddockArgs
 624       verbosity
 625       tmp
 626       lbi
 627       clbi
 628       htmlTemplate
 629       haddockVersion
 630       inFiles
 631       (buildInfo exe)
 632   return
 633     args
 634       { argOutputDir = Dir $ unUnqualComponentName $ exeName exe
 635       , argTitle = Flag $ unUnqualComponentName $ exeName exe
 636       }
 637
 638 fromForeignLib
 639   :: Verbosity
 640   -> FilePath
 641   -> LocalBuildInfo
 642   -> ComponentLocalBuildInfo
 643   -> Maybe PathTemplate
 644   -- ^ template for HTML location
 645   -> Version
 646   -> ForeignLib
 647   -> IO HaddockArgs
 648 fromForeignLib verbosity tmp lbi clbi htmlTemplate haddockVersion flib = do
 649   inFiles <- map snd `fmap` getFLibSourceFiles verbosity lbi flib clbi
 650   args <-
 651     mkHaddockArgs
 652       verbosity
 653       tmp
 654       lbi
 655       clbi
 656       htmlTemplate
 657       haddockVersion
 658       inFiles
 659       (foreignLibBuildInfo flib)
 660   return
 661     args
 662       { argOutputDir = Dir $ unUnqualComponentName $ foreignLibName flib
 663       , argTitle = Flag $ unUnqualComponentName $ foreignLibName flib
 664       }
 665
 666 compToExe :: Component -> Maybe Executable
 667 compToExe comp =
 668   case comp of
 669     CTest test@TestSuite{testInterface = TestSuiteExeV10 _ f} ->
 670       Just
 671         Executable
 672           { exeName = testName test
 673           , modulePath = f
 674           , exeScope = ExecutablePublic
 675           , buildInfo = testBuildInfo test
 676           }
 677     CBench bench@Benchmark{benchmarkInterface = BenchmarkExeV10 _ f} ->
 678       Just
 679         Executable
 680           { exeName = benchmarkName bench
 681           , modulePath = f
 682           , exeScope = ExecutablePublic
 683           , buildInfo = benchmarkBuildInfo bench
 684           }
 685     CExe exe -> Just exe
 686     _ -> Nothing
 687
 688 getInterfaces
 689   :: Verbosity
 690   -> LocalBuildInfo
 691   -> ComponentLocalBuildInfo
 692   -> Maybe PathTemplate
 693   -- ^ template for HTML location
 694   -> IO HaddockArgs
 695 getInterfaces verbosity lbi clbi htmlTemplate = do
 696   (packageFlags, warnings) <- haddockPackageFlags verbosity lbi clbi htmlTemplate
 697   traverse_ (warn (verboseUnmarkOutput verbosity)) warnings
 698   return $
 699     mempty
 700       { argInterfaces = packageFlags
 701       }
 702
 703 getReexports :: ComponentLocalBuildInfo -> [OpenModule]
 704 getReexports LibComponentLocalBuildInfo{componentExposedModules = mods} =
 705   mapMaybe exposedReexport mods
 706 getReexports _ = []
 707
 708 getGhcCppOpts
 709   :: Version
 710   -> BuildInfo
 711   -> GhcOptions
 712 getGhcCppOpts haddockVersion bi =
 713   mempty
 714     { ghcOptExtensions = toNubListR [EnableExtension CPP | needsCpp]
 715     , ghcOptCppOptions = defines
 716     }
 717   where
 718     needsCpp = EnableExtension CPP `elem` usedExtensions bi
 719     defines = [haddockVersionMacro]
 720     haddockVersionMacro =
 721       "-D__HADDOCK_VERSION__="
 722         ++ show (v1 * 1000 + v2 * 10 + v3)
 723       where
 724         (v1, v2, v3) = case versionNumbers haddockVersion of
 725           [] -> (0, 0, 0)
 726           [x] -> (x, 0, 0)
 727           [x, y] -> (x, y, 0)
 728           (x : y : z : _) -> (x, y, z)
 729
 730 getGhcLibDir
 731   :: Verbosity
 732   -> LocalBuildInfo
 733   -> IO HaddockArgs
 734 getGhcLibDir verbosity lbi = do
 735   l <- case compilerFlavor (compiler lbi) of
 736     GHC -> GHC.getLibDir verbosity lbi
 737     GHCJS -> GHCJS.getLibDir verbosity lbi
 738     _ -> error "haddock only supports GHC and GHCJS"
 739   return $ mempty{argGhcLibDir = Flag l}
 740
 741 -- ------------------------------------------------------------------------------
 742
 743 -- | Call haddock with the specified arguments.
 744 runHaddock
 745   :: Verbosity
 746   -> TempFileOptions
 747   -> Compiler
 748   -> Platform
 749   -> ConfiguredProgram
 750   -> Bool
 751   -- ^ require targets
 752   -> HaddockArgs
 753   -> IO ()
 754 runHaddock verbosity tmpFileOpts comp platform haddockProg requireTargets args
 755   | requireTargets && null (argTargets args) =
 756       warn verbosity $
 757         "Haddocks are being requested, but there aren't any modules given "
 758           ++ "to create documentation for."
 759   | otherwise = do
 760       let haddockVersion =
 761             fromMaybe
 762               (error "unable to determine haddock version")
 763               (programVersion haddockProg)
 764       renderArgs verbosity tmpFileOpts haddockVersion comp platform args $
 765         \(flags, result) -> do
 766           runProgram verbosity haddockProg flags
 767
 768           notice verbosity $ "Documentation created: " ++ result
 769
 770 renderArgs
 771   :: Verbosity
 772   -> TempFileOptions
 773   -> Version
 774   -> Compiler
 775   -> Platform
 776   -> HaddockArgs
 777   -> (([String], FilePath) -> IO a)
 778   -> IO a
 779 renderArgs verbosity tmpFileOpts version comp platform args k = do
 780   let haddockSupportsUTF8 = version >= mkVersion [2, 14, 4]
 781       haddockSupportsResponseFiles = version > mkVersion [2, 16, 2]
 782   createDirectoryIfMissingVerbose verbosity True outputDir
 783   case argPrologue args of
 784     Flag prologueText ->
 785       withTempFileEx tmpFileOpts outputDir "haddock-prologue.txt" $
 786         \prologueFileName h -> do
 787           do
 788             when haddockSupportsUTF8 (hSetEncoding h utf8)
 789             hPutStrLn h prologueText
 790             hClose h
 791             let pflag = "--prologue=" ++ prologueFileName
 792                 renderedArgs = pflag : renderPureArgs version comp platform args
 793             if haddockSupportsResponseFiles
 794               then
 795                 withResponseFile
 796                   verbosity
 797                   tmpFileOpts
 798                   outputDir
 799                   "haddock-response.txt"
 800                   (if haddockSupportsUTF8 then Just utf8 else Nothing)
 801                   renderedArgs
 802                   (\responseFileName -> k (["@" ++ responseFileName], result))
 803               else k (renderedArgs, result)
 804     _ -> do
 805       let renderedArgs =
 806             ( case argPrologueFile args of
 807                 Flag pfile -> ["--prologue=" ++ pfile]
 808                 _ -> []
 809             )
 810               <> renderPureArgs version comp platform args
 811       if haddockSupportsResponseFiles
 812         then
 813           withResponseFile
 814             verbosity
 815             tmpFileOpts
 816             outputDir
 817             "haddock-response.txt"
 818             (if haddockSupportsUTF8 then Just utf8 else Nothing)
 819             renderedArgs
 820             (\responseFileName -> k (["@" ++ responseFileName], result))
 821         else k (renderedArgs, result)
 822   where
 823     outputDir = (unDir $ argOutputDir args)
 824     isNotArgContents = isNothing (flagToMaybe $ argContents args)
 825     isNotArgIndex = isNothing (flagToMaybe $ argIndex args)
 826     isArgGenIndex = fromFlagOrDefault False (argGenIndex args)
 827     -- Haddock, when generating HTML, does not generate an index if the options
 828     -- --use-contents or --use-index are passed to it. See
 829     -- https://haskell-haddock.readthedocs.io/en/latest/invoking.html#cmdoption-use-contents
 830     isIndexGenerated = isArgGenIndex && isNotArgContents && isNotArgIndex
 831     result =
 832       intercalate ", "
 833         . map
 834           ( \o ->
 835               outputDir
 836                 </> case o of
 837                   Html
 838                     | isIndexGenerated ->
 839                         "index.html"
 840                   Html
 841                     | otherwise ->
 842                         mempty
 843                   Hoogle -> pkgstr <.> "txt"
 844           )
 845         . fromFlagOrDefault [Html]
 846         . argOutput
 847         $ args
 848       where
 849         pkgstr = prettyShow $ packageName pkgid
 850         pkgid = arg argPackageName
 851     arg f = fromFlag $ f args
 852
 853 renderPureArgs :: Version -> Compiler -> Platform -> HaddockArgs -> [String]
 854 renderPureArgs version comp platform args =
 855   concat
 856     [ map (\f -> "--dump-interface=" ++ unDir (argOutputDir args) </> f)
 857         . flagToList
 858         . argInterfaceFile
 859         $ args
 860     , if haddockSupportsPackageName
 861         then
 862           maybe
 863             []
 864             ( \pkg ->
 865                 [ "--package-name=" ++ prettyShow (pkgName pkg)
 866                 , "--package-version=" ++ prettyShow (pkgVersion pkg)
 867                 ]
 868             )
 869             . flagToMaybe
 870             . argPackageName
 871             $ args
 872         else []
 873     , ["--since-qual=external" | isVersion 2 20]
 874     , [ "--quickjump" | isVersion 2 19, True <- flagToList . argQuickJump $ args
 875       ]
 876     , ["--hyperlinked-source" | isHyperlinkedSource]
 877     , (\(All b, xs) -> bool (map (("--hide=" ++) . prettyShow) xs) [] b)
 878         . argHideModules
 879         $ args
 880     , bool ["--ignore-all-exports"] [] . getAny . argIgnoreExports $ args
 881     , -- Haddock's --source-* options are ignored once --hyperlinked-source is
 882       -- set.
 883       -- See https://haskell-haddock.readthedocs.io/en/latest/invoking.html#cmdoption-hyperlinked-source
 884       -- To avoid Haddock's warning, we only set --source-* options if
 885       -- --hyperlinked-source is not set.
 886       if isHyperlinkedSource
 887         then []
 888         else
 889           maybe
 890             []
 891             ( \(m, e, l) ->
 892                 [ "--source-module=" ++ m
 893                 , "--source-entity=" ++ e
 894                 ]
 895                   ++ if isVersion 2 14
 896                     then ["--source-entity-line=" ++ l]
 897                     else []
 898             )
 899             . flagToMaybe
 900             . argLinkSource
 901             $ args
 902     , maybe [] ((: []) . ("--css=" ++)) . flagToMaybe . argCssFile $ args
 903     , maybe [] ((: []) . ("--use-contents=" ++)) . flagToMaybe . argContents $ args
 904     , bool ["--gen-contents"] [] . fromFlagOrDefault False . argGenContents $ args
 905     , maybe [] ((: []) . ("--use-index=" ++)) . flagToMaybe . argIndex $ args
 906     , bool ["--gen-index"] [] . fromFlagOrDefault False . argGenIndex $ args
 907     , maybe [] ((: []) . ("--base-url=" ++)) . flagToMaybe . argBaseUrl $ args
 908     , bool [] [verbosityFlag] . getAny . argVerbose $ args
 909     , map (\o -> case o of Hoogle -> "--hoogle"; Html -> "--html")
 910         . fromFlagOrDefault []
 911         . argOutput
 912         $ args
 913     , renderInterfaces . argInterfaces $ args
 914     , (: []) . ("--odir=" ++) . unDir . argOutputDir $ args
 915     , maybe
 916         []
 917         ( (: [])
 918             . ("--title=" ++)
 919             . ( bool
 920                   (++ " (internal documentation)")
 921                   id
 922                   (getAny $ argIgnoreExports args)
 923               )
 924         )
 925         . flagToMaybe
 926         . argTitle
 927         $ args
 928     , [ "--optghc=" ++ opt | let opts = argGhcOptions args, opt <- renderGhcOptions comp platform opts
 929       ]
 930     , maybe [] (\l -> ["-B" ++ l]) $
 931         flagToMaybe (argGhcLibDir args) -- error if Nothing?
 932     , -- https://github.com/haskell/haddock/pull/547
 933       [ "--reexport=" ++ prettyShow r
 934       | r <- argReexports args
 935       , isVersion 2 19
 936       ]
 937     , argTargets $ args
 938     , maybe [] ((: []) . ("--lib=" ++)) . flagToMaybe . argLib $ args
 939     ]
 940   where
 941     renderInterfaces = map renderInterface
 942
 943     renderInterface :: (FilePath, Maybe FilePath, Maybe FilePath, Visibility) -> String
 944     renderInterface (i, html, hypsrc, visibility) =
 945       "--read-interface="
 946         ++ intercalate
 947           ","
 948           ( concat
 949               [ [fromMaybe "" html]
 950               , -- only render hypsrc path if html path
 951                 -- is given and hyperlinked-source is
 952                 -- enabled
 953
 954                 [ case (html, hypsrc) of
 955                     (Nothing, _) -> ""
 956                     (_, Nothing) -> ""
 957                     (_, Just x)
 958                       | isVersion 2 17
 959                       , fromFlagOrDefault False . argLinkedSource $ args ->
 960                           x
 961                       | otherwise ->
 962                           ""
 963                 ]
 964               , if haddockSupportsVisibility
 965                   then
 966                     [ case visibility of
 967                         Visible -> "visible"
 968                         Hidden -> "hidden"
 969                     ]
 970                   else []
 971               , [i]
 972               ]
 973           )
 974
 975     bool a b c = if c then a else b
 976     isVersion major minor = version >= mkVersion [major, minor]
 977     verbosityFlag
 978       | isVersion 2 5 = "--verbosity=1"
 979       | otherwise = "--verbose"
 980     haddockSupportsVisibility = version >= mkVersion [2, 26, 1]
 981     haddockSupportsPackageName = version > mkVersion [2, 16]
 982     haddockSupportsHyperlinkedSource = isVersion 2 17
 983     isHyperlinkedSource =
 984       haddockSupportsHyperlinkedSource
 985         && fromFlagOrDefault False (argLinkedSource args)
 986
 987 ---------------------------------------------------------------------------------
 988
 989 -- | Given a list of 'InstalledPackageInfo's, return a list of interfaces and
 990 -- HTML paths, and an optional warning for packages with missing documentation.
 991 haddockPackagePaths
 992   :: [InstalledPackageInfo]
 993   -> Maybe (InstalledPackageInfo -> FilePath)
 994   -> IO
 995       ( [ ( FilePath -- path to interface
 996       -- file
 997           , Maybe FilePath -- url to html
 998           -- documentation
 999           , Maybe FilePath -- url to hyperlinked
1000           -- source
1001           , Visibility
1002           )
1003         ]
1004       , Maybe String -- warning about
1005       -- missing documentation
1006       )
1007 haddockPackagePaths ipkgs mkHtmlPath = do
1008   interfaces <-
1009     sequenceA
1010       [ case interfaceAndHtmlPath ipkg of
1011         Nothing -> return (Left (packageId ipkg))
1012         Just (interface, html) -> do
1013           (html', hypsrc') <-
1014             case html of
1015               Just htmlPath -> do
1016                 let hypSrcPath = htmlPath </> defaultHyperlinkedSourceDirectory
1017                 hypSrcExists <- doesDirectoryExist hypSrcPath
1018                 return $
1019                   ( Just (fixFileUrl htmlPath)
1020                   , if hypSrcExists
1021                       then Just (fixFileUrl hypSrcPath)
1022                       else Nothing
1023                   )
1024               Nothing -> return (Nothing, Nothing)
1025
1026           exists <- doesFileExist interface
1027           if exists
1028             then return (Right (interface, html', hypsrc', Visible))
1029             else return (Left pkgid)
1030       | ipkg <- ipkgs
1031       , let pkgid = packageId ipkg
1032       , pkgName pkgid `notElem` noHaddockWhitelist
1033       ]
1034
1035   let missing = [pkgid | Left pkgid <- interfaces]
1036       warning =
1037         "The documentation for the following packages are not "
1038           ++ "installed. No links will be generated to these packages: "
1039           ++ intercalate ", " (map prettyShow missing)
1040       flags = rights interfaces
1041
1042   return (flags, if null missing then Nothing else Just warning)
1043   where
1044     -- Don't warn about missing documentation for these packages. See #1231.
1045     noHaddockWhitelist = map mkPackageName ["rts"]
1046
1047     -- Actually extract interface and HTML paths from an 'InstalledPackageInfo'.
1048     interfaceAndHtmlPath
1049       :: InstalledPackageInfo
1050       -> Maybe (FilePath, Maybe FilePath)
1051     interfaceAndHtmlPath pkg = do
1052       interface <- listToMaybe (InstalledPackageInfo.haddockInterfaces pkg)
1053       html <- case mkHtmlPath of
1054         Nothing -> listToMaybe (InstalledPackageInfo.haddockHTMLs pkg)
1055         Just mkPath -> Just (mkPath pkg)
1056       return (interface, if null html then Nothing else Just html)
1057
1058     -- The 'haddock-html' field in the hc-pkg output is often set as a
1059     -- native path, but we need it as a URL. See #1064. Also don't "fix"
1060     -- the path if it is an interpolated one.
1061     fixFileUrl f
1062       | Nothing <- mkHtmlPath
1063       , isAbsolute f =
1064           "file://" ++ f
1065       | otherwise = f
1066
1067     -- 'src' is the default hyperlinked source directory ever since. It is
1068     -- not possible to configure that directory in any way in haddock.
1069     defaultHyperlinkedSourceDirectory = "src"
1070
1071 haddockPackageFlags
1072   :: Verbosity
1073   -> LocalBuildInfo
1074   -> ComponentLocalBuildInfo
1075   -> Maybe PathTemplate
1076   -> IO
1077       ( [ ( FilePath -- path to interface
1078       -- file
1079           , Maybe FilePath -- url to html
1080           -- documentation
1081           , Maybe FilePath -- url to hyperlinked
1082           -- source
1083           , Visibility
1084           )
1085         ]
1086       , Maybe String -- warning about
1087       -- missing documentation
1088       )
1089 haddockPackageFlags verbosity lbi clbi htmlTemplate = do
1090   let allPkgs = installedPkgs lbi
1091       directDeps = map fst (componentPackageDeps clbi)
1092   transitiveDeps <- case PackageIndex.dependencyClosure allPkgs directDeps of
1093     Left x -> return x
1094     Right inf ->
1095       dieWithException verbosity $ HaddockPackageFlags inf
1096
1097   haddockPackagePaths (PackageIndex.allPackages transitiveDeps) mkHtmlPath
1098   where
1099     mkHtmlPath = fmap expandTemplateVars htmlTemplate
1100     expandTemplateVars tmpl pkg =
1101       fromPathTemplate . substPathTemplate (env pkg) $ tmpl
1102     env pkg = haddockTemplateEnv lbi (packageId pkg)
1103
1104 haddockTemplateEnv :: LocalBuildInfo -> PackageIdentifier -> PathTemplateEnv
1105 haddockTemplateEnv lbi pkg_id =
1106   (PrefixVar, prefix (installDirTemplates lbi))
1107     -- We want the legacy unit ID here, because it gives us nice paths
1108     -- (Haddock people don't care about the dependencies)
1109     : initialPathTemplateEnv
1110       pkg_id
1111       (mkLegacyUnitId pkg_id)
1112       (compilerInfo (compiler lbi))
1113       (hostPlatform lbi)
1114
1115 -- ------------------------------------------------------------------------------
1116 -- hscolour support.
1117
1118 hscolour
1119   :: PackageDescription
1120   -> LocalBuildInfo
1121   -> [PPSuffixHandler]
1122   -> HscolourFlags
1123   -> IO ()
1124 hscolour = hscolour' dieNoVerbosity ForDevelopment
1125
1126 hscolour'
1127   :: (String -> IO ())
1128   -- ^ Called when the 'hscolour' exe is not found.
1129   -> HaddockTarget
1130   -> PackageDescription
1131   -> LocalBuildInfo
1132   -> [PPSuffixHandler]
1133   -> HscolourFlags
1134   -> IO ()
1135 hscolour' onNoHsColour haddockTarget pkg_descr lbi suffixes flags =
1136   either (\excep -> onNoHsColour $ exceptionMessage excep) (\(hscolourProg, _, _) -> go hscolourProg)
1137     =<< lookupProgramVersion
1138       verbosity
1139       hscolourProgram
1140       (orLaterVersion (mkVersion [1, 8]))
1141       (withPrograms lbi)
1142   where
1143     go :: ConfiguredProgram -> IO ()
1144     go hscolourProg = do
1145       warn verbosity $
1146         "the 'cabal hscolour' command is deprecated in favour of 'cabal "
1147           ++ "haddock --hyperlink-source' and will be removed in the next major "
1148           ++ "release."
1149
1150       setupMessage verbosity "Running hscolour for" (packageId pkg_descr)
1151       createDirectoryIfMissingVerbose verbosity True $
1152         hscolourPref haddockTarget distPref pkg_descr
1153
1154       withAllComponentsInBuildOrder pkg_descr lbi $ \comp clbi -> do
1155         componentInitialBuildSteps distPref pkg_descr lbi clbi verbosity
1156         preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
1157         let
1158           doExe com = case (compToExe com) of
1159             Just exe -> do
1160               let outputDir =
1161                     hscolourPref haddockTarget distPref pkg_descr
1162                       </> unUnqualComponentName (exeName exe)
1163                       </> "src"
1164               runHsColour hscolourProg outputDir =<< getExeSourceFiles verbosity lbi exe clbi
1165             Nothing -> do
1166               warn
1167                 (fromFlag $ hscolourVerbosity flags)
1168                 "Unsupported component, skipping..."
1169               return ()
1170         case comp of
1171           CLib lib -> do
1172             let outputDir = hscolourPref haddockTarget distPref pkg_descr </> "src"
1173             runHsColour hscolourProg outputDir =<< getLibSourceFiles verbosity lbi lib clbi
1174           CFLib flib -> do
1175             let outputDir =
1176                   hscolourPref haddockTarget distPref pkg_descr
1177                     </> unUnqualComponentName (foreignLibName flib)
1178                     </> "src"
1179             runHsColour hscolourProg outputDir =<< getFLibSourceFiles verbosity lbi flib clbi
1180           CExe _ -> when (fromFlag (hscolourExecutables flags)) $ doExe comp
1181           CTest _ -> when (fromFlag (hscolourTestSuites flags)) $ doExe comp
1182           CBench _ -> when (fromFlag (hscolourBenchmarks flags)) $ doExe comp
1183
1184     stylesheet = flagToMaybe (hscolourCSS flags)
1185
1186     verbosity = fromFlag (hscolourVerbosity flags)
1187     distPref = fromFlag (hscolourDistPref flags)
1188
1189     runHsColour prog outputDir moduleFiles = do
1190       createDirectoryIfMissingVerbose verbosity True outputDir
1191
1192       case stylesheet of -- copy the CSS file
1193         Nothing
1194           | programVersion prog >= Just (mkVersion [1, 9]) ->
1195               runProgram
1196                 verbosity
1197                 prog
1198                 ["-print-css", "-o" ++ outputDir </> "hscolour.css"]
1199           | otherwise -> return ()
1200         Just s -> copyFileVerbose verbosity s (outputDir </> "hscolour.css")
1201
1202       for_ moduleFiles $ \(m, inFile) ->
1203         runProgram
1204           verbosity
1205           prog
1206           ["-css", "-anchor", "-o" ++ outFile m, inFile]
1207       where
1208         outFile m =
1209           outputDir
1210             </> intercalate "-" (ModuleName.components m) <.> "html"
1211
1212 haddockToHscolour :: HaddockFlags -> HscolourFlags
1213 haddockToHscolour flags =
1214   HscolourFlags
1215     { hscolourCSS = haddockHscolourCss flags
1216     , hscolourExecutables = haddockExecutables flags
1217     , hscolourTestSuites = haddockTestSuites flags
1218     , hscolourBenchmarks = haddockBenchmarks flags
1219     , hscolourForeignLibs = haddockForeignLibs flags
1220     , hscolourVerbosity = haddockVerbosity flags
1221     , hscolourDistPref = haddockDistPref flags
1222     , hscolourCabalFilePath = haddockCabalFilePath flags
1223     }
1224
1225 -- ------------------------------------------------------------------------------
1226 -- Boilerplate Monoid instance.
1227 instance Monoid HaddockArgs where
1228   mempty = gmempty
1229   mappend = (<>)
1230
1231 instance Semigroup HaddockArgs where
1232   (<>) = gmappend
1233
1234 instance Monoid Directory where
1235   mempty = Dir "."
1236   mappend = (<>)
1237
1238 instance Semigroup Directory where
1239   Dir m <> Dir n = Dir $ m </> n