diff --git a/Distribution/Simple.hs b/Distribution/Simple.hs index b8c3062b5886868184cea619511e6b45cd6128e3..a3d37224e011e1505796a9d2705285105caab79a 100644 --- a/Distribution/Simple.hs +++ b/Distribution/Simple.hs @@ -387,62 +387,69 @@ defaultMainWorker pkg_descr_in action args hooks -- (filter (\x -> notElem x overriders) overridden) ++ overriders + +getModulePaths :: BuildInfo -> [String] -> IO [FilePath] +getModulePaths bi = + fmap concat . + mapM (flip (moduleToFilePath (hsSourceDirs bi)) ["hs", "lhs"]) + haddock :: PackageDescription -> LocalBuildInfo -> Maybe UserHooks -> HaddockFlags -> IO () haddock pkg_descr lbi hooks (HaddockFlags verbose) = do let pps = allSuffixHandlers hooks confHaddock <- do let programConf = withPrograms lbi - let haddockName = programName $ haddockProgram + let haddockName = programName haddockProgram mHaddock <- lookupProgram haddockName programConf - case mHaddock of - Nothing -> (die "haddock command not found") - Just h -> return h + maybe (die "haddock command not found") return mHaddock let targetDir = joinPaths distPref (joinPaths "doc" "html") let tmpDir = joinPaths (buildDir lbi) "tmp" createDirectoryIfMissing True tmpDir createDirectoryIfMissing True targetDir preprocessSources pkg_descr lbi verbose pps - + setupMessage "Running Haddock for" pkg_descr + let replaceLitExts = map (joinFileName tmpDir . flip changeFileExt "hs") + let mockAll bi = mapM_ (mockPP ["-D__HADDOCK__"] pkg_descr bi lbi tmpDir verbose) + withLib pkg_descr () $ \lib -> do let bi = libBuildInfo lib - inFiles <- sequence [moduleToFilePath (hsSourceDirs bi) m ["hs", "lhs"] - | m <- exposedModules lib ++ otherModules bi] >>= return . concat - mapM_ (mockPP ["-D__HADDOCK__"] pkg_descr bi lbi tmpDir verbose) inFiles + inFiles <- getModulePaths bi (exposedModules lib ++ otherModules bi) + mockAll bi inFiles let showPkg = showPackageId (package pkg_descr) let prologName = showPkg ++ "-haddock-prolog.txt" - writeFile prologName ((description pkg_descr) ++ "\n") - let outFiles = map (joinFileName tmpDir) - (map ((flip changeFileExt) "hs") inFiles) + writeFile prologName (description pkg_descr ++ "\n") + let outFiles = replaceLitExts inFiles + let haddockFile = joinFileExt (pkgName (package pkg_descr)) "haddock" -- FIX: replace w/ rawSystemProgramConf? rawSystemProgram verbose confHaddock (["-h", "-o", targetDir, "-t", showPkg, - "-p", prologName] ++ (programArgs confHaddock) - ++ (if verbose > 4 then ["-v"] else []) - ++ outFiles - ++ map ((++) "--hide=") (otherModules bi) + "-D", joinFileName targetDir haddockFile, + "-p", prologName] + ++ programArgs confHaddock + ++ (if verbose > 4 then ["-v"] else []) + ++ outFiles + ++ map ("--hide=" ++) (otherModules bi) ) removeFile prologName withExe pkg_descr $ \exe -> do let bi = buildInfo exe exeTargetDir = targetDir `joinFileName` exeName exe createDirectoryIfMissing True exeTargetDir - inFiles' <- sequence [moduleToFilePath (hsSourceDirs bi) m ["hs", "lhs"] - | m <- otherModules bi] >>= return . concat + inFiles' <- getModulePaths bi (otherModules bi) srcMainPath <- findFile (hsSourceDirs bi) (modulePath exe) let inFiles = srcMainPath : inFiles' - mapM_ (mockPP ["-D__HADDOCK__"] pkg_descr bi lbi tmpDir verbose) inFiles - let outFiles = map (joinFileName tmpDir) - (map ((flip changeFileExt) "hs") inFiles) + mockAll bi inFiles + let outFiles = replaceLitExts inFiles rawSystemProgram verbose confHaddock (["-h", "-o", exeTargetDir, - "-t", exeName exe] ++ (programArgs confHaddock) - ++ (if verbose > 4 then ["-v"] else []) - ++ outFiles + "-t", exeName exe] + ++ programArgs confHaddock + ++ (if verbose > 4 then ["-v"] else []) + ++ outFiles ) removeDirectoryRecursive tmpDir @@ -460,8 +467,9 @@ haddock pkg_descr lbi hooks (HaddockFlags verbose) = do ppUnlit targetFile (joinFileExt targetFileNoext "hs") verbose return () needsCpp :: PackageDescription -> Bool - needsCpp p | not (hasLibs p) = False - | otherwise = any (== CPP) (extensions $ libBuildInfo $ fromJust $ library p) + needsCpp p = + hasLibs p && + any (== CPP) (extensions $ libBuildInfo $ fromJust $ library p) pfe :: PackageDescription -> LocalBuildInfo -> Maybe UserHooks -> PFEFlags -> IO () pfe pkg_descr _lbi hooks (PFEFlags verbose) = do @@ -473,8 +481,7 @@ pfe pkg_descr _lbi hooks (PFEFlags verbose) = do let bi = libBuildInfo lib let mods = exposedModules lib ++ otherModules (libBuildInfo lib) preprocessSources pkg_descr lbi verbose pps - inFiles <- sequence [moduleToFilePath (hsSourceDirs bi) m ["hs", "lhs"] - | m <- mods] >>= return . concat + inFiles <- getModulePaths bi mods rawSystemProgramConf verbose (programName pfesetupProgram) (withPrograms lbi) ("noplogic":"cpp": (if verbose > 4 then ["-v"] else []) ++ inFiles) @@ -513,9 +520,8 @@ clean pkg_descr maybeLbi hooks (CleanFlags verbose) = do try $ removeFile (startN ++ "_stub.c") removeGHCModuleStubs :: BuildInfo -> [String] -> IO () removeGHCModuleStubs (BuildInfo{hsSourceDirs=dirs}) mods = do - s <- sequence [moduleToFilePath dirs (x ++"_stub") ["h", "c"] - | x <- mods ] - mapM_ removeFile (concat s) + s <- mapM (\x -> moduleToFilePath dirs (x ++"_stub") ["h", "c"]) mods + mapM_ removeFile (concat s) -- JHC FIXME remove exe-sources cleanJHCExtras lbi = do try $ removeFile (buildDir lbi `joinFileName` "jhc-pkg.conf") @@ -531,7 +537,7 @@ clean pkg_descr maybeLbi hooks (CleanFlags verbose) = do no_extra_flags :: [String] -> IO () no_extra_flags [] = return () no_extra_flags extra_flags = - die ("Unrecognised flags: " ++ concat (intersperse "," (extra_flags))) + die ("Unrecognised flags: " ++ concat (intersperse "," extra_flags)) buildDirOpt :: OptDescr (LocalBuildInfo -> LocalBuildInfo) buildDirOpt = Option "b" ["scratchdir"] (reqDirArg setBuildDir)