module Distribution.Simple.Haddock (
haddock, hscolour
) where
import Distribution.Package
( PackageIdentifier, Package(..), packageName )
import qualified Distribution.ModuleName as ModuleName
import Distribution.PackageDescription as PD
( PackageDescription(..), BuildInfo(..), allExtensions
, Library(..), hasLibs, Executable(..), Component(..) )
import Distribution.Simple.Compiler
( Compiler(..), compilerVersion )
import Distribution.Simple.GHC ( ghcLibDir )
import Distribution.Simple.Program
( ConfiguredProgram(..), requireProgramVersion
, rawSystemProgram, rawSystemProgramStdout
, hscolourProgram, haddockProgram )
import Distribution.Simple.PreProcess (ppCpp', ppUnlit
, PPSuffixHandler, runSimplePreProcessor
, preprocessComponent)
import Distribution.Simple.Setup
( defaultHscolourFlags, Flag(..), flagToMaybe, fromFlag
, HaddockFlags(..), HscolourFlags(..) )
import Distribution.Simple.Build (initialBuildSteps)
import Distribution.Simple.InstallDirs (InstallDirs(..), PathTemplate,
PathTemplateVariable(..),
toPathTemplate, fromPathTemplate,
substPathTemplate,
initialPathTemplateEnv)
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), externalPackageDeps
, ComponentLocalBuildInfo(..), withComponentsLBI )
import Distribution.Simple.BuildPaths ( haddockName,
hscolourPref, autogenModulesDir,
)
import Distribution.Simple.PackageIndex (dependencyClosure)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
( InstalledPackageInfo_(..) )
import Distribution.InstalledPackageInfo
( InstalledPackageInfo )
import Distribution.Simple.Utils
( die, warn, notice, intercalate, setupMessage
, createDirectoryIfMissingVerbose, withTempFile, copyFileVerbose
, withTempDirectory
, findFileWithExtension, findFile )
import Distribution.Simple.GHC (ghcOptions)
import Distribution.Text
( display, simpleParse )
import Distribution.Verbosity
import Language.Haskell.Extension
import System.Directory(removeFile, doesFileExist, createDirectoryIfMissing)
import Control.Monad ( when, guard )
import Control.Exception (assert)
import Data.Monoid
import Data.Maybe ( fromMaybe, listToMaybe )
import System.FilePath((</>), (<.>), splitFileName, splitExtension,
normalise, splitPath, joinPath)
import System.IO (hClose, hPutStrLn)
import Distribution.Version
data argInterfaces :: [(FilePath, Maybe FilePath)]HaddockArgs = HaddockArgs {
argInterfaceFile :: Flag FilePath,
argPackageName :: Flag PackageIdentifier,
argHideModules :: (All,[ModuleName.ModuleName]),
argIgnoreExports :: Any,
argLinkSource :: Flag (Template,Template),
argCssFile :: Flag FilePath,
argVerbose :: Any,
argOutput :: Flag [Output],
argInterfaces :: [(FilePath, Maybe FilePath)],
argOutputDir :: Directory,
argTitle :: Flag String,
argPrologue :: Flag String,
argGhcFlags :: [String],
argGhcLibDir :: Flag FilePath,
argTargets :: [FilePath]
}
newtype unDir' :: FilePathDirectory = Dir { unDir' :: FilePath } deriving (D:Read ::
(Int -> ReadS a)
-> ReadS [a]
-> ReadPrec a
-> ReadPrec [a]
-> T:Read aRead,D:Show ::
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> T:Show aShow,D:Eq :: (a -> a -> Bool) -> (a -> a -> Bool) -> T:Eq aEq,D:Ord ::
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> T:Ord aOrd)
unDir :: Directory -> FilePath
unDir = joinPath :: [FilePath] -> FilePathjoinPath (.) :: (b -> c) -> (a -> b) -> a -> c. filter :: (a -> Bool) -> [a] -> [a]filter (\p -> p :: FilePathp (/=) :: Eq a => a -> a -> Bool/="./" (&&) :: Bool -> Bool -> Bool&& p :: FilePathp (/=) :: Eq a => a -> a -> Bool/= ".") (.) :: (b -> c) -> (a -> b) -> a -> c. splitPath :: FilePath -> [FilePath]splitPath (.) :: (b -> c) -> (a -> b) -> a -> c. unDir' :: Directory -> FilePathunDir'
type Template = String
data Output = Html | Hoogle | Annot
annotName :: FilePath
annotName = "annot.txt"
haddock :: PackageDescription -> LocalBuildInfo -> [PPSuffixHandler] -> HaddockFlags -> IO ()
haddock pkg_descr _ _ haddockFlags
| not :: Bool -> Boolnot (hasLibs :: PackageDescription -> BoolhasLibs pkg_descr :: PackageDescriptionpkg_descr)
(&&) :: Bool -> Bool -> Bool&& not :: Bool -> Boolnot (fromFlag :: Flag a -> afromFlag ($) :: (a -> b) -> a -> b$ haddockExecutables :: HaddockFlags -> Flag BoolhaddockExecutables haddockFlags :: HaddockFlagshaddockFlags) =
warn :: Verbosity -> String -> IO ()warn (fromFlag :: Flag a -> afromFlag ($) :: (a -> b) -> a -> b$ haddockVerbosity :: HaddockFlags -> Flag VerbosityhaddockVerbosity haddockFlags :: HaddockFlagshaddockFlags) ($) :: (a -> b) -> a -> b$
"No documentation was generated as this package does not contain "
(++) :: [a] -> [a] -> [a]++ "a library. Perhaps you want to use the --executables flag."
haddock pkg_descr lbi suffixes flags = do
setupMessage :: Verbosity -> String -> PackageIdentifier -> IO ()setupMessage verbosity :: Verbosityverbosity "Running Haddock for" (packageId :: Package pkg => pkg -> PackageIdentifierpackageId pkg_descr :: PackageDescriptionpkg_descr)
(confHaddock, version, _) <-
requireProgramVersion ::
Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)requireProgramVersion verbosity :: Verbosityverbosity haddockProgram :: ProgramhaddockProgram
(orLaterVersion :: Version -> VersionRangeorLaterVersion (Version :: [Int] -> [String] -> VersionVersion [0,6] [] :: [a][])) (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
let isVersion2 = version :: Versionversion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [2,0] [] :: [a][]
when :: Monad m => Bool -> m () -> m ()when ( flag :: (HaddockFlags -> Flag a) -> aflag haddockHoogle :: HaddockFlags -> Flag BoolhaddockHoogle
(&&) :: Bool -> Bool -> Bool&& version :: Versionversion (>) :: Ord a => a -> a -> Bool> Version :: [Int] -> [String] -> VersionVersion [2] [] :: [a][]
(&&) :: Bool -> Bool -> Bool&& version :: Versionversion (<) :: Ord a => a -> a -> Bool< Version :: [Int] -> [String] -> VersionVersion [2,2] [] :: [a][]) ($) :: (a -> b) -> a -> b$
die :: String -> IO adie "haddock 2.0 and 2.1 do not support the --hoogle flag."
when :: Monad m => Bool -> m () -> m ()when (flag :: (HaddockFlags -> Flag a) -> aflag haddockHscolour :: HaddockFlags -> Flag BoolhaddockHscolour (&&) :: Bool -> Bool -> Bool&& version :: Versionversion (<) :: Ord a => a -> a -> Bool< Version :: [Int] -> [String] -> VersionVersion [0,8] [] :: [a][]) ($) :: (a -> b) -> a -> b$
die :: String -> IO adie "haddock --hyperlink-source requires Haddock version 0.8 or later"
when :: Monad m => Bool -> m () -> m ()when isVersion2 :: BoolisVersion2 ($) :: (a -> b) -> a -> b$ do
haddockGhcVersionStr <- rawSystemProgramStdout ::
Verbosity -> ConfiguredProgram -> [ProgArg] -> IO StringrawSystemProgramStdout verbosity :: Verbosityverbosity confHaddock :: ConfiguredProgramconfHaddock
["--ghc-version"]
case simpleParse :: Text a => String -> Maybe asimpleParse haddockGhcVersionStr :: StringhaddockGhcVersionStr of
Nothing -> die :: String -> IO adie "Could not get GHC version from Haddock"
Just haddockGhcVersion
| haddockGhcVersion :: VersionhaddockGhcVersion (==) :: Eq a => a -> a -> Bool== ghcVersion :: VersionghcVersion -> return :: Monad m => forall a. a -> m areturn ()
| otherwise :: Boolotherwise -> die :: String -> IO adie ($) :: (a -> b) -> a -> b$
"Haddock's internal GHC version must match the configured "
(++) :: [a] -> [a] -> [a]++ "GHC version.\n"
(++) :: [a] -> [a] -> [a]++ "The GHC version is " (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay ghcVersion :: VersionghcVersion (++) :: [a] -> [a] -> [a]++ " but "
(++) :: [a] -> [a] -> [a]++ "haddock is using GHC version " (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay haddockGhcVersion :: VersionhaddockGhcVersion
where ghcVersion = compilerVersion :: Compiler -> VersioncompilerVersion (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi)
initialBuildSteps ::
FilePath
-> PackageDescription
-> LocalBuildInfo
-> Verbosity
-> IO ()initialBuildSteps (flag :: (HaddockFlags -> Flag a) -> aflag haddockDistPref :: HaddockFlags -> Flag FilePathhaddockDistPref) pkg_descr :: PackageDescriptionpkg_descr lbi :: LocalBuildInfolbi verbosity :: Verbosityverbosity
args <- fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap mconcat :: Monoid a => [a] -> amconcat (.) :: (b -> c) -> (a -> b) -> a -> c. sequence :: Monad m => [m a] -> m [a]sequence ($) :: (a -> b) -> a -> b$
[ getInterfaces ::
Verbosity -> LocalBuildInfo -> Maybe String -> IO HaddockArgsgetInterfaces verbosity :: Verbosityverbosity lbi :: LocalBuildInfolbi (flagToMaybe :: Flag a -> Maybe aflagToMaybe (haddockHtmlLocation :: HaddockFlags -> Flag StringhaddockHtmlLocation flags :: HaddockFlagsflags))
, getGhcLibDir ::
Verbosity -> LocalBuildInfo -> Bool -> IO HaddockArgsgetGhcLibDir verbosity :: Verbosityverbosity lbi :: LocalBuildInfolbi isVersion2 :: BoolisVersion2 ]
(++) :: [a] -> [a] -> [a]++ map :: (a -> b) -> [a] -> [b]map return :: Monad m => forall a. a -> m areturn
[ fromFlags :: HaddockFlags -> HaddockArgsfromFlags flags :: HaddockFlagsflags
, fromPackageDescription :: PackageDescription -> HaddockArgsfromPackageDescription pkg_descr :: PackageDescriptionpkg_descr ]
let pre c = preprocessComponent ::
PackageDescription
-> Component
-> LocalBuildInfo
-> Bool
-> Verbosity
-> [PPSuffixHandler]
-> IO ()preprocessComponent pkg_descr :: PackageDescriptionpkg_descr c :: Componentc lbi :: LocalBuildInfolbi False :: BoolFalse verbosity :: Verbosityverbosity suffixes :: [PPSuffixHandler]suffixes
withComponentsLBI ::
LocalBuildInfo
-> (Component -> ComponentLocalBuildInfo -> IO ())
-> IO ()withComponentsLBI lbi :: LocalBuildInfolbi ($) :: (a -> b) -> a -> b$ \comp clbi -> do
pre :: Component -> IO ()pre comp :: Componentcomp
case comp :: Componentcomp of
CLib lib -> do
withTempDirectory ::
Verbosity -> FilePath -> String -> (FilePath -> IO a) -> IO awithTempDirectory verbosity :: Verbosityverbosity (buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi) "tmp" ($) :: (a -> b) -> a -> b$ \tmp -> do
let bi = libBuildInfo :: Library -> BuildInfolibBuildInfo lib :: Librarylib
libArgs <- fromLibrary ::
FilePath
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO HaddockArgsfromLibrary tmp :: FilePathtmp lbi :: LocalBuildInfolbi lib :: Librarylib clbi :: ComponentLocalBuildInfoclbi
libArgs' <- prepareSources ::
Verbosity
-> FilePath
-> LocalBuildInfo
-> Bool
-> BuildInfo
-> HaddockArgs
-> IO HaddockArgsprepareSources verbosity :: Verbosityverbosity tmp :: FilePathtmp
lbi :: LocalBuildInfolbi isVersion2 :: BoolisVersion2 bi :: BuildInfobi (args :: HaddockArgsargs mappend :: Monoid a => a -> a -> a`mappend` libArgs :: HaddockArgslibArgs)
runHaddock ::
Verbosity -> ConfiguredProgram -> HaddockArgs -> IO ()runHaddock verbosity :: Verbosityverbosity confHaddock :: ConfiguredProgramconfHaddock libArgs' :: HaddockArgslibArgs'
CExe exe -> when :: Monad m => Bool -> m () -> m ()when (flag :: (HaddockFlags -> Flag a) -> aflag haddockExecutables :: HaddockFlags -> Flag BoolhaddockExecutables) ($) :: (a -> b) -> a -> b$ do
withTempDirectory ::
Verbosity -> FilePath -> String -> (FilePath -> IO a) -> IO awithTempDirectory verbosity :: Verbosityverbosity (buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi) "tmp" ($) :: (a -> b) -> a -> b$ \tmp -> do
let bi = buildInfo :: Executable -> BuildInfobuildInfo exe :: Executableexe
exeArgs <- fromExecutable ::
FilePath
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO HaddockArgsfromExecutable tmp :: FilePathtmp lbi :: LocalBuildInfolbi exe :: Executableexe clbi :: ComponentLocalBuildInfoclbi
exeArgs' <- prepareSources ::
Verbosity
-> FilePath
-> LocalBuildInfo
-> Bool
-> BuildInfo
-> HaddockArgs
-> IO HaddockArgsprepareSources verbosity :: Verbosityverbosity tmp :: FilePathtmp
lbi :: LocalBuildInfolbi isVersion2 :: BoolisVersion2 bi :: BuildInfobi (args :: HaddockArgsargs mappend :: Monoid a => a -> a -> a`mappend` exeArgs :: HaddockArgsexeArgs)
runHaddock ::
Verbosity -> ConfiguredProgram -> HaddockArgs -> IO ()runHaddock verbosity :: Verbosityverbosity confHaddock :: ConfiguredProgramconfHaddock exeArgs' :: HaddockArgsexeArgs'
_ -> return :: Monad m => forall a. a -> m areturn ()
when :: Monad m => Bool -> m () -> m ()when (flag :: (HaddockFlags -> Flag a) -> aflag haddockHscolour :: HaddockFlags -> Flag BoolhaddockHscolour) ($) :: (a -> b) -> a -> b$ hscolour' ::
PackageDescription
-> LocalBuildInfo
-> [PPSuffixHandler]
-> HscolourFlags
-> IO ()hscolour' pkg_descr :: PackageDescriptionpkg_descr lbi :: LocalBuildInfolbi suffixes :: [PPSuffixHandler]suffixes ($) :: (a -> b) -> a -> b$
defaultHscolourFlags :: HscolourFlagsdefaultHscolourFlags mappend :: Monoid a => a -> a -> a`mappend` haddockToHscolour ::
PackageDescription -> HaddockFlags -> HscolourFlagshaddockToHscolour pkg_descr :: PackageDescriptionpkg_descr flags :: HaddockFlagsflags
where
verbosity = flag :: (HaddockFlags -> Flag a) -> aflag haddockVerbosity :: HaddockFlags -> Flag VerbosityhaddockVerbosity
flag f = fromFlag :: Flag a -> afromFlag ($) :: (a -> b) -> a -> b$ f :: HaddockArgs -> af flags :: HaddockFlagsflags
prepareSources :: Verbosity
-> FilePath
-> LocalBuildInfo
-> Bool
-> BuildInfo
-> HaddockArgs
-> IO HaddockArgs
prepareSources verbosity tmp lbi isVersion2 bi args@HaddockArgs{argTargets=files} =
mapM :: Monad m => (a -> m b) -> [a] -> m [b]mapM (mockPP :: FilePath -> FilePath -> IO FilePathmockPP tmp :: FilePathtmp) files :: [FilePath]files (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= \targets -> return :: Monad m => forall a. a -> m areturn args :: HaddockArgsargs {argTargets=targets :: [FilePath]targets}
where
mockPP pref file = do
let (filePref, fileName) = splitFileName :: FilePath -> (String, String)splitFileName file :: FilePathfile
targetDir = pref :: FilePathpref (</>) :: FilePath -> FilePath -> FilePath</> filePref :: StringfilePref
targetFile = targetDir :: FilePathtargetDir (</>) :: FilePath -> FilePath -> FilePath</> fileName :: StringfileName
(targetFileNoext, targetFileExt) = splitExtension :: FilePath -> (String, String)splitExtension ($) :: (a -> b) -> a -> b$ targetFile :: FilePathtargetFile
hsFile = targetFileNoext :: StringtargetFileNoext (<.>) :: FilePath -> String -> FilePath<.> "hs"
assertError :: Addr# -> Bool -> a -> aassert (targetFileExt :: StringtargetFileExt elem :: Eq a => a -> [a] -> Bool`elem` [".lhs",".hs"]) ($) :: (a -> b) -> a -> b$ return :: Monad m => forall a. a -> m areturn ()
createDirectoryIfMissing :: Bool -> FilePath -> IO ()createDirectoryIfMissing True :: BoolTrue targetDir :: FilePathtargetDir
if needsCpp :: BoolneedsCpp
then do
runSimplePreProcessor ::
PreProcessor -> FilePath -> FilePath -> Verbosity -> IO ()runSimplePreProcessor (ppCpp' :: [String] -> BuildInfo -> LocalBuildInfo -> PreProcessorppCpp' defines :: [[Char]]defines bi :: BuildInfobi lbi :: LocalBuildInfolbi)
file :: FilePathfile targetFile :: FilePathtargetFile verbosity :: Verbosityverbosity
else
copyFileVerbose :: Verbosity -> FilePath -> FilePath -> IO ()copyFileVerbose verbosity :: Verbosityverbosity file :: FilePathfile targetFile :: FilePathtargetFile
when :: Monad m => Bool -> m () -> m ()when (targetFileExt :: StringtargetFileExt (==) :: Eq a => a -> a -> Bool== ".lhs") ($) :: (a -> b) -> a -> b$ do
runSimplePreProcessor ::
PreProcessor -> FilePath -> FilePath -> Verbosity -> IO ()runSimplePreProcessor ppUnlit :: PreProcessorppUnlit targetFile :: FilePathtargetFile hsFile :: FilePathhsFile verbosity :: Verbosityverbosity
removeFile :: FilePath -> IO ()removeFile targetFile :: FilePathtargetFile
return :: Monad m => forall a. a -> m areturn hsFile :: FilePathhsFile
needsCpp = EnableExtension :: KnownExtension -> ExtensionEnableExtension CPP :: KnownExtensionCPP elem :: Eq a => a -> [a] -> Bool`elem` allExtensions :: BuildInfo -> [Extension]allExtensions bi :: BuildInfobi
defines | isVersion2 :: BoolisVersion2 = [] :: [a][]
| otherwise :: Boolotherwise = ["-D__HADDOCK__"]
fromFlags :: HaddockFlags -> HaddockArgs
fromFlags flags =
mempty :: Monoid a => amempty {
argHideModules = (maybe :: b -> (a -> b) -> Maybe a -> bmaybe mempty :: Monoid a => amempty (All :: Bool -> AllAll (.) :: (b -> c) -> (a -> b) -> a -> c. not :: Bool -> Boolnot) ($) :: (a -> b) -> a -> b$ flagToMaybe :: Flag a -> Maybe aflagToMaybe (haddockInternal :: HaddockFlags -> Flag BoolhaddockInternal flags :: HaddockFlagsflags), mempty :: Monoid a => amempty),
argLinkSource = if fromFlag :: Flag a -> afromFlag (haddockHscolour :: HaddockFlags -> Flag BoolhaddockHscolour flags :: HaddockFlagsflags)
then Flag :: a -> Flag aFlag ("src/%{MODULE/./-}.html"
,"src/%{MODULE/./-}.html#%{NAME}")
else NoFlag :: Flag aNoFlag,
argCssFile = haddockCss :: HaddockFlags -> Flag FilePathhaddockCss flags :: HaddockFlagsflags,
argVerbose = maybe :: b -> (a -> b) -> Maybe a -> bmaybe mempty :: Monoid a => amempty (Any :: Bool -> AnyAny (.) :: (b -> c) -> (a -> b) -> a -> c. ((>=) :: Ord a => a -> a -> Bool>= deafening :: Verbositydeafening)) (.) :: (b -> c) -> (a -> b) -> a -> c. flagToMaybe :: Flag a -> Maybe aflagToMaybe ($) :: (a -> b) -> a -> b$ haddockVerbosity :: HaddockFlags -> Flag VerbosityhaddockVerbosity flags :: HaddockFlagsflags,
argOutput =
Flag :: a -> Flag aFlag ($) :: (a -> b) -> a -> b$ case [ Html :: OutputHtml | Flag True <- [haddockHtml :: HaddockFlags -> Flag BoolhaddockHtml flags :: HaddockFlagsflags] ] (++) :: [a] -> [a] -> [a]++
[ Hoogle :: OutputHoogle | Flag True <- [haddockHoogle :: HaddockFlags -> Flag BoolhaddockHoogle flags :: HaddockFlagsflags] ] (++) :: [a] -> [a] -> [a]++
(if haddockAnnot :: HaddockFlags -> Flag BoolhaddockAnnot flags :: HaddockFlagsflags (==) :: Eq a => a -> a -> Bool== Flag :: a -> Flag aFlag True :: BoolTrue then [Annot :: OutputAnnot, Html :: OutputHtml] else [] :: [a][])
of [] -> [ Html :: OutputHtml ]
os -> os :: [Output]os,
argOutputDir = maybe :: b -> (a -> b) -> Maybe a -> bmaybe mempty :: Monoid a => amempty Dir :: FilePath -> DirectoryDir (.) :: (b -> c) -> (a -> b) -> a -> c. flagToMaybe :: Flag a -> Maybe aflagToMaybe ($) :: (a -> b) -> a -> b$ haddockDistPref :: HaddockFlags -> Flag FilePathhaddockDistPref flags :: HaddockFlagsflags
}
fromPackageDescription :: PackageDescription -> HaddockArgs
fromPackageDescription pkg_descr =
mempty :: Monoid a => amempty {
argInterfaceFile = Flag :: a -> Flag aFlag ($) :: (a -> b) -> a -> b$ haddockName :: PackageDescription -> FilePathhaddockName pkg_descr :: PackageDescriptionpkg_descr,
argPackageName = Flag :: a -> Flag aFlag ($) :: (a -> b) -> a -> b$ packageId :: Package pkg => pkg -> PackageIdentifierpackageId ($) :: (a -> b) -> a -> b$ pkg_descr :: PackageDescriptionpkg_descr,
argOutputDir = Dir :: FilePath -> DirectoryDir ($) :: (a -> b) -> a -> b$ "doc" (</>) :: FilePath -> FilePath -> FilePath</> "html" (</>) :: FilePath -> FilePath -> FilePath</> display :: Text a => a -> Stringdisplay (packageName :: Package pkg => pkg -> PackageNamepackageName pkg_descr :: PackageDescriptionpkg_descr),
argPrologue = Flag :: a -> Flag aFlag ($) :: (a -> b) -> a -> b$ if null :: [a] -> Boolnull desc :: Stringdesc then synopsis :: PackageDescription -> Stringsynopsis pkg_descr :: PackageDescriptionpkg_descr else desc :: Stringdesc,
argTitle = Flag :: a -> Flag aFlag ($) :: (a -> b) -> a -> b$ showPkg :: StringshowPkg (++) :: [a] -> [a] -> [a]++ subtitle :: [Char]subtitle
}
where
desc = description :: PackageDescription -> StringPD.description pkg_descr :: PackageDescriptionpkg_descr
showPkg = display :: Text a => a -> Stringdisplay (packageId :: Package pkg => pkg -> PackageIdentifierpackageId pkg_descr :: PackageDescriptionpkg_descr)
subtitle | null :: [a] -> Boolnull (synopsis :: PackageDescription -> Stringsynopsis pkg_descr :: PackageDescriptionpkg_descr) = ""
| otherwise :: Boolotherwise = ": " (++) :: [a] -> [a] -> [a]++ synopsis :: PackageDescription -> Stringsynopsis pkg_descr :: PackageDescriptionpkg_descr
fromLibrary :: FilePath
-> LocalBuildInfo -> Library -> ComponentLocalBuildInfo
-> IO HaddockArgs
fromLibrary tmp lbi lib clbi =
do inFiles <- map :: (a -> b) -> [a] -> [b]map snd :: (a, b) -> bsnd fmap :: Functor f => forall a b. (a -> b) -> f a -> f b`fmap` getLibSourceFiles ::
LocalBuildInfo -> Library -> IO [(ModuleName, FilePath)]getLibSourceFiles lbi :: LocalBuildInfolbi lib :: Librarylib
return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ mempty :: Monoid a => amempty {
argHideModules = (mempty :: Monoid a => amempty,otherModules :: BuildInfo -> [ModuleName]otherModules ($) :: (a -> b) -> a -> b$ bi :: BuildInfobi),
argGhcFlags = ghcOptions ::
LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> [String]ghcOptions lbi :: LocalBuildInfolbi bi :: BuildInfobi clbi :: ComponentLocalBuildInfoclbi (buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi)
(++) :: [a] -> [a] -> [a]++ [ "-odir", tmp :: FilePathtmp, "-hidir", tmp :: FilePathtmp
, "-stubdir", tmp :: FilePathtmp ],
argTargets = inFiles :: [FilePath]inFiles
}
where
bi = libBuildInfo :: Library -> BuildInfolibBuildInfo lib :: Librarylib
fromExecutable :: FilePath
-> LocalBuildInfo -> Executable -> ComponentLocalBuildInfo
-> IO HaddockArgs
fromExecutable tmp lbi exe clbi =
do inFiles <- map :: (a -> b) -> [a] -> [b]map snd :: (a, b) -> bsnd fmap :: Functor f => forall a b. (a -> b) -> f a -> f b`fmap` getExeSourceFiles ::
LocalBuildInfo -> Executable -> IO [(ModuleName, FilePath)]getExeSourceFiles lbi :: LocalBuildInfolbi exe :: Executableexe
return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ mempty :: Monoid a => amempty {
argGhcFlags = ghcOptions ::
LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> [String]ghcOptions lbi :: LocalBuildInfolbi bi :: BuildInfobi clbi :: ComponentLocalBuildInfoclbi (buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi)
(++) :: [a] -> [a] -> [a]++ [ "-odir", tmp :: FilePathtmp, "-hidir", tmp :: FilePathtmp
, "-stubdir", tmp :: FilePathtmp ],
argOutputDir = Dir :: FilePath -> DirectoryDir (exeName :: Executable -> StringexeName exe :: Executableexe),
argTitle = Flag :: a -> Flag aFlag (exeName :: Executable -> StringexeName exe :: Executableexe),
argTargets = inFiles :: [FilePath]inFiles
}
where
bi = buildInfo :: Executable -> BuildInfobuildInfo exe :: Executableexe
getInterfaces :: Verbosity
-> LocalBuildInfo
-> Maybe String
-> IO HaddockArgs
getInterfaces verbosity lbi location = do
let htmlTemplate = fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap toPathTemplate :: FilePath -> PathTemplatetoPathTemplate ($) :: (a -> b) -> a -> b$ location :: Maybe Stringlocation
(packageFlags, warnings) <- haddockPackageFlags ::
LocalBuildInfo
-> Maybe PathTemplate
-> IO ([(FilePath, Maybe FilePath)], Maybe String)haddockPackageFlags lbi :: LocalBuildInfolbi htmlTemplate :: Maybe PathTemplatehtmlTemplate
maybe :: b -> (a -> b) -> Maybe a -> bmaybe (return :: Monad m => forall a. a -> m areturn ()) (warn :: Verbosity -> String -> IO ()warn verbosity :: Verbosityverbosity) warnings :: Maybe Stringwarnings
return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ mempty :: Monoid a => amempty {
argInterfaces = packageFlags :: [(FilePath, Maybe FilePath)]packageFlags
}
getGhcLibDir :: Verbosity -> LocalBuildInfo
-> Bool
-> IO HaddockArgs
getGhcLibDir verbosity lbi isVersion2
| isVersion2 :: BoolisVersion2 =
do l <- ghcLibDir :: Verbosity -> LocalBuildInfo -> IO FilePathghcLibDir verbosity :: Verbosityverbosity lbi :: LocalBuildInfolbi
return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ mempty :: Monoid a => amempty { argGhcLibDir = Flag :: a -> Flag aFlag l :: [Char]l }
| otherwise :: Boolotherwise =
return :: Monad m => forall a. a -> m areturn mempty :: Monoid a => amempty
runHaddock :: Verbosity -> ConfiguredProgram -> HaddockArgs -> IO ()
runHaddock verbosity confHaddock args = do
let haddockVersion = fromMaybe :: a -> Maybe a -> afromMaybe (error :: [Char] -> aerror "unable to determine haddock version")
(programVersion :: ConfiguredProgram -> Maybe VersionprogramVersion confHaddock :: ConfiguredProgramconfHaddock)
renderArgs ::
Verbosity
-> Version
-> HaddockArgs
-> (([[Char]], FilePath) -> IO a)
-> IO arenderArgs verbosity :: Verbosityverbosity haddockVersion :: VersionhaddockVersion args :: HaddockArgsargs ($) :: (a -> b) -> a -> b$ \(flags,result)-> do
rawSystemProgram ::
Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ()rawSystemProgram verbosity :: Verbosityverbosity confHaddock :: ConfiguredProgramconfHaddock flags :: HaddockFlagsflags
notice :: Verbosity -> String -> IO ()notice verbosity :: Verbosityverbosity ($) :: (a -> b) -> a -> b$ "Documentation created: " (++) :: [a] -> [a] -> [a]++ result :: FilePathresult
renderArgs :: Verbosity
-> Version
-> HaddockArgs
-> (([[Char]], FilePath) -> IO a)
-> IO a
renderArgs verbosity version args k = do
createDirectoryIfMissingVerbose ::
Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue outputDir :: FilePathoutputDir
withTempFile ::
FilePath -> String -> (FilePath -> Handle -> IO a) -> IO awithTempFile outputDir :: FilePathoutputDir "haddock-prolog.txt" ($) :: (a -> b) -> a -> b$ \prologFileName h -> do
do
hPutStrLn :: Handle -> String -> IO ()hPutStrLn h :: Handleh ($) :: (a -> b) -> a -> b$ fromFlag :: Flag a -> afromFlag ($) :: (a -> b) -> a -> b$ argPrologue :: HaddockArgs -> Flag StringargPrologue args :: HaddockArgsargs
hClose :: Handle -> IO ()hClose h :: Handleh
let pflag = ((:) :: a -> [a] -> [a]:[] :: [a][])(.) :: (b -> c) -> (a -> b) -> a -> c.("--prologue="(++) :: [a] -> [a] -> [a]++) ($) :: (a -> b) -> a -> b$ prologFileName :: FilePathprologFileName
k :: ([[Char]], FilePath) -> IO ak ($) :: (a -> b) -> a -> b$ (pflag :: [[Char]]pflag (++) :: [a] -> [a] -> [a]++ renderPureArgs :: Version -> HaddockArgs -> [[Char]]renderPureArgs version :: Versionversion args :: HaddockArgsargs, result :: FilePathresult)
where
isVersion2 = version :: Versionversion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [2,0] [] :: [a][]
outputDir = (unDir :: Directory -> FilePathunDir ($) :: (a -> b) -> a -> b$ argOutputDir :: HaddockArgs -> DirectoryargOutputDir args :: HaddockArgsargs)
result = intercalate :: [a] -> [[a]] -> [a]intercalate ", "
(.) :: (b -> c) -> (a -> b) -> a -> c. map :: (a -> b) -> [a] -> [b]map (\o -> outputDir :: FilePathoutputDir (</>) :: FilePath -> FilePath -> FilePath</>
case o :: Outputo of
Html -> "index.html"
Hoogle -> pkgstr :: Stringpkgstr (<.>) :: FilePath -> String -> FilePath<.> "txt"
Annot -> annotName :: FilePathannotName)
($) :: (a -> b) -> a -> b$ arg :: (HaddockArgs -> Flag a) -> aarg argOutput :: HaddockArgs -> Flag [Output]argOutput
where
pkgstr | isVersion2 :: BoolisVersion2 = display :: Text a => a -> Stringdisplay ($) :: (a -> b) -> a -> b$ packageName :: Package pkg => pkg -> PackageNamepackageName pkgid :: PackageIdentifierpkgid
| otherwise :: Boolotherwise = display :: Text a => a -> Stringdisplay pkgid :: PackageIdentifierpkgid
pkgid = arg :: (HaddockArgs -> Flag a) -> aarg argPackageName :: HaddockArgs -> Flag PackageIdentifierargPackageName
arg f = fromFlag :: Flag a -> afromFlag ($) :: (a -> b) -> a -> b$ f :: HaddockArgs -> af args :: HaddockArgsargs
renderPureArgs :: Version -> HaddockArgs -> [[Char]]
renderPureArgs version args = concat :: [[a]] -> [a]concat
[
((:) :: a -> [a] -> [a]:[] :: [a][]) (.) :: (b -> c) -> (a -> b) -> a -> c. (\f -> "--dump-interface="(++) :: [a] -> [a] -> [a]++ unDir :: Directory -> FilePathunDir (argOutputDir :: HaddockArgs -> DirectoryargOutputDir args :: HaddockArgsargs) (</>) :: FilePath -> FilePath -> FilePath</> f :: HaddockArgs -> af)
(.) :: (b -> c) -> (a -> b) -> a -> c. fromFlag :: Flag a -> afromFlag (.) :: (b -> c) -> (a -> b) -> a -> c. argInterfaceFile :: HaddockArgs -> Flag FilePathargInterfaceFile ($) :: (a -> b) -> a -> b$ args :: HaddockArgsargs,
(\pkgName -> if isVersion2 :: BoolisVersion2
then ["--optghc=-package-name", "--optghc=" (++) :: [a] -> [a] -> [a]++ pkgName :: [Char]pkgName]
else ["--package=" (++) :: [a] -> [a] -> [a]++ pkgName :: [Char]pkgName]) (.) :: (b -> c) -> (a -> b) -> a -> c. display :: Text a => a -> Stringdisplay (.) :: (b -> c) -> (a -> b) -> a -> c. fromFlag :: Flag a -> afromFlag (.) :: (b -> c) -> (a -> b) -> a -> c. argPackageName :: HaddockArgs -> Flag PackageIdentifierargPackageName ($) :: (a -> b) -> a -> b$ args :: HaddockArgsargs,
(\(All b,xs) -> bool :: t -> t -> Bool -> tbool (map :: (a -> b) -> [a] -> [b]map (("--hide=" (++) :: [a] -> [a] -> [a]++)(.) :: (b -> c) -> (a -> b) -> a -> c. display :: Text a => a -> Stringdisplay) xs :: [ModuleName]xs) [] :: [a][] b :: HaddockArgsb) (.) :: (b -> c) -> (a -> b) -> a -> c. argHideModules :: HaddockArgs -> (All, [ModuleName])argHideModules ($) :: (a -> b) -> a -> b$ args :: HaddockArgsargs,
bool :: t -> t -> Bool -> tbool ["--ignore-all-exports"] [] :: [a][] (.) :: (b -> c) -> (a -> b) -> a -> c. getAny :: Any -> BoolgetAny (.) :: (b -> c) -> (a -> b) -> a -> c. argIgnoreExports :: HaddockArgs -> AnyargIgnoreExports ($) :: (a -> b) -> a -> b$ args :: HaddockArgsargs,
maybe :: b -> (a -> b) -> Maybe a -> bmaybe [] :: [a][] (\(m,e) -> ["--source-module=" (++) :: [a] -> [a] -> [a]++ m :: FilePathm
,"--source-entity=" (++) :: [a] -> [a] -> [a]++ e :: [Char]e]) (.) :: (b -> c) -> (a -> b) -> a -> c. flagToMaybe :: Flag a -> Maybe aflagToMaybe (.) :: (b -> c) -> (a -> b) -> a -> c. argLinkSource :: HaddockArgs -> Flag (Template, Template)argLinkSource ($) :: (a -> b) -> a -> b$ args :: HaddockArgsargs,
maybe :: b -> (a -> b) -> Maybe a -> bmaybe [] :: [a][] (((:) :: a -> [a] -> [a]:[] :: [a][])(.) :: (b -> c) -> (a -> b) -> a -> c.("--css="(++) :: [a] -> [a] -> [a]++)) (.) :: (b -> c) -> (a -> b) -> a -> c. flagToMaybe :: Flag a -> Maybe aflagToMaybe (.) :: (b -> c) -> (a -> b) -> a -> c. argCssFile :: HaddockArgs -> Flag FilePathargCssFile ($) :: (a -> b) -> a -> b$ args :: HaddockArgsargs,
bool :: t -> t -> Bool -> tbool [] :: [a][] [verbosityFlag :: [Char]verbosityFlag] (.) :: (b -> c) -> (a -> b) -> a -> c. getAny :: Any -> BoolgetAny (.) :: (b -> c) -> (a -> b) -> a -> c. argVerbose :: HaddockArgs -> AnyargVerbose ($) :: (a -> b) -> a -> b$ args :: HaddockArgsargs,
map :: (a -> b) -> [a] -> [b]map (\o -> case o :: Outputo of Hoogle -> "--hoogle"; Html -> "--html"; Annot -> ("--annot=" (++) :: [a] -> [a] -> [a]++ annotName :: FilePathannotName)) (.) :: (b -> c) -> (a -> b) -> a -> c. fromFlag :: Flag a -> afromFlag (.) :: (b -> c) -> (a -> b) -> a -> c. argOutput :: HaddockArgs -> Flag [Output]argOutput ($) :: (a -> b) -> a -> b$ args :: HaddockArgsargs,
renderInterfaces :: [([Char], Maybe [Char])] -> [[Char]]renderInterfaces (.) :: (b -> c) -> (a -> b) -> a -> c. argInterfaces :: HaddockArgs -> [(FilePath, Maybe FilePath)]argInterfaces ($) :: (a -> b) -> a -> b$ args :: HaddockArgsargs,
((:) :: a -> [a] -> [a]:[] :: [a][])(.) :: (b -> c) -> (a -> b) -> a -> c.("--odir="(++) :: [a] -> [a] -> [a]++) (.) :: (b -> c) -> (a -> b) -> a -> c. unDir :: Directory -> FilePathunDir (.) :: (b -> c) -> (a -> b) -> a -> c. argOutputDir :: HaddockArgs -> DirectoryargOutputDir ($) :: (a -> b) -> a -> b$ args :: HaddockArgsargs,
((:) :: a -> [a] -> [a]:[] :: [a][])(.) :: (b -> c) -> (a -> b) -> a -> c.("--title="(++) :: [a] -> [a] -> [a]++) (.) :: (b -> c) -> (a -> b) -> a -> c. (bool :: t -> t -> Bool -> tbool ((++) :: [a] -> [a] -> [a]++" (internal documentation)") id :: a -> aid (getAny :: Any -> BoolgetAny ($) :: (a -> b) -> a -> b$ argIgnoreExports :: HaddockArgs -> AnyargIgnoreExports args :: HaddockArgsargs))
(.) :: (b -> c) -> (a -> b) -> a -> c. fromFlag :: Flag a -> afromFlag (.) :: (b -> c) -> (a -> b) -> a -> c. argTitle :: HaddockArgs -> Flag StringargTitle ($) :: (a -> b) -> a -> b$ args :: HaddockArgsargs,
bool :: t -> t -> Bool -> tbool id :: a -> aid (const :: a -> b -> aconst [] :: [a][]) isVersion2 :: BoolisVersion2 (.) :: (b -> c) -> (a -> b) -> a -> c. map :: (a -> b) -> [a] -> [b]map ("--optghc=" (++) :: [a] -> [a] -> [a]++) (.) :: (b -> c) -> (a -> b) -> a -> c. argGhcFlags :: HaddockArgs -> [String]argGhcFlags ($) :: (a -> b) -> a -> b$ args :: HaddockArgsargs,
maybe :: b -> (a -> b) -> Maybe a -> bmaybe [] :: [a][] (\l -> ["-B"(++) :: [a] -> [a] -> [a]++l :: [Char]l]) ($) :: (a -> b) -> a -> b$ guard :: MonadPlus m => Bool -> m ()guard isVersion2 :: BoolisVersion2 (>>) :: Monad m => forall a b. m a -> m b -> m b>> flagToMaybe :: Flag a -> Maybe aflagToMaybe (argGhcLibDir :: HaddockArgs -> Flag FilePathargGhcLibDir args :: HaddockArgsargs),
argTargets :: HaddockArgs -> [FilePath]argTargets ($) :: (a -> b) -> a -> b$ args :: HaddockArgsargs
]
where
renderInterfaces = map :: (a -> b) -> [a] -> [b]map (\(i,mh) -> "--read-interface=" (++) :: [a] -> [a] -> [a]++ maybe :: b -> (a -> b) -> Maybe a -> bmaybe "" ((++) :: [a] -> [a] -> [a]++",") mh :: Maybe [Char]mh (++) :: [a] -> [a] -> [a]++ i :: [Char]i)
bool a b c = if c :: Componentc then a :: HaddockArgsa else b :: HaddockArgsb
isVersion2 = version :: Versionversion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [2,0] [] :: [a][]
isVersion2_5 = version :: Versionversion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [2,5] [] :: [a][]
verbosityFlag
| isVersion2_5 :: BoolisVersion2_5 = "--verbosity=1"
| otherwise :: Boolotherwise = "--verbose"
haddockPackageFlags :: LocalBuildInfo
-> Maybe PathTemplate
-> IO ([(FilePath,Maybe FilePath)], Maybe String)
haddockPackageFlags lbi htmlTemplate = do
let allPkgs = installedPkgs :: LocalBuildInfo -> PackageIndexinstalledPkgs lbi :: LocalBuildInfolbi
directDeps = map :: (a -> b) -> [a] -> [b]map fst :: (a, b) -> afst (externalPackageDeps ::
LocalBuildInfo -> [(InstalledPackageId, PackageId)]externalPackageDeps lbi :: LocalBuildInfolbi)
transitiveDeps <- case dependencyClosure ::
PackageIndex
-> [InstalledPackageId]
-> Either
PackageIndex [(InstalledPackageInfo, [InstalledPackageId])]dependencyClosure allPkgs :: PackageIndexallPkgs directDeps :: [InstalledPackageId]directDeps of
Left x -> return :: Monad m => forall a. a -> m areturn x :: PackageIndexx
Right _ -> die :: String -> IO adie "Can't find transitive deps for haddock"
interfaces <- sequence :: Monad m => [m a] -> m [a]sequence
[ case interfaceAndHtmlPath ::
InstalledPackageInfo -> Maybe (FilePath, FilePath)interfaceAndHtmlPath ipkg :: InstalledPackageInfoipkg of
Nothing -> return :: Monad m => forall a. a -> m areturn (Left :: a -> Either a bLeft (packageId :: Package pkg => pkg -> PackageIdentifierpackageId ipkg :: InstalledPackageInfoipkg))
Just (interface, html) -> do
exists <- doesFileExist :: FilePath -> IO BooldoesFileExist interface :: FilePathinterface
if exists :: Boolexists
then return :: Monad m => forall a. a -> m areturn (Right :: b -> Either a bRight (interface :: FilePathinterface, html :: FilePathhtml))
else return :: Monad m => forall a. a -> m areturn (Left :: a -> Either a bLeft (packageId :: Package pkg => pkg -> PackageIdentifierpackageId ipkg :: InstalledPackageInfoipkg))
| ipkg <- allPackages :: PackageIndex -> [InstalledPackageInfo]PackageIndex.allPackages transitiveDeps :: PackageIndextransitiveDeps ]
let missing = [ pkgid :: PackageIdentifierpkgid | Left pkgid <- interfaces :: [Either PackageIdentifier (FilePath, FilePath)]interfaces ]
warning = "The documentation for the following packages are not "
(++) :: [a] -> [a] -> [a]++ "installed. No links will be generated to these packages: "
(++) :: [a] -> [a] -> [a]++ intercalate :: [a] -> [[a]] -> [a]intercalate ", " (map :: (a -> b) -> [a] -> [b]map display :: Text a => a -> Stringdisplay missing :: [PackageIdentifier]missing)
flags = [ (interface :: FilePathinterface, if null :: [a] -> Boolnull html :: FilePathhtml then Nothing :: Maybe aNothing else Just :: a -> Maybe aJust html :: FilePathhtml)
| Right (interface, html) <- interfaces :: [Either PackageIdentifier (FilePath, FilePath)]interfaces ]
return :: Monad m => forall a. a -> m areturn (flags :: HaddockFlagsflags, if null :: [a] -> Boolnull missing :: [PackageIdentifier]missing then Nothing :: Maybe aNothing else Just :: a -> Maybe aJust warning :: [Char]warning)
where
interfaceAndHtmlPath :: InstalledPackageInfo -> Maybe (FilePath, FilePath)
interfaceAndHtmlPath pkg = do
interface <- listToMaybe :: [a] -> Maybe alistToMaybe (haddockInterfaces :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.haddockInterfaces pkg :: InstalledPackageInfopkg)
html <- case htmlTemplate :: Maybe PathTemplatehtmlTemplate of
Nothing -> listToMaybe :: [a] -> Maybe alistToMaybe (haddockHTMLs :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.haddockHTMLs pkg :: InstalledPackageInfopkg)
Just htmlPathTemplate -> Just :: a -> Maybe aJust (expandTemplateVars :: PathTemplate -> FilePathexpandTemplateVars htmlPathTemplate :: PathTemplatehtmlPathTemplate)
return :: Monad m => forall a. a -> m areturn (interface :: FilePathinterface, html :: FilePathhtml)
where expandTemplateVars = fromPathTemplate :: PathTemplate -> FilePathfromPathTemplate (.) :: (b -> c) -> (a -> b) -> a -> c. substPathTemplate ::
PathTemplateEnv -> PathTemplate -> PathTemplatesubstPathTemplate env :: [(PathTemplateVariable, PathTemplate)]env
env = (PrefixVar :: PathTemplateVariablePrefixVar, prefix :: InstallDirs dir -> dirprefix (installDirTemplates :: LocalBuildInfo -> InstallDirTemplatesinstallDirTemplates lbi :: LocalBuildInfolbi))
(:) :: a -> [a] -> [a]: initialPathTemplateEnv ::
PackageIdentifier -> CompilerId -> PathTemplateEnvinitialPathTemplateEnv (packageId :: Package pkg => pkg -> PackageIdentifierpackageId pkg :: InstalledPackageInfopkg) (compilerId :: Compiler -> CompilerIdcompilerId (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi))
hscolour :: PackageDescription -> LocalBuildInfo -> [PPSuffixHandler] -> HscolourFlags -> IO ()
hscolour pkg_descr lbi suffixes flags = do
initialBuildSteps ::
FilePath
-> PackageDescription
-> LocalBuildInfo
-> Verbosity
-> IO ()initialBuildSteps distPref :: FilePathdistPref pkg_descr :: PackageDescriptionpkg_descr lbi :: LocalBuildInfolbi verbosity :: Verbosityverbosity
hscolour' ::
PackageDescription
-> LocalBuildInfo
-> [PPSuffixHandler]
-> HscolourFlags
-> IO ()hscolour' pkg_descr :: PackageDescriptionpkg_descr lbi :: LocalBuildInfolbi suffixes :: [PPSuffixHandler]suffixes flags :: HaddockFlagsflags
where
verbosity = fromFlag :: Flag a -> afromFlag (hscolourVerbosity :: HscolourFlags -> Flag VerbosityhscolourVerbosity flags :: HaddockFlagsflags)
distPref = fromFlag :: Flag a -> afromFlag ($) :: (a -> b) -> a -> b$ hscolourDistPref :: HscolourFlags -> Flag FilePathhscolourDistPref flags :: HaddockFlagsflags
hscolour' :: PackageDescription
-> LocalBuildInfo
-> [PPSuffixHandler]
-> HscolourFlags
-> IO ()
hscolour' pkg_descr lbi suffixes flags = do
let distPref = fromFlag :: Flag a -> afromFlag ($) :: (a -> b) -> a -> b$ hscolourDistPref :: HscolourFlags -> Flag FilePathhscolourDistPref flags :: HaddockFlagsflags
(hscolourProg, _, _) <-
requireProgramVersion ::
Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)requireProgramVersion
verbosity :: Verbosityverbosity hscolourProgram :: ProgramhscolourProgram
(orLaterVersion :: Version -> VersionRangeorLaterVersion (Version :: [Int] -> [String] -> VersionVersion [1,8] [] :: [a][])) (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
setupMessage :: Verbosity -> String -> PackageIdentifier -> IO ()setupMessage verbosity :: Verbosityverbosity "Running hscolour for" (packageId :: Package pkg => pkg -> PackageIdentifierpackageId pkg_descr :: PackageDescriptionpkg_descr)
createDirectoryIfMissingVerbose ::
Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue ($) :: (a -> b) -> a -> b$ hscolourPref :: FilePath -> PackageDescription -> FilePathhscolourPref distPref :: FilePathdistPref pkg_descr :: PackageDescriptionpkg_descr
let pre c = preprocessComponent ::
PackageDescription
-> Component
-> LocalBuildInfo
-> Bool
-> Verbosity
-> [PPSuffixHandler]
-> IO ()preprocessComponent pkg_descr :: PackageDescriptionpkg_descr c :: Componentc lbi :: LocalBuildInfolbi False :: BoolFalse verbosity :: Verbosityverbosity suffixes :: [PPSuffixHandler]suffixes
withComponentsLBI ::
LocalBuildInfo
-> (Component -> ComponentLocalBuildInfo -> IO ())
-> IO ()withComponentsLBI lbi :: LocalBuildInfolbi ($) :: (a -> b) -> a -> b$ \comp _ -> do
pre :: Component -> IO ()pre comp :: Componentcomp
case comp :: Componentcomp of
CLib lib -> do
let outputDir = hscolourPref :: FilePath -> PackageDescription -> FilePathhscolourPref distPref :: FilePathdistPref pkg_descr :: PackageDescriptionpkg_descr (</>) :: FilePath -> FilePath -> FilePath</> "src"
runHsColour ::
ConfiguredProgram -> FilePath -> [(ModuleName, ProgArg)] -> IO ()runHsColour hscolourProg :: ConfiguredProgramhscolourProg outputDir :: FilePathoutputDir (=<<) :: Monad m => (a -> m b) -> m a -> m b=<< getLibSourceFiles ::
LocalBuildInfo -> Library -> IO [(ModuleName, FilePath)]getLibSourceFiles lbi :: LocalBuildInfolbi lib :: Librarylib
CExe exe | fromFlag :: Flag a -> afromFlag (hscolourExecutables :: HscolourFlags -> Flag BoolhscolourExecutables flags :: HaddockFlagsflags) -> do
let outputDir = hscolourPref :: FilePath -> PackageDescription -> FilePathhscolourPref distPref :: FilePathdistPref pkg_descr :: PackageDescriptionpkg_descr (</>) :: FilePath -> FilePath -> FilePath</> exeName :: Executable -> StringexeName exe :: Executableexe (</>) :: FilePath -> FilePath -> FilePath</> "src"
runHsColour ::
ConfiguredProgram -> FilePath -> [(ModuleName, ProgArg)] -> IO ()runHsColour hscolourProg :: ConfiguredProgramhscolourProg outputDir :: FilePathoutputDir (=<<) :: Monad m => (a -> m b) -> m a -> m b=<< getExeSourceFiles ::
LocalBuildInfo -> Executable -> IO [(ModuleName, FilePath)]getExeSourceFiles lbi :: LocalBuildInfolbi exe :: Executableexe
_ -> return :: Monad m => forall a. a -> m areturn ()
where
stylesheet = flagToMaybe :: Flag a -> Maybe aflagToMaybe (hscolourCSS :: HscolourFlags -> Flag FilePathhscolourCSS flags :: HaddockFlagsflags)
verbosity = fromFlag :: Flag a -> afromFlag (hscolourVerbosity :: HscolourFlags -> Flag VerbosityhscolourVerbosity flags :: HaddockFlagsflags)
runHsColour prog outputDir moduleFiles = do
createDirectoryIfMissingVerbose ::
Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue outputDir :: FilePathoutputDir
case stylesheet :: Maybe FilePathstylesheet of
Nothing | programVersion :: ConfiguredProgram -> Maybe VersionprogramVersion prog :: ConfiguredProgramprog (>=) :: Ord a => a -> a -> Bool>= Just :: a -> Maybe aJust (Version :: [Int] -> [String] -> VersionVersion [1,9] [] :: [a][]) ->
rawSystemProgram ::
Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ()rawSystemProgram verbosity :: Verbosityverbosity prog :: ConfiguredProgramprog
["-print-css", "-o" (++) :: [a] -> [a] -> [a]++ outputDir :: FilePathoutputDir (</>) :: FilePath -> FilePath -> FilePath</> "hscolour.css"]
| otherwise :: Boolotherwise -> return :: Monad m => forall a. a -> m areturn ()
Just s -> copyFileVerbose :: Verbosity -> FilePath -> FilePath -> IO ()copyFileVerbose verbosity :: Verbosityverbosity s :: FilePaths (outputDir :: FilePathoutputDir (</>) :: FilePath -> FilePath -> FilePath</> "hscolour.css")
flip :: (a -> b -> c) -> b -> a -> cflip mapM_ :: Monad m => (a -> m b) -> [a] -> m ()mapM_ moduleFiles :: [(ModuleName, ProgArg)]moduleFiles ($) :: (a -> b) -> a -> b$ \(m, inFile) ->
rawSystemProgram ::
Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ()rawSystemProgram verbosity :: Verbosityverbosity prog :: ConfiguredProgramprog
[(css :: HscolourFlags -> [Char]css flags :: HaddockFlagsflags), "-anchor", "-o" (++) :: [a] -> [a] -> [a]++ outFile :: ModuleName -> FilePathoutFile m :: FilePathm, inFile :: ProgArginFile]
where
outFile m = outputDir :: FilePathoutputDir (</>) :: FilePath -> FilePath -> FilePath</> intercalate :: [a] -> [[a]] -> [a]intercalate "-" (components :: ModuleName -> [String]ModuleName.components m :: FilePathm) (<.>) :: FilePath -> String -> FilePath<.> "html"
css = fromMaybe :: a -> Maybe a -> afromMaybe "-css" (.) :: (b -> c) -> (a -> b) -> a -> c. (("-acss=" (++) :: [a] -> [a] -> [a]++) fmap :: Functor f => forall a b. (a -> b) -> f a -> f b`fmap`) (.) :: (b -> c) -> (a -> b) -> a -> c. flagToMaybe :: Flag a -> Maybe aflagToMaybe (.) :: (b -> c) -> (a -> b) -> a -> c. hscolourAnnotFile :: HscolourFlags -> Flag FilePathhscolourAnnotFile
haddockToHscolour :: PackageDescription -> HaddockFlags -> HscolourFlags
haddockToHscolour pkg_descr flags =
HscolourFlags {
hscolourCSS = haddockHscolourCss :: HaddockFlags -> Flag FilePathhaddockHscolourCss flags :: HaddockFlagsflags,
hscolourExecutables = haddockExecutables :: HaddockFlags -> Flag BoolhaddockExecutables flags :: HaddockFlagsflags,
hscolourVerbosity = haddockVerbosity :: HaddockFlags -> Flag VerbosityhaddockVerbosity flags :: HaddockFlagsflags,
hscolourDistPref = haddockDistPref :: HaddockFlags -> Flag FilePathhaddockDistPref flags :: HaddockFlagsflags,
hscolourAnnotFile = ann :: Flag FilePathann
}
where ann = if fromFlag :: Flag a -> afromFlag ($) :: (a -> b) -> a -> b$ haddockAnnot :: HaddockFlags -> Flag BoolhaddockAnnot flags :: HaddockFlagsflags
then (((</>) :: FilePath -> FilePath -> FilePath</> annotName :: FilePathannotName) (.) :: (b -> c) -> (a -> b) -> a -> c. (hscolourPref :: FilePath -> PackageDescription -> FilePath`hscolourPref` pkg_descr :: PackageDescriptionpkg_descr)) fmap :: Functor f => forall a b. (a -> b) -> f a -> f b`fmap` haddockDistPref :: HaddockFlags -> Flag FilePathhaddockDistPref flags :: HaddockFlagsflags
else NoFlag :: Flag aNoFlag
getLibSourceFiles :: LocalBuildInfo
-> Library
-> IO [(ModuleName.ModuleName, FilePath)]
getLibSourceFiles lbi lib = getSourceFiles ::
[FilePath] -> [ModuleName] -> IO [(ModuleName, FilePath)]getSourceFiles searchpaths :: [String]searchpaths modules :: [ModuleName]modules
where
bi = libBuildInfo :: Library -> BuildInfolibBuildInfo lib :: Librarylib
modules = exposedModules :: Library -> [ModuleName]PD.exposedModules lib :: Librarylib (++) :: [a] -> [a] -> [a]++ otherModules :: BuildInfo -> [ModuleName]otherModules bi :: BuildInfobi
searchpaths = autogenModulesDir :: LocalBuildInfo -> StringautogenModulesDir lbi :: LocalBuildInfolbi (:) :: a -> [a] -> [a]: buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi (:) :: a -> [a] -> [a]: hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs bi :: BuildInfobi
getExeSourceFiles :: LocalBuildInfo
-> Executable
-> IO [(ModuleName.ModuleName, FilePath)]
getExeSourceFiles lbi exe = do
moduleFiles <- getSourceFiles ::
[FilePath] -> [ModuleName] -> IO [(ModuleName, FilePath)]getSourceFiles searchpaths :: [String]searchpaths modules :: [ModuleName]modules
srcMainPath <- findFile :: [FilePath] -> FilePath -> IO FilePathfindFile (hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs bi :: BuildInfobi) (modulePath :: Executable -> FilePathmodulePath exe :: Executableexe)
return :: Monad m => forall a. a -> m areturn ((main :: ModuleNameModuleName.main, srcMainPath :: FilePathsrcMainPath) (:) :: a -> [a] -> [a]: moduleFiles :: [(ModuleName, ProgArg)]moduleFiles)
where
bi = buildInfo :: Executable -> BuildInfobuildInfo exe :: Executableexe
modules = otherModules :: BuildInfo -> [ModuleName]otherModules bi :: BuildInfobi
searchpaths = autogenModulesDir :: LocalBuildInfo -> StringautogenModulesDir lbi :: LocalBuildInfolbi (:) :: a -> [a] -> [a]: exeBuildDir :: LocalBuildInfo -> Executable -> FilePathexeBuildDir lbi :: LocalBuildInfolbi exe :: Executableexe (:) :: a -> [a] -> [a]: hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs bi :: BuildInfobi
getSourceFiles :: [FilePath]
-> [ModuleName.ModuleName]
-> IO [(ModuleName.ModuleName, FilePath)]
getSourceFiles dirs modules = flip :: (a -> b -> c) -> b -> a -> cflip mapM :: Monad m => (a -> m b) -> [a] -> m [b]mapM modules :: [ModuleName]modules ($) :: (a -> b) -> a -> b$ \m -> fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap ((,) m :: FilePathm) ($) :: (a -> b) -> a -> b$
findFileWithExtension ::
[String] -> [FilePath] -> FilePath -> IO (Maybe FilePath)findFileWithExtension ["hs", "lhs"] dirs :: [FilePath]dirs (toFilePath :: ModuleName -> FilePathModuleName.toFilePath m :: FilePathm)
(>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= maybe :: b -> (a -> b) -> Maybe a -> bmaybe (notFound :: a -> IO anotFound m :: FilePathm) (return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. normalise :: FilePath -> FilePathnormalise)
where
notFound module_ = die :: String -> IO adie ($) :: (a -> b) -> a -> b$ "can't find source for module " (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay module_ :: amodule_
exeBuildDir :: LocalBuildInfo -> Executable -> FilePath
exeBuildDir lbi exe = buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi (</>) :: FilePath -> FilePath -> FilePath</> exeName :: Executable -> StringexeName exe :: Executableexe (</>) :: FilePath -> FilePath -> FilePath</> exeName :: Executable -> StringexeName exe :: Executableexe (++) :: [a] -> [a] -> [a]++ "-tmp"
instance D:Monoid :: a -> (a -> a -> a) -> ([a] -> a) -> T:Monoid aMonoid HaddockArgs where
mempty = HaddockArgs {
argInterfaceFile = mempty :: Monoid a => amempty,
argPackageName = mempty :: Monoid a => amempty,
argHideModules = mempty :: Monoid a => amempty,
argIgnoreExports = mempty :: Monoid a => amempty,
argLinkSource = mempty :: Monoid a => amempty,
argCssFile = mempty :: Monoid a => amempty,
argVerbose = mempty :: Monoid a => amempty,
argOutput = mempty :: Monoid a => amempty,
argInterfaces = mempty :: Monoid a => amempty,
argOutputDir = mempty :: Monoid a => amempty,
argTitle = mempty :: Monoid a => amempty,
argPrologue = mempty :: Monoid a => amempty,
argGhcFlags = mempty :: Monoid a => amempty,
argGhcLibDir = mempty :: Monoid a => amempty,
argTargets = mempty :: Monoid a => amempty
}
mappend a b = HaddockArgs {
argInterfaceFile = mult :: (HaddockArgs -> a) -> amult argInterfaceFile :: HaddockArgs -> Flag FilePathargInterfaceFile,
argPackageName = mult :: (HaddockArgs -> a) -> amult argPackageName :: HaddockArgs -> Flag PackageIdentifierargPackageName,
argHideModules = mult :: (HaddockArgs -> a) -> amult argHideModules :: HaddockArgs -> (All, [ModuleName])argHideModules,
argIgnoreExports = mult :: (HaddockArgs -> a) -> amult argIgnoreExports :: HaddockArgs -> AnyargIgnoreExports,
argLinkSource = mult :: (HaddockArgs -> a) -> amult argLinkSource :: HaddockArgs -> Flag (Template, Template)argLinkSource,
argCssFile = mult :: (HaddockArgs -> a) -> amult argCssFile :: HaddockArgs -> Flag FilePathargCssFile,
argVerbose = mult :: (HaddockArgs -> a) -> amult argVerbose :: HaddockArgs -> AnyargVerbose,
argOutput = mult :: (HaddockArgs -> a) -> amult argOutput :: HaddockArgs -> Flag [Output]argOutput,
argInterfaces = mult :: (HaddockArgs -> a) -> amult argInterfaces :: HaddockArgs -> [(FilePath, Maybe FilePath)]argInterfaces,
argOutputDir = mult :: (HaddockArgs -> a) -> amult argOutputDir :: HaddockArgs -> DirectoryargOutputDir,
argTitle = mult :: (HaddockArgs -> a) -> amult argTitle :: HaddockArgs -> Flag StringargTitle,
argPrologue = mult :: (HaddockArgs -> a) -> amult argPrologue :: HaddockArgs -> Flag StringargPrologue,
argGhcFlags = mult :: (HaddockArgs -> a) -> amult argGhcFlags :: HaddockArgs -> [String]argGhcFlags,
argGhcLibDir = mult :: (HaddockArgs -> a) -> amult argGhcLibDir :: HaddockArgs -> Flag FilePathargGhcLibDir,
argTargets = mult :: (HaddockArgs -> a) -> amult argTargets :: HaddockArgs -> [FilePath]argTargets
}
where mult f = f :: HaddockArgs -> af a :: HaddockArgsa mappend :: Monoid a => a -> a -> a`mappend` f :: HaddockArgs -> af b :: HaddockArgsb
instance D:Monoid :: a -> (a -> a -> a) -> ([a] -> a) -> T:Monoid aMonoid Directory where
mempty = Dir :: FilePath -> DirectoryDir "."
mappend (Dir m) (Dir n) = Dir :: FilePath -> DirectoryDir ($) :: (a -> b) -> a -> b$ m :: FilePathm (</>) :: FilePath -> FilePath -> FilePath</> n :: FilePathn