1 files changed, 210 insertions, 0 deletions
diff --git a/hadrian/src/Rules/Documentation.hs b/hadrian/src/Rules/Documentation.hs
new file mode 100644
index 0000000000..92b5ff5476
--- /dev/null
+++ b/hadrian/src/Rules/Documentation.hs
@@ -0,0 +1,210 @@
+module Rules.Documentation (
+    -- * Rules
+    buildPackageDocumentation, documentationRules,
+
+    -- * Utilities
+    haddockDependencies
+    ) where
+
+import Hadrian.Haskell.Cabal
+import Hadrian.Haskell.Cabal.Type
+
+import Base
+import Context
+import Expression (getContextData, interpretInContext)
+import Flavour
+import Oracles.ModuleFiles
+import Packages
+import Settings
+import Target
+import Utilities
+
+docRoot :: FilePath
+docRoot = "docs"
+
+htmlRoot :: FilePath
+htmlRoot = docRoot -/- "html"
+
+pdfRoot :: FilePath
+pdfRoot = docRoot -/- "pdfs"
+
+archiveRoot :: FilePath
+archiveRoot = docRoot -/- "archives"
+
+haddockHtmlLib :: FilePath
+haddockHtmlLib = htmlRoot -/- "haddock-bundle.min.js"
+
+manPageBuildPath :: FilePath
+manPageBuildPath = "docs/users_guide/build-man/ghc.1"
+
+-- TODO: Get rid of this hack.
+docContext :: Context
+docContext = vanillaContext Stage2 (library "Documentation" "docs")
+
+docPaths :: [FilePath]
+docPaths = ["libraries", "users_guide", "Haddock"]
+
+pathPdf :: FilePath -> FilePath
+pathPdf path = pdfRoot -/- path <.> ".pdf"
+
+pathIndex :: FilePath -> FilePath
+pathIndex path = htmlRoot -/- path -/- "index.html"
+
+pathArchive :: FilePath -> FilePath
+pathArchive path = archiveRoot -/- path <.> "html.tar.xz"
+
+-- TODO: Get rid of this hack.
+pathPath :: FilePath -> FilePath
+pathPath "users_guide" = "docs/users_guide"
+pathPath "Haddock" = "utils/haddock/doc"
+pathPath _ = ""
+
+-- | Build all documentation
+documentationRules :: Rules ()
+documentationRules = do
+    buildDocumentationArchives
+    buildHtmlDocumentation
+    buildManPage
+    buildPdfDocumentation
+
+    "docs" ~> do
+        root <- buildRoot
+        let html     = htmlRoot -/- "index.html"
+            archives = map pathArchive docPaths
+            pdfs     = map pathPdf $ docPaths \\ ["libraries"]
+        need $ map (root -/-) $ [html] ++ archives ++ pdfs
+        need [ root -/- htmlRoot -/- "libraries" -/- "gen_contents_index"
+             , root -/- htmlRoot -/- "libraries" -/- "prologue.txt"
+             , root -/- manPageBuildPath ]
+
+------------------------------------- HTML -------------------------------------
+
+-- | Build rules for HTML documentation.
+buildHtmlDocumentation :: Rules ()
+buildHtmlDocumentation = do
+    mapM_ buildSphinxHtml $ docPaths \\ ["libraries"]
+    buildLibraryDocumentation
+    root <- buildRootRules
+    root -/- htmlRoot -/- "libraries/gen_contents_index" %>
+        copyFile "libraries/gen_contents_index"
+
+    root -/- htmlRoot -/- "libraries/prologue.txt" %>
+        copyFile "libraries/prologue.txt"
+
+    root -/- htmlRoot -/- "index.html" %> \file -> do
+        need [root -/- haddockHtmlLib]
+        need $ map ((root -/-) . pathIndex) docPaths
+        copyFileUntracked "docs/index.html" file
+
+-- | Compile a Sphinx ReStructured Text package to HTML.
+buildSphinxHtml :: FilePath -> Rules ()
+buildSphinxHtml path = do
+    root <- buildRootRules
+    root -/- htmlRoot -/- path -/- "index.html" %> \file -> do
+        need [root -/- haddockHtmlLib]
+        let dest = takeDirectory file
+        build $ target docContext (Sphinx Html) [pathPath path] [dest]
+
+------------------------------------ Haddock -----------------------------------
+
+-- | Build the haddocks for GHC's libraries.
+buildLibraryDocumentation :: Rules ()
+buildLibraryDocumentation = do
+    root <- buildRootRules
+
+    -- Js and Css files for haddock output
+    root -/- haddockHtmlLib %> \_ ->
+        copyDirectory "utils/haddock/haddock-api/resources/html" (root -/- docRoot)
+
+    root -/- htmlRoot -/- "libraries/index.html" %> \file -> do
+        need [root -/- haddockHtmlLib]
+        haddocks <- allHaddocks
+        let libDocs = filter
+                (\x -> takeFileName x `notElem` ["ghc.haddock", "rts.haddock"])
+                haddocks
+        need (root -/- haddockHtmlLib : libDocs)
+        build $ target docContext (Haddock BuildIndex) libDocs [file]
+
+allHaddocks :: Action [FilePath]
+allHaddocks = do
+    pkgs <- stagePackages Stage1
+    sequence [ pkgHaddockFile $ vanillaContext Stage1 pkg
+             | pkg <- pkgs, isLibrary pkg ]
+
+-- Note: this build rule creates plenty of files, not just the .haddock one.
+-- All of them go into the 'docRoot' subdirectory. Pedantically tracking all
+-- built files in the Shake database seems fragile and unnecessary.
+buildPackageDocumentation :: Context -> Rules ()
+buildPackageDocumentation context@Context {..} = when (stage == Stage1 && package /= rts) $ do
+    root <- buildRootRules
+
+    -- Per-package haddocks
+    root -/- htmlRoot -/- "libraries" -/- pkgName package -/- "haddock-prologue.txt" %> \file -> do
+        need [root -/- haddockHtmlLib]
+        -- This is how @ghc-cabal@ used to produces "haddock-prologue.txt" files.
+        syn  <- pkgSynopsis    package
+        desc <- pkgDescription package
+        let prologue = if null desc then syn else desc
+        liftIO $ writeFile file prologue
+
+    root -/- htmlRoot -/- "libraries" -/- pkgName package -/- pkgName package <.> "haddock" %> \file -> do
+        need [root -/- htmlRoot -/- "libraries" -/- pkgName package -/- "haddock-prologue.txt"]
+        haddocks <- haddockDependencies context
+        srcs <- hsSources context
+        need $ srcs ++ haddocks ++ [root -/- haddockHtmlLib]
+
+        -- Build Haddock documentation
+        -- TODO: Pass the correct way from Rules via Context.
+        dynamicPrograms <- dynamicGhcPrograms =<< flavour
+        let haddockWay = if dynamicPrograms then dynamic else vanilla
+        build $ target (context {way = haddockWay}) (Haddock BuildPackage) srcs [file]
+
+-------------------------------------- PDF -------------------------------------
+
+-- | Build all PDF documentation
+buildPdfDocumentation :: Rules ()
+buildPdfDocumentation = mapM_ buildSphinxPdf docPaths
+
+-- | Compile a Sphinx ReStructured Text package to LaTeX
+buildSphinxPdf :: FilePath -> Rules ()
+buildSphinxPdf path = do
+    root <- buildRootRules
+    root -/- pdfRoot -/- path <.> "pdf" %> \file -> do
+        need [root -/- haddockHtmlLib]
+        withTempDir $ \dir -> do
+            build $ target docContext (Sphinx Latex) [pathPath path] [dir]
+            build $ target docContext Xelatex [path <.> "tex"] [dir]
+            copyFileUntracked (dir -/- path <.> "pdf") file
+
+------------------------------------ Archive -----------------------------------
+
+-- | Build documentation archives.
+buildDocumentationArchives :: Rules ()
+buildDocumentationArchives = mapM_ buildArchive docPaths
+
+buildArchive :: FilePath -> Rules ()
+buildArchive path = do
+    root <- buildRootRules
+    root -/- pathArchive path %> \file -> do
+        need [root -/- haddockHtmlLib]
+        root <- buildRoot
+        let src = root -/- pathIndex path
+        need [src]
+        build $ target docContext (Tar Create) [takeDirectory src] [file]
+
+-- | Build the man page.
+buildManPage :: Rules ()
+buildManPage = do
+    root <- buildRootRules
+    root -/- manPageBuildPath %> \file -> do
+        need [root -/- haddockHtmlLib, "docs/users_guide/ghc.rst"]
+        withTempDir $ \dir -> do
+            build $ target docContext (Sphinx Man) ["docs/users_guide"] [dir]
+            copyFileUntracked (dir -/- "ghc.1") file
+
+-- | Find the Haddock files for the dependencies of the current library.
+haddockDependencies :: Context -> Action [FilePath]
+haddockDependencies context = do
+    depNames <- interpretInContext context (getContextData depNames)
+    sequence [ pkgHaddockFile $ vanillaContext Stage1 depPkg
+             | Just depPkg <- map findPackageByName depNames, depPkg /= rts ]