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 (matchDirFileGlob)
  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   let using_hscolour = flag haddockLinkedSource && version < mkVersion [2, 17]
 273   when using_hscolour $
 274     hscolour'
 275       (warn verbosity)
 276       haddockTarget
 277       pkg_descr
 278       lbi
 279       suffixes
 280       (defaultHscolourFlags `mappend` haddockToHscolour flags)
 281
 282   targets <- readTargetInfos verbosity pkg_descr lbi (haddockArgs flags)
 283
 284   let
 285     targets' =
 286       case targets of
 287         [] -> allTargetsInBuildOrder' pkg_descr lbi
 288         _ -> targets
 289
 290   internalPackageDB <-
 291     createInternalPackageDB verbosity lbi (flag haddockDistPref)
 292
 293   (\f -> foldM_ f (installedPkgs lbi) targets') $ \index target -> do
 294     let component = targetComponent target
 295         clbi = targetCLBI target
 296
 297     preBuildComponent verbosity lbi target
 298
 299     let
 300       lbi' =
 301         lbi
 302           { withPackageDB = withPackageDB lbi ++ [internalPackageDB]
 303           , installedPkgs = index
 304           }
 305
 306     preprocessComponent pkg_descr component lbi' clbi False verbosity suffixes
 307     let
 308       doExe com = case (compToExe com) of
 309         Just exe -> do
 310           withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi') "tmp" $
 311             \tmp -> do
 312               exeArgs <-
 313                 fromExecutable
 314                   verbosity
 315                   tmp
 316                   lbi'
 317                   clbi
 318                   htmlTemplate
 319                   version
 320                   exe
 321               let exeArgs' = commonArgs `mappend` exeArgs
 322               runHaddock
 323                 verbosity
 324                 tmpFileOpts
 325                 comp
 326                 platform
 327                 haddockProg
 328                 True
 329                 exeArgs'
 330         Nothing -> do
 331           warn
 332             (fromFlag $ haddockVerbosity flags)
 333             "Unsupported component, skipping..."
 334           return ()
 335       -- We define 'smsg' once and then reuse it inside the case, so that
 336       -- we don't say we are running Haddock when we actually aren't
 337       -- (e.g., Haddock is not run on non-libraries)
 338       smsg :: IO ()
 339       smsg =
 340         setupMessage'
 341           verbosity
 342           "Running Haddock on"
 343           (packageId pkg_descr)
 344           (componentLocalName clbi)
 345           (maybeComponentInstantiatedWith clbi)
 346     case component of
 347       CLib lib -> do
 348         withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi) "tmp" $
 349           \tmp -> do
 350             smsg
 351             libArgs <-
 352               fromLibrary
 353                 verbosity
 354                 tmp
 355                 lbi'
 356                 clbi
 357                 htmlTemplate
 358                 version
 359                 lib
 360             let libArgs' = commonArgs `mappend` libArgs
 361             runHaddock verbosity tmpFileOpts comp platform haddockProg True libArgs'
 362
 363             pwd <- getCurrentDirectory
 364
 365             let
 366               ipi =
 367                 inplaceInstalledPackageInfo
 368                   pwd
 369                   (flag haddockDistPref)
 370                   pkg_descr
 371                   (mkAbiHash "inplace")
 372                   lib
 373                   lbi'
 374                   clbi
 375
 376             debug verbosity $
 377               "Registering inplace:\n"
 378                 ++ (InstalledPackageInfo.showInstalledPackageInfo ipi)
 379
 380             registerPackage
 381               verbosity
 382               (compiler lbi')
 383               (withPrograms lbi')
 384               (withPackageDB lbi')
 385               ipi
 386               HcPkg.defaultRegisterOptions
 387                 { HcPkg.registerMultiInstance = True
 388                 }
 389
 390             return $ PackageIndex.insert ipi index
 391       CFLib flib ->
 392         when
 393           (flag haddockForeignLibs)
 394           ( do
 395               withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi') "tmp" $
 396                 \tmp -> do
 397                   smsg
 398                   flibArgs <-
 399                     fromForeignLib
 400                       verbosity
 401                       tmp
 402                       lbi'
 403                       clbi
 404                       htmlTemplate
 405                       version
 406                       flib
 407                   let libArgs' = commonArgs `mappend` flibArgs
 408                   runHaddock verbosity tmpFileOpts comp platform haddockProg True libArgs'
 409           )
 410           >> return index
 411       CExe _ -> when (flag haddockExecutables) (smsg >> doExe component) >> return index
 412       CTest _ -> when (flag haddockTestSuites) (smsg >> doExe component) >> return index
 413       CBench _ -> when (flag haddockBenchmarks) (smsg >> doExe component) >> return index
 414
 415   for_ (extraDocFiles pkg_descr) $ \fpath -> do
 416     files <- matchDirFileGlob verbosity (specVersion pkg_descr) "." fpath
 417     for_ files $ copyFileTo verbosity (unDir $ argOutputDir commonArgs)
 418
 419 -- | Execute 'Haddock' configured with 'HaddocksFlags'.  It is used to build
 420 -- index and contents for documentation of multiple packages.
 421 createHaddockIndex
 422   :: Verbosity
 423   -> ProgramDb
 424   -> Compiler
 425   -> Platform
 426   -> HaddockProjectFlags
 427   -> IO ()
 428 createHaddockIndex verbosity programDb comp platform flags = do
 429   let args = fromHaddockProjectFlags flags
 430   (haddockProg, _version) <-
 431     getHaddockProg verbosity programDb comp args (Flag True)
 432   runHaddock verbosity defaultTempFileOptions comp platform haddockProg False args
 433
 434 -- ------------------------------------------------------------------------------
 435 -- Contributions to HaddockArgs (see also Doctest.hs for very similar code).
 436
 437 fromFlags :: PathTemplateEnv -> HaddockFlags -> HaddockArgs
 438 fromFlags env flags =
 439   mempty
 440     { argHideModules =
 441         ( maybe mempty (All . not) $
 442             flagToMaybe (haddockInternal flags)
 443         , mempty
 444         )
 445     , argLinkSource =
 446         if fromFlag (haddockLinkedSource flags)
 447           then
 448             Flag
 449               ( "src/%{MODULE/./-}.html"
 450               , "src/%{MODULE/./-}.html#%{NAME}"
 451               , "src/%{MODULE/./-}.html#line-%{LINE}"
 452               )
 453           else NoFlag
 454     , argLinkedSource = haddockLinkedSource flags
 455     , argQuickJump = haddockQuickJump flags
 456     , argCssFile = haddockCss flags
 457     , argContents =
 458         fmap
 459           (fromPathTemplate . substPathTemplate env)
 460           (haddockContents flags)
 461     , argGenContents = Flag False
 462     , argIndex =
 463         fmap
 464           (fromPathTemplate . substPathTemplate env)
 465           (haddockIndex flags)
 466     , argGenIndex = Flag False
 467     , argBaseUrl = haddockBaseUrl flags
 468     , argLib = haddockLib flags
 469     , argVerbose =
 470         maybe mempty (Any . (>= deafening))
 471           . flagToMaybe
 472           $ haddockVerbosity flags
 473     , argOutput =
 474         Flag $ case [Html | Flag True <- [haddockHtml flags]]
 475           ++ [Hoogle | Flag True <- [haddockHoogle flags]] of
 476           [] -> [Html]
 477           os -> os
 478     , argOutputDir = maybe mempty Dir . flagToMaybe $ haddockDistPref flags
 479     , argGhcOptions = mempty{ghcOptExtra = ghcArgs}
 480     }
 481   where
 482     ghcArgs = fromMaybe [] . lookup "ghc" . haddockProgramArgs $ flags
 483
 484 fromHaddockProjectFlags :: HaddockProjectFlags -> HaddockArgs
 485 fromHaddockProjectFlags flags =
 486   mempty
 487     { argOutputDir = Dir (fromFlag $ haddockProjectDir flags)
 488     , argQuickJump = Flag True
 489     , argGenContents = Flag True
 490     , argGenIndex = Flag True
 491     , argPrologueFile = haddockProjectPrologue flags
 492     , argInterfaces = fromFlagOrDefault [] (haddockProjectInterfaces flags)
 493     , argLinkedSource = Flag True
 494     , argLib = haddockProjectLib flags
 495     }
 496
 497 fromPackageDescription :: HaddockTarget -> PackageDescription -> HaddockArgs
 498 fromPackageDescription haddockTarget pkg_descr =
 499   mempty
 500     { argInterfaceFile = Flag $ haddockName pkg_descr
 501     , argPackageName = Flag $ packageId $ pkg_descr
 502     , argOutputDir =
 503         Dir $
 504           "doc" </> "html" </> haddockDirName haddockTarget pkg_descr
 505     , argPrologue =
 506         Flag $
 507           ShortText.fromShortText $
 508             if ShortText.null desc
 509               then synopsis pkg_descr
 510               else desc
 511     , argTitle = Flag $ showPkg ++ subtitle
 512     }
 513   where
 514     desc = description pkg_descr
 515     showPkg = prettyShow (packageId pkg_descr)
 516     subtitle
 517       | ShortText.null (synopsis pkg_descr) = ""
 518       | otherwise = ": " ++ ShortText.fromShortText (synopsis pkg_descr)
 519
 520 componentGhcOptions
 521   :: Verbosity
 522   -> LocalBuildInfo
 523   -> BuildInfo
 524   -> ComponentLocalBuildInfo
 525   -> FilePath
 526   -> GhcOptions
 527 componentGhcOptions verbosity lbi bi clbi odir =
 528   let f = case compilerFlavor (compiler lbi) of
 529         GHC -> GHC.componentGhcOptions
 530         GHCJS -> GHCJS.componentGhcOptions
 531         _ ->
 532           error $
 533             "Distribution.Simple.Haddock.componentGhcOptions:"
 534               ++ "haddock only supports GHC and GHCJS"
 535    in f verbosity lbi bi clbi odir
 536
 537 mkHaddockArgs
 538   :: Verbosity
 539   -> FilePath
 540   -> LocalBuildInfo
 541   -> ComponentLocalBuildInfo
 542   -> Maybe PathTemplate
 543   -- ^ template for HTML location
 544   -> Version
 545   -> [FilePath]
 546   -> BuildInfo
 547   -> IO HaddockArgs
 548 mkHaddockArgs verbosity tmp lbi clbi htmlTemplate haddockVersion inFiles bi = do
 549   ifaceArgs <- getInterfaces verbosity lbi clbi htmlTemplate
 550   let vanillaOpts =
 551         (componentGhcOptions normal lbi bi clbi (buildDir lbi))
 552           { -- Noooooooooo!!!!!111
 553             -- haddock stomps on our precious .hi
 554             -- and .o files. Workaround by telling
 555             -- haddock to write them elsewhere.
 556             ghcOptObjDir = toFlag tmp
 557           , ghcOptHiDir = toFlag tmp
 558           , ghcOptStubDir = toFlag tmp
 559           }
 560           `mappend` getGhcCppOpts haddockVersion bi
 561       sharedOpts =
 562         vanillaOpts
 563           { ghcOptDynLinkMode = toFlag GhcDynamicOnly
 564           , ghcOptFPic = toFlag True
 565           , ghcOptHiSuffix = toFlag "dyn_hi"
 566           , ghcOptObjSuffix = toFlag "dyn_o"
 567           , ghcOptExtra = hcSharedOptions GHC bi
 568           }
 569   opts <-
 570     if withVanillaLib lbi
 571       then return vanillaOpts
 572       else
 573         if withSharedLib lbi
 574           then return sharedOpts
 575           else dieWithException verbosity MustHaveSharedLibraries
 576
 577   return
 578     ifaceArgs
 579       { argGhcOptions = opts
 580       , argTargets = inFiles
 581       , argReexports = getReexports clbi
 582       }
 583
 584 fromLibrary
 585   :: Verbosity
 586   -> FilePath
 587   -> LocalBuildInfo
 588   -> ComponentLocalBuildInfo
 589   -> Maybe PathTemplate
 590   -- ^ template for HTML location
 591   -> Version
 592   -> Library
 593   -> IO HaddockArgs
 594 fromLibrary verbosity tmp lbi clbi htmlTemplate haddockVersion lib = do
 595   inFiles <- map snd `fmap` getLibSourceFiles verbosity lbi lib clbi
 596   args <-
 597     mkHaddockArgs
 598       verbosity
 599       tmp
 600       lbi
 601       clbi
 602       htmlTemplate
 603       haddockVersion
 604       inFiles
 605       (libBuildInfo lib)
 606   return
 607     args
 608       { argHideModules = (mempty, otherModules (libBuildInfo lib))
 609       }
 610
 611 fromExecutable
 612   :: Verbosity
 613   -> FilePath
 614   -> LocalBuildInfo
 615   -> ComponentLocalBuildInfo
 616   -> Maybe PathTemplate
 617   -- ^ template for HTML location
 618   -> Version
 619   -> Executable
 620   -> IO HaddockArgs
 621 fromExecutable verbosity tmp lbi clbi htmlTemplate haddockVersion exe = do
 622   inFiles <- map snd `fmap` getExeSourceFiles verbosity lbi exe clbi
 623   args <-
 624     mkHaddockArgs
 625       verbosity
 626       tmp
 627       lbi
 628       clbi
 629       htmlTemplate
 630       haddockVersion
 631       inFiles
 632       (buildInfo exe)
 633   return
 634     args
 635       { argOutputDir = Dir $ unUnqualComponentName $ exeName exe
 636       , argTitle = Flag $ unUnqualComponentName $ exeName exe
 637       }
 638
 639 fromForeignLib
 640   :: Verbosity
 641   -> FilePath
 642   -> LocalBuildInfo
 643   -> ComponentLocalBuildInfo
 644   -> Maybe PathTemplate
 645   -- ^ template for HTML location
 646   -> Version
 647   -> ForeignLib
 648   -> IO HaddockArgs
 649 fromForeignLib verbosity tmp lbi clbi htmlTemplate haddockVersion flib = do
 650   inFiles <- map snd `fmap` getFLibSourceFiles verbosity lbi flib clbi
 651   args <-
 652     mkHaddockArgs
 653       verbosity
 654       tmp
 655       lbi
 656       clbi
 657       htmlTemplate
 658       haddockVersion
 659       inFiles
 660       (foreignLibBuildInfo flib)
 661   return
 662     args
 663       { argOutputDir = Dir $ unUnqualComponentName $ foreignLibName flib
 664       , argTitle = Flag $ unUnqualComponentName $ foreignLibName flib
 665       }
 666
 667 compToExe :: Component -> Maybe Executable
 668 compToExe comp =
 669   case comp of
 670     CTest test@TestSuite{testInterface = TestSuiteExeV10 _ f} ->
 671       Just
 672         Executable
 673           { exeName = testName test
 674           , modulePath = f
 675           , exeScope = ExecutablePublic
 676           , buildInfo = testBuildInfo test
 677           }
 678     CBench bench@Benchmark{benchmarkInterface = BenchmarkExeV10 _ f} ->
 679       Just
 680         Executable
 681           { exeName = benchmarkName bench
 682           , modulePath = f
 683           , exeScope = ExecutablePublic
 684           , buildInfo = benchmarkBuildInfo bench
 685           }
 686     CExe exe -> Just exe
 687     _ -> Nothing
 688
 689 getInterfaces
 690   :: Verbosity
 691   -> LocalBuildInfo
 692   -> ComponentLocalBuildInfo
 693   -> Maybe PathTemplate
 694   -- ^ template for HTML location
 695   -> IO HaddockArgs
 696 getInterfaces verbosity lbi clbi htmlTemplate = do
 697   (packageFlags, warnings) <- haddockPackageFlags verbosity lbi clbi htmlTemplate
 698   traverse_ (warn (verboseUnmarkOutput verbosity)) warnings
 699   return $
 700     mempty
 701       { argInterfaces = packageFlags
 702       }
 703
 704 getReexports :: ComponentLocalBuildInfo -> [OpenModule]
 705 getReexports LibComponentLocalBuildInfo{componentExposedModules = mods} =
 706   mapMaybe exposedReexport mods
 707 getReexports _ = []
 708
 709 getGhcCppOpts
 710   :: Version
 711   -> BuildInfo
 712   -> GhcOptions
 713 getGhcCppOpts haddockVersion bi =
 714   mempty
 715     { ghcOptExtensions = toNubListR [EnableExtension CPP | needsCpp]
 716     , ghcOptCppOptions = defines
 717     }
 718   where
 719     needsCpp = EnableExtension CPP `elem` usedExtensions bi
 720     defines = [haddockVersionMacro]
 721     haddockVersionMacro =
 722       "-D__HADDOCK_VERSION__="
 723         ++ show (v1 * 1000 + v2 * 10 + v3)
 724       where
 725         (v1, v2, v3) = case versionNumbers haddockVersion of
 726           [] -> (0, 0, 0)
 727           [x] -> (x, 0, 0)
 728           [x, y] -> (x, y, 0)
 729           (x : y : z : _) -> (x, y, z)
 730
 731 getGhcLibDir
 732   :: Verbosity
 733   -> LocalBuildInfo
 734   -> IO HaddockArgs
 735 getGhcLibDir verbosity lbi = do
 736   l <- case compilerFlavor (compiler lbi) of
 737     GHC -> GHC.getLibDir verbosity lbi
 738     GHCJS -> GHCJS.getLibDir verbosity lbi
 739     _ -> error "haddock only supports GHC and GHCJS"
 740   return $ mempty{argGhcLibDir = Flag l}
 741
 742 -- ------------------------------------------------------------------------------
 743
 744 -- | Call haddock with the specified arguments.
 745 runHaddock
 746   :: Verbosity
 747   -> TempFileOptions
 748   -> Compiler
 749   -> Platform
 750   -> ConfiguredProgram
 751   -> Bool
 752   -- ^ require targets
 753   -> HaddockArgs
 754   -> IO ()
 755 runHaddock verbosity tmpFileOpts comp platform haddockProg requireTargets args
 756   | requireTargets && null (argTargets args) =
 757       warn verbosity $
 758         "Haddocks are being requested, but there aren't any modules given "
 759           ++ "to create documentation for."
 760   | otherwise = do
 761       let haddockVersion =
 762             fromMaybe
 763               (error "unable to determine haddock version")
 764               (programVersion haddockProg)
 765       renderArgs verbosity tmpFileOpts haddockVersion comp platform args $
 766         \(flags, result) -> do
 767           runProgram verbosity haddockProg flags
 768
 769           notice verbosity $ "Documentation created: " ++ result
 770
 771 renderArgs
 772   :: Verbosity
 773   -> TempFileOptions
 774   -> Version
 775   -> Compiler
 776   -> Platform
 777   -> HaddockArgs
 778   -> (([String], FilePath) -> IO a)
 779   -> IO a
 780 renderArgs verbosity tmpFileOpts version comp platform args k = do
 781   let haddockSupportsUTF8 = version >= mkVersion [2, 14, 4]
 782       haddockSupportsResponseFiles = version > mkVersion [2, 16, 2]
 783   createDirectoryIfMissingVerbose verbosity True outputDir
 784   case argPrologue args of
 785     Flag prologueText ->
 786       withTempFileEx tmpFileOpts outputDir "haddock-prologue.txt" $
 787         \prologueFileName h -> do
 788           do
 789             when haddockSupportsUTF8 (hSetEncoding h utf8)
 790             hPutStrLn h prologueText
 791             hClose h
 792             let pflag = "--prologue=" ++ prologueFileName
 793                 renderedArgs = pflag : renderPureArgs version comp platform args
 794             if haddockSupportsResponseFiles
 795               then
 796                 withResponseFile
 797                   verbosity
 798                   tmpFileOpts
 799                   outputDir
 800                   "haddock-response.txt"
 801                   (if haddockSupportsUTF8 then Just utf8 else Nothing)
 802                   renderedArgs
 803                   (\responseFileName -> k (["@" ++ responseFileName], result))
 804               else k (renderedArgs, result)
 805     _ -> do
 806       let renderedArgs =
 807             ( case argPrologueFile args of
 808                 Flag pfile -> ["--prologue=" ++ pfile]
 809                 _ -> []
 810             )
 811               <> renderPureArgs version comp platform args
 812       if haddockSupportsResponseFiles
 813         then
 814           withResponseFile
 815             verbosity
 816             tmpFileOpts
 817             outputDir
 818             "haddock-response.txt"
 819             (if haddockSupportsUTF8 then Just utf8 else Nothing)
 820             renderedArgs
 821             (\responseFileName -> k (["@" ++ responseFileName], result))
 822         else k (renderedArgs, result)
 823   where
 824     outputDir = (unDir $ argOutputDir args)
 825     isNotArgContents = isNothing (flagToMaybe $ argContents args)
 826     isNotArgIndex = isNothing (flagToMaybe $ argIndex args)
 827     isArgGenIndex = fromFlagOrDefault False (argGenIndex args)
 828     -- Haddock, when generating HTML, does not generate an index if the options
 829     -- --use-contents or --use-index are passed to it. See
 830     -- https://haskell-haddock.readthedocs.io/en/latest/invoking.html#cmdoption-use-contents
 831     isIndexGenerated = isArgGenIndex && isNotArgContents && isNotArgIndex
 832     result =
 833       intercalate ", "
 834         . map
 835           ( \o ->
 836               outputDir
 837                 </> case o of
 838                   Html
 839                     | isIndexGenerated ->
 840                         "index.html"
 841                   Html
 842                     | otherwise ->
 843                         mempty
 844                   Hoogle -> pkgstr <.> "txt"
 845           )
 846         . fromFlagOrDefault [Html]
 847         . argOutput
 848         $ args
 849       where
 850         pkgstr = prettyShow $ packageName pkgid
 851         pkgid = arg argPackageName
 852     arg f = fromFlag $ f args
 853
 854 renderPureArgs :: Version -> Compiler -> Platform -> HaddockArgs -> [String]
 855 renderPureArgs version comp platform args =
 856   concat
 857     [ map (\f -> "--dump-interface=" ++ unDir (argOutputDir args) </> f)
 858         . flagToList
 859         . argInterfaceFile
 860         $ args
 861     , if haddockSupportsPackageName
 862         then
 863           maybe
 864             []
 865             ( \pkg ->
 866                 [ "--package-name=" ++ prettyShow (pkgName pkg)
 867                 , "--package-version=" ++ prettyShow (pkgVersion pkg)
 868                 ]
 869             )
 870             . flagToMaybe
 871             . argPackageName
 872             $ args
 873         else []
 874     , ["--since-qual=external" | isVersion 2 20]
 875     , [ "--quickjump" | isVersion 2 19, True <- flagToList . argQuickJump $ args
 876       ]
 877     , ["--hyperlinked-source" | isHyperlinkedSource]
 878     , (\(All b, xs) -> bool (map (("--hide=" ++) . prettyShow) xs) [] b)
 879         . argHideModules
 880         $ args
 881     , bool ["--ignore-all-exports"] [] . getAny . argIgnoreExports $ args
 882     , -- Haddock's --source-* options are ignored once --hyperlinked-source is
 883       -- set.
 884       -- See https://haskell-haddock.readthedocs.io/en/latest/invoking.html#cmdoption-hyperlinked-source
 885       -- To avoid Haddock's warning, we only set --source-* options if
 886       -- --hyperlinked-source is not set.
 887       if isHyperlinkedSource
 888         then []
 889         else
 890           maybe
 891             []
 892             ( \(m, e, l) ->
 893                 [ "--source-module=" ++ m
 894                 , "--source-entity=" ++ e
 895                 ]
 896                   ++ if isVersion 2 14
 897                     then ["--source-entity-line=" ++ l]
 898                     else []
 899             )
 900             . flagToMaybe
 901             . argLinkSource
 902             $ args
 903     , maybe [] ((: []) . ("--css=" ++)) . flagToMaybe . argCssFile $ args
 904     , maybe [] ((: []) . ("--use-contents=" ++)) . flagToMaybe . argContents $ args
 905     , bool ["--gen-contents"] [] . fromFlagOrDefault False . argGenContents $ args
 906     , maybe [] ((: []) . ("--use-index=" ++)) . flagToMaybe . argIndex $ args
 907     , bool ["--gen-index"] [] . fromFlagOrDefault False . argGenIndex $ args
 908     , maybe [] ((: []) . ("--base-url=" ++)) . flagToMaybe . argBaseUrl $ args
 909     , bool [] [verbosityFlag] . getAny . argVerbose $ args
 910     , map (\o -> case o of Hoogle -> "--hoogle"; Html -> "--html")
 911         . fromFlagOrDefault []
 912         . argOutput
 913         $ args
 914     , renderInterfaces . argInterfaces $ args
 915     , (: []) . ("--odir=" ++) . unDir . argOutputDir $ args
 916     , maybe
 917         []
 918         ( (: [])
 919             . ("--title=" ++)
 920             . ( bool
 921                   (++ " (internal documentation)")
 922                   id
 923                   (getAny $ argIgnoreExports args)
 924               )
 925         )
 926         . flagToMaybe
 927         . argTitle
 928         $ args
 929     , [ "--optghc=" ++ opt | let opts = argGhcOptions args, opt <- renderGhcOptions comp platform opts
 930       ]
 931     , maybe [] (\l -> ["-B" ++ l]) $
 932         flagToMaybe (argGhcLibDir args) -- error if Nothing?
 933     , -- https://github.com/haskell/haddock/pull/547
 934       [ "--reexport=" ++ prettyShow r
 935       | r <- argReexports args
 936       , isVersion 2 19
 937       ]
 938     , argTargets $ args
 939     , maybe [] ((: []) . ("--lib=" ++)) . flagToMaybe . argLib $ args
 940     ]
 941   where
 942     renderInterfaces = map renderInterface
 943
 944     renderInterface :: (FilePath, Maybe FilePath, Maybe FilePath, Visibility) -> String
 945     renderInterface (i, html, hypsrc, visibility) =
 946       "--read-interface="
 947         ++ intercalate
 948           ","
 949           ( concat
 950               [ [fromMaybe "" html]
 951               , -- only render hypsrc path if html path
 952                 -- is given and hyperlinked-source is
 953                 -- enabled
 954
 955                 [ case (html, hypsrc) of
 956                     (Nothing, _) -> ""
 957                     (_, Nothing) -> ""
 958                     (_, Just x)
 959                       | isVersion 2 17
 960                       , fromFlagOrDefault False . argLinkedSource $ args ->
 961                           x
 962                       | otherwise ->
 963                           ""
 964                 ]
 965               , if haddockSupportsVisibility
 966                   then
 967                     [ case visibility of
 968                         Visible -> "visible"
 969                         Hidden -> "hidden"
 970                     ]
 971                   else []
 972               , [i]
 973               ]
 974           )
 975
 976     bool a b c = if c then a else b
 977     isVersion major minor = version >= mkVersion [major, minor]
 978     verbosityFlag
 979       | isVersion 2 5 = "--verbosity=1"
 980       | otherwise = "--verbose"
 981     haddockSupportsVisibility = version >= mkVersion [2, 26, 1]
 982     haddockSupportsPackageName = version > mkVersion [2, 16]
 983     haddockSupportsHyperlinkedSource = isVersion 2 17
 984     isHyperlinkedSource =
 985       haddockSupportsHyperlinkedSource
 986         && fromFlagOrDefault False (argLinkedSource args)
 987
 988 ---------------------------------------------------------------------------------
 989
 990 -- | Given a list of 'InstalledPackageInfo's, return a list of interfaces and
 991 -- HTML paths, and an optional warning for packages with missing documentation.
 992 haddockPackagePaths
 993   :: [InstalledPackageInfo]
 994   -> Maybe (InstalledPackageInfo -> FilePath)
 995   -> IO
 996       ( [ ( FilePath -- path to interface
 997       -- file
 998           , Maybe FilePath -- url to html
 999           -- documentation
1000           , Maybe FilePath -- url to hyperlinked
1001           -- source
1002           , Visibility
1003           )
1004         ]
1005       , Maybe String -- warning about
1006       -- missing documentation
1007       )
1008 haddockPackagePaths ipkgs mkHtmlPath = do
1009   interfaces <-
1010     sequenceA
1011       [ case interfaceAndHtmlPath ipkg of
1012         Nothing -> return (Left (packageId ipkg))
1013         Just (interface, html) -> do
1014           (html', hypsrc') <-
1015             case html of
1016               Just htmlPath -> do
1017                 let hypSrcPath = htmlPath </> defaultHyperlinkedSourceDirectory
1018                 hypSrcExists <- doesDirectoryExist hypSrcPath
1019                 return $
1020                   ( Just (fixFileUrl htmlPath)
1021                   , if hypSrcExists
1022                       then Just (fixFileUrl hypSrcPath)
1023                       else Nothing
1024                   )
1025               Nothing -> return (Nothing, Nothing)
1026
1027           exists <- doesFileExist interface
1028           if exists
1029             then return (Right (interface, html', hypsrc', Visible))
1030             else return (Left pkgid)
1031       | ipkg <- ipkgs
1032       , let pkgid = packageId ipkg
1033       , pkgName pkgid `notElem` noHaddockWhitelist
1034       ]
1035
1036   let missing = [pkgid | Left pkgid <- interfaces]
1037       warning =
1038         "The documentation for the following packages are not "
1039           ++ "installed. No links will be generated to these packages: "
1040           ++ intercalate ", " (map prettyShow missing)
1041       flags = rights interfaces
1042
1043   return (flags, if null missing then Nothing else Just warning)
1044   where
1045     -- Don't warn about missing documentation for these packages. See #1231.
1046     noHaddockWhitelist = map mkPackageName ["rts"]
1047
1048     -- Actually extract interface and HTML paths from an 'InstalledPackageInfo'.
1049     interfaceAndHtmlPath
1050       :: InstalledPackageInfo
1051       -> Maybe (FilePath, Maybe FilePath)
1052     interfaceAndHtmlPath pkg = do
1053       interface <- listToMaybe (InstalledPackageInfo.haddockInterfaces pkg)
1054       html <- case mkHtmlPath of
1055         Nothing -> listToMaybe (InstalledPackageInfo.haddockHTMLs pkg)
1056         Just mkPath -> Just (mkPath pkg)
1057       return (interface, if null html then Nothing else Just html)
1058
1059     -- The 'haddock-html' field in the hc-pkg output is often set as a
1060     -- native path, but we need it as a URL. See #1064. Also don't "fix"
1061     -- the path if it is an interpolated one.
1062     fixFileUrl f
1063       | Nothing <- mkHtmlPath
1064       , isAbsolute f =
1065           "file://" ++ f
1066       | otherwise = f
1067
1068     -- 'src' is the default hyperlinked source directory ever since. It is
1069     -- not possible to configure that directory in any way in haddock.
1070     defaultHyperlinkedSourceDirectory = "src"
1071
1072 haddockPackageFlags
1073   :: Verbosity
1074   -> LocalBuildInfo
1075   -> ComponentLocalBuildInfo
1076   -> Maybe PathTemplate
1077   -> IO
1078       ( [ ( FilePath -- path to interface
1079       -- file
1080           , Maybe FilePath -- url to html
1081           -- documentation
1082           , Maybe FilePath -- url to hyperlinked
1083           -- source
1084           , Visibility
1085           )
1086         ]
1087       , Maybe String -- warning about
1088       -- missing documentation
1089       )
1090 haddockPackageFlags verbosity lbi clbi htmlTemplate = do
1091   let allPkgs = installedPkgs lbi
1092       directDeps = map fst (componentPackageDeps clbi)
1093   transitiveDeps <- case PackageIndex.dependencyClosure allPkgs directDeps of
1094     Left x -> return x
1095     Right inf ->
1096       dieWithException verbosity $ HaddockPackageFlags inf
1097
1098   haddockPackagePaths (PackageIndex.allPackages transitiveDeps) mkHtmlPath
1099   where
1100     mkHtmlPath = fmap expandTemplateVars htmlTemplate
1101     expandTemplateVars tmpl pkg =
1102       fromPathTemplate . substPathTemplate (env pkg) $ tmpl
1103     env pkg = haddockTemplateEnv lbi (packageId pkg)
1104
1105 haddockTemplateEnv :: LocalBuildInfo -> PackageIdentifier -> PathTemplateEnv
1106 haddockTemplateEnv lbi pkg_id =
1107   (PrefixVar, prefix (installDirTemplates lbi))
1108     -- We want the legacy unit ID here, because it gives us nice paths
1109     -- (Haddock people don't care about the dependencies)
1110     : initialPathTemplateEnv
1111       pkg_id
1112       (mkLegacyUnitId pkg_id)
1113       (compilerInfo (compiler lbi))
1114       (hostPlatform lbi)
1115
1116 -- ------------------------------------------------------------------------------
1117 -- hscolour support.
1118
1119 hscolour
1120   :: PackageDescription
1121   -> LocalBuildInfo
1122   -> [PPSuffixHandler]
1123   -> HscolourFlags
1124   -> IO ()
1125 hscolour = hscolour' dieNoVerbosity ForDevelopment
1126
1127 hscolour'
1128   :: (String -> IO ())
1129   -- ^ Called when the 'hscolour' exe is not found.
1130   -> HaddockTarget
1131   -> PackageDescription
1132   -> LocalBuildInfo
1133   -> [PPSuffixHandler]
1134   -> HscolourFlags
1135   -> IO ()
1136 hscolour' onNoHsColour haddockTarget pkg_descr lbi suffixes flags =
1137   either (\excep -> onNoHsColour $ exceptionMessage excep) (\(hscolourProg, _, _) -> go hscolourProg)
1138     =<< lookupProgramVersion
1139       verbosity
1140       hscolourProgram
1141       (orLaterVersion (mkVersion [1, 8]))
1142       (withPrograms lbi)
1143   where
1144     go :: ConfiguredProgram -> IO ()
1145     go hscolourProg = do
1146       warn verbosity $
1147         "the 'cabal hscolour' command is deprecated in favour of 'cabal "
1148           ++ "haddock --hyperlink-source' and will be removed in the next major "
1149           ++ "release."
1150
1151       setupMessage verbosity "Running hscolour for" (packageId pkg_descr)
1152       createDirectoryIfMissingVerbose verbosity True $
1153         hscolourPref haddockTarget distPref pkg_descr
1154
1155       withAllComponentsInBuildOrder pkg_descr lbi $ \comp clbi -> do
1156         let tgt = TargetInfo clbi comp
1157         preBuildComponent verbosity lbi tgt
1158         preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
1159         let
1160           doExe com = case (compToExe com) of
1161             Just exe -> do
1162               let outputDir =
1163                     hscolourPref haddockTarget distPref pkg_descr
1164                       </> unUnqualComponentName (exeName exe)
1165                       </> "src"
1166               runHsColour hscolourProg outputDir =<< getExeSourceFiles verbosity lbi exe clbi
1167             Nothing -> do
1168               warn
1169                 (fromFlag $ hscolourVerbosity flags)
1170                 "Unsupported component, skipping..."
1171               return ()
1172         case comp of
1173           CLib lib -> do
1174             let outputDir = hscolourPref haddockTarget distPref pkg_descr </> "src"
1175             runHsColour hscolourProg outputDir =<< getLibSourceFiles verbosity lbi lib clbi
1176           CFLib flib -> do
1177             let outputDir =
1178                   hscolourPref haddockTarget distPref pkg_descr
1179                     </> unUnqualComponentName (foreignLibName flib)
1180                     </> "src"
1181             runHsColour hscolourProg outputDir =<< getFLibSourceFiles verbosity lbi flib clbi
1182           CExe _ -> when (fromFlag (hscolourExecutables flags)) $ doExe comp
1183           CTest _ -> when (fromFlag (hscolourTestSuites flags)) $ doExe comp
1184           CBench _ -> when (fromFlag (hscolourBenchmarks flags)) $ doExe comp
1185
1186     stylesheet = flagToMaybe (hscolourCSS flags)
1187
1188     verbosity = fromFlag (hscolourVerbosity flags)
1189     distPref = fromFlag (hscolourDistPref flags)
1190
1191     runHsColour prog outputDir moduleFiles = do
1192       createDirectoryIfMissingVerbose verbosity True outputDir
1193
1194       case stylesheet of -- copy the CSS file
1195         Nothing
1196           | programVersion prog >= Just (mkVersion [1, 9]) ->
1197               runProgram
1198                 verbosity
1199                 prog
1200                 ["-print-css", "-o" ++ outputDir </> "hscolour.css"]
1201           | otherwise -> return ()
1202         Just s -> copyFileVerbose verbosity s (outputDir </> "hscolour.css")
1203
1204       for_ moduleFiles $ \(m, inFile) ->
1205         runProgram
1206           verbosity
1207           prog
1208           ["-css", "-anchor", "-o" ++ outFile m, inFile]
1209       where
1210         outFile m =
1211           outputDir
1212             </> intercalate "-" (ModuleName.components m) <.> "html"
1213
1214 haddockToHscolour :: HaddockFlags -> HscolourFlags
1215 haddockToHscolour flags =
1216   HscolourFlags
1217     { hscolourCSS = haddockHscolourCss flags
1218     , hscolourExecutables = haddockExecutables flags
1219     , hscolourTestSuites = haddockTestSuites flags
1220     , hscolourBenchmarks = haddockBenchmarks flags
1221     , hscolourForeignLibs = haddockForeignLibs flags
1222     , hscolourVerbosity = haddockVerbosity flags
1223     , hscolourDistPref = haddockDistPref flags
1224     , hscolourCabalFilePath = haddockCabalFilePath flags
1225     }
1226
1227 -- ------------------------------------------------------------------------------
1228 -- Boilerplate Monoid instance.
1229 instance Monoid HaddockArgs where
1230   mempty = gmempty
1231   mappend = (<>)
1232
1233 instance Semigroup HaddockArgs where
1234   (<>) = gmappend
1235
1236 instance Monoid Directory where
1237   mempty = Dir "."
1238   mappend = (<>)
1239
1240 instance Semigroup Directory where
1241   Dir m <> Dir n = Dir $ m </> n