Commit 88190fe6 authored by Ross Paterson's avatar Ross Paterson
Browse files

rejig location of package interfaces for haddock

Formerly, setup haddock invoked haddock with a --use-package option
for each prerequisite package, causing haddock to invoke ghc-pkg to
get the haddock-interfaces and haddock-html fields for each package.
The former is accurate, but the latter is not what you want if your
documentation is to be placed on the web.

Now setup haddock invokes ghc-pkg itself, but if the --html-location
option is given, its argument is expanded for each package and used
instead of the haddock-html field.  The results are then assembed as
--read-interface options for haddock.  For example,

	setup haddock '--html-location=http://hackage.haskell.org/packages/archive/$pkg/latest/doc/html'

generates HTML documentation with hyperlinks pointing at the pages on
HackageDB.
parent d59bce86
......@@ -142,8 +142,7 @@ data ConfigFlags = ConfigFlags {
configVerbose :: Verbosity, -- ^verbosity level
configUser :: Bool, -- ^ the --user flag?
configGHCiLib :: Bool, -- ^Enable compiling library for GHCi
configSplitObjs :: Bool, -- ^Enable -split-objs with GHC
configHaddockUsePackages :: Bool -- ^ auto-gen haddock --use-package
configSplitObjs :: Bool -- ^Enable -split-objs with GHC
}
deriving Show
......@@ -176,8 +175,7 @@ emptyConfigFlags progConf = ConfigFlags {
configVerbose = normal,
configUser = False,
configGHCiLib = True,
configSplitObjs = False, -- takes longer, so turn off by default
configHaddockUsePackages = True
configSplitObjs = False -- takes longer, so turn off by default
}
-- | Flags to @copy@: (destdir, copy-prefix (backwards compat), verbosity)
......@@ -239,11 +237,13 @@ emptyRegisterFlags = RegisterFlags { regUser = MaybeUserNone,
regVerbose = normal }
data HaddockFlags = HaddockFlags {haddockHoogle :: Bool
,haddockHtmlLocation :: Maybe String
,haddockVerbose :: Verbosity}
deriving Show
emptyHaddockFlags :: HaddockFlags
emptyHaddockFlags = HaddockFlags {haddockHoogle = False
,haddockHtmlLocation = Nothing
,haddockVerbose = normal}
data CleanFlags = CleanFlags {cleanSaveConf :: Bool
......@@ -287,7 +287,6 @@ data Flag a = GhcFlag | NhcFlag | HugsFlag | JhcFlag
| LibExecDir FilePath
| DataDir FilePath
| DataSubDir FilePath
| WithHaddockUsePackages | WithoutHaddockUsePackages
| ProgramArgs String String -- program name, arguments
| WithProgram String FilePath -- program name, location
......@@ -304,6 +303,7 @@ data Flag a = GhcFlag | NhcFlag | HugsFlag | JhcFlag
| Snapshot
-- For haddock:
| HaddockHoogle
| HaddockHtmlLocation String
-- For clean:
| SaveConfigure -- ^don't delete .setup-config during clean
-- For makefile:
......@@ -515,11 +515,7 @@ configureCmd progConf = Cmd {
Option "" ["user"] (NoArg UserFlag)
"allow dependencies to be satisfied from the user package database. also implies install --user",
Option "" ["global"] (NoArg GlobalFlag)
"(default) dependencies must be satisfied from the global package database",
Option "" ["enable-haddock-use-packages"] (NoArg WithHaddockUsePackages)
"Automatically pass --use-library flags to haddock.",
Option "" ["disable-haddock-use-packages"] (NoArg WithoutHaddockUsePackages)
"Don't automatically pass --use-library flags to haddock. Instead, you might use --haddock-args with --read-interface to get web links to your dependent library docs."
"(default) dependencies must be satisfied from the global package database"
]
{-
FIX: Instead of using ++ here, we might add extra arguments. That
......@@ -595,8 +591,6 @@ parseConfigureArgs progConf = parseArgs (configureCmd progConf) updateCfg
updateCfg t GlobalFlag = t { configUser = False }
updateCfg t WithSplitObjs = t { configSplitObjs = True }
updateCfg t WithoutSplitObjs = t { configSplitObjs = False }
updateCfg t WithHaddockUsePackages = t { configHaddockUsePackages = True }
updateCfg t WithoutHaddockUsePackages = t { configHaddockUsePackages = False }
updateCfg t (Lift _) = t
updateCfg _ _ = error $ "Unexpected flag!"
......@@ -637,15 +631,17 @@ haddockCmd = Cmd {
cmdHelp = "Generate Haddock HTML code from Exposed-Modules.",
cmdDescription = "Requires cpphs and haddock.",
cmdOptions = [cmd_help, cmd_verbose,
Option "" ["hoogle"] (NoArg HaddockHoogle) "Generate a hoogle database"],
Option "" ["hoogle"] (NoArg HaddockHoogle) "Generate a hoogle database",
Option "" ["html-location"] (ReqArg HaddockHtmlLocation "URL") "Location of HTML documentation for pre-requisite packages"],
cmdAction = HaddockCmd
}
parseHaddockArgs :: HaddockFlags -> [String] -> [OptDescr a] -> IO (HaddockFlags, [a], [String])
parseHaddockArgs = parseArgs haddockCmd updateCfg
where updateCfg (HaddockFlags hoogle verbosity) fl = case fl of
HaddockHoogle -> HaddockFlags True verbosity
Verbose n -> HaddockFlags hoogle n
where updateCfg hflags fl = case fl of
HaddockHoogle -> hflags{haddockHoogle=True}
HaddockHtmlLocation s -> hflags{haddockHtmlLocation=Just s}
Verbose n -> hflags{haddockVerbose=n}
_ -> error "Unexpected flag!"
programaticaCmd :: Cmd a
......
......@@ -90,13 +90,13 @@ import Distribution.Simple.Configure(getPersistBuildConfig, maybeGetPersistBuild
haddockVersion)
import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..), distPref,
srcPref, haddockPref )
srcPref, haddockPref, substDir )
import Distribution.Simple.Install(install)
import Distribution.Simple.Utils (die, currentDir,
defaultPackageDesc, defaultHookedPackageDesc,
moduleToFilePath, findFile, warn)
import Distribution.Simple.Utils (rawSystemPathExit)
import Distribution.Simple.Utils (rawSystemPathExit, rawSystemStdout)
import Distribution.Verbosity
import Language.Haskell.Extension
-- Base
......@@ -105,7 +105,7 @@ import System.Exit(ExitCode(..), exitWith)
import System.Directory(removeFile, doesFileExist, doesDirectoryExist)
import Distribution.License
import Control.Monad(when, unless)
import Control.Monad(liftM, when, unless)
import Data.List ( intersperse, unionBy )
import System.IO.Error (try)
import System.IO ( hPutStrLn, stderr )
......@@ -389,7 +389,7 @@ getModulePaths bi =
-- Haddock support
haddock :: PackageDescription -> LocalBuildInfo -> UserHooks -> HaddockFlags -> IO ()
haddock pkg_descr lbi hooks (HaddockFlags hoogle verbosity) = do
haddock pkg_descr lbi hooks (HaddockFlags hoogle html_loc verbosity) = do
let pps = allSuffixHandlers hooks
confHaddock <- do let programConf = withPrograms lbi
let haddockPath = programName haddockProgram
......@@ -406,7 +406,6 @@ haddock pkg_descr lbi hooks (HaddockFlags hoogle verbosity) = do
let replaceLitExts = map (joinFileName tmpDir . flip changeFileExt "hs")
let mockAll bi = mapM_ (mockPP ["-D__HADDOCK__"] bi tmpDir)
let showPkg = showPackageId (package pkg_descr)
let showDepPkgs = map showPackageId (packageDeps lbi)
let outputFlag = if hoogle then "--hoogle" else "--html"
have_new_flags <- fmap (> Version [0,8] []) (haddockVersion verbosity lbi)
let ghcpkgFlags = if have_new_flags
......@@ -416,6 +415,21 @@ haddock pkg_descr lbi hooks (HaddockFlags hoogle verbosity) = do
then ["--allow-missing-html"]
else []
let pkgTool = compilerPkgTool (compiler lbi)
let getField pkgId f = do
let name = showPackageId pkgId
s <- rawSystemStdout verbose pkgTool ["field", name, f]
return $ case words s of
_:v:_ -> v
[] -> []
let makeReadInterface pkgId = do
interface <- getField pkgId "haddock-interfaces"
html <- case html_loc of
Nothing -> getField pkgId "haddock-html"
Just htmlTemplate -> return (substDir pkgId lbi htmlTemplate)
return $ "--read-interface=" ++ html ++ "," ++ interface
packageFlags <- mapM makeReadInterface (packageDeps lbi)
withLib pkg_descr () $ \lib -> do
let bi = libBuildInfo lib
inFiles <- getModulePaths bi (exposedModules lib ++ otherModules bi)
......@@ -435,9 +449,7 @@ haddock pkg_descr lbi hooks (HaddockFlags hoogle verbosity) = do
"--prologue=" ++ prologName]
++ ghcpkgFlags
++ allowMissingHtmlFlags
++ (if haddockUsePackages lbi
then map ("--use-package=" ++) showDepPkgs
else [])
++ packageFlags
++ programArgs confHaddock
++ (if verbosity >= deafening then ["--verbose"] else [])
++ outFiles
......@@ -459,9 +471,7 @@ haddock pkg_descr lbi hooks (HaddockFlags hoogle verbosity) = do
"--title=" ++ exeName exe]
++ ghcpkgFlags
++ allowMissingHtmlFlags
++ (if haddockUsePackages lbi
then map ("--use-package=" ++) showDepPkgs
else [])
++ packageFlags
++ programArgs confHaddock
++ (if verbosity >= deafening then ["--verbose"] else [])
++ outFiles
......
......@@ -238,8 +238,7 @@ configure pkg_descr cfg
withOptimization=configOptimization cfg,
withGHCiLib=configGHCiLib cfg,
splitObjs=split_objs,
userConf=configUser cfg,
haddockUsePackages=configHaddockUsePackages cfg
userConf=configUser cfg
}
-- FIXME: maybe this should only be printed when verbose?
......
......@@ -65,6 +65,7 @@ import Distribution.PackageDescription (PackageDescription(..))
import Distribution.Package (PackageIdentifier(..), showPackageId)
import Distribution.Compiler (Compiler(..), CompilerFlavor(..), showCompilerId)
import Distribution.Setup (CopyDest(..))
import Distribution.Version (showVersion)
import Distribution.Compat.FilePath
#if mingw32_HOST_OS || mingw32_TARGET_OS
import Data.Maybe (fromMaybe)
......@@ -117,8 +118,7 @@ data LocalBuildInfo = LocalBuildInfo {
withProfExe :: Bool, -- ^Whether to build executables for profiling.
withOptimization :: Bool, -- ^Whether to build with optimization (if available).
withGHCiLib :: Bool, -- ^Whether to build libs suitable for use with GHCi.
splitObjs :: Bool, -- ^Use -split-objs with GHC, if available
haddockUsePackages :: Bool -- ^Auto-gen --use-package for haddock
splitObjs :: Bool -- ^Use -split-objs with GHC, if available
} deriving (Read, Show)
......@@ -311,8 +311,8 @@ prefixRelPath :: PackageDescription -> LocalBuildInfo -> CopyDest -> FilePath
-> Maybe FilePath
prefixRelPath pkg_descr lbi0 copydest ('$':'p':'r':'e':'f':'i':'x':s) = Just $
case s of
(c:s') | isPathSeparator c -> substDir pkg_descr lbi s'
_ -> substDir pkg_descr lbi s
(c:s') | isPathSeparator c -> substDir (package pkg_descr) lbi s'
_ -> substDir (package pkg_descr) lbi s
where
lbi = case copydest of
CopyPrefix d -> lbi0{prefix=d}
......@@ -323,12 +323,12 @@ absolutePath :: PackageDescription -> LocalBuildInfo -> CopyDest -> FilePath
-> FilePath
absolutePath pkg_descr lbi copydest s =
case copydest of
NoCopyDest -> substDir pkg_descr lbi s
CopyPrefix d -> substDir pkg_descr lbi{prefix=d} s
CopyTo p -> p `joinFileName` (dropAbsolutePrefix (substDir pkg_descr lbi s))
NoCopyDest -> substDir (package pkg_descr) lbi s
CopyPrefix d -> substDir (package pkg_descr) lbi{prefix=d} s
CopyTo p -> p `joinFileName` (dropAbsolutePrefix (substDir (package pkg_descr) lbi s))
substDir :: PackageDescription -> LocalBuildInfo -> String -> String
substDir pkg_descr lbi xs = loop xs
substDir :: PackageIdentifier -> LocalBuildInfo -> String -> String
substDir pkgId lbi xs = loop xs
where
loop "" = ""
loop ('$':'p':'r':'e':'f':'i':'x':s)
......@@ -336,11 +336,11 @@ substDir pkg_descr lbi xs = loop xs
loop ('$':'c':'o':'m':'p':'i':'l':'e':'r':s)
= showCompilerId (compiler lbi) ++ loop s
loop ('$':'p':'k':'g':'i':'d':s)
= showPackageId (package pkg_descr) ++ loop s
= showPackageId pkgId ++ loop s
loop ('$':'p':'k':'g':s)
= pkgName (package pkg_descr) ++ loop s
= pkgName pkgId ++ loop s
loop ('$':'v':'e':'r':'s':'i':'o':'n':s)
= show (pkgVersion (package pkg_descr)) ++ loop s
= showVersion (pkgVersion pkgId) ++ loop s
loop ('$':'$':s) = '$' : loop s
loop (c:s) = c : loop s
......@@ -13,6 +13,7 @@
<!ENTITY Greencard '<ulink url="http://www.haskell.org/greencard/"><command>greencard</command></ulink>'>
<!ENTITY Haddock '<ulink url="http://www.haskell.org/haddock/"><command>haddock</command></ulink>'>
<!ENTITY Happy '<ulink url="http://www.haskell.org/happy/"><command>happy</command></ulink>'>
<!ENTITY HackageDB '<ulink url="http://hackage.haskell.org/">HackageDB</ulink>'>
]>
<article>
......@@ -1752,7 +1753,7 @@ runhaskell Setup.hs build
<para>Build the interface documentation for a library using
&Haddock;.</para>
<para>This command takes the following option:</para>
<para>This command takes the following options:</para>
<variablelist>
<varlistentry>
......@@ -1767,6 +1768,25 @@ runhaskell Setup.hs build
</para>
</listitem>
</varlistentry>
<varlistentry>
<term><option>--html-location</option>=<replaceable>url</replaceable></term>
<listitem>
<para>Specify a template for the location of HTML documentation
for pre-requisite packages. The substitutions listed in
<xref linkend="simple-paths"/> are applied to the template
to obtain a location for each package, which will be used
by hyperlinks in the generated documentation. For example,
the following command generates links pointing at &HackageDB;
pages:</para>
<screen>setup haddock --html-location='http://hackage.haskell.org/packages/archive/$pkg/latest/doc/html'</screen>
<para>Here the argument is quoted to prevent substitution
by the shell.</para>
<para>If this option is omitted, the location for each package
is obtained using the package tool (e.g.
<command>ghc-pkg</command>).</para>
</listitem>
</varlistentry>
</variablelist>
</sect2>
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment