Commit e63f1087 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Replace moduleToFilePath with findFileWithExtension

moduleToFilePath encouraged bad error handling and becuase it was specific
to module names it made it hard to treat modules and main.hs files uniformly.
This is one step towards using the same code paths for modules and main.hs
files so that main.hs files always work properly with pre-processors etc.
parent 85cf7e73
......@@ -82,6 +82,7 @@ import Distribution.Compat.ReadP
import Control.Monad ( unless, when )
import Data.Char
import Data.List ( nub, isPrefixOf )
import Data.Maybe ( catMaybes )
import System.Directory ( removeFile, renameFile,
getDirectoryContents, doesFileExist,
getTemporaryDirectory )
......@@ -360,12 +361,18 @@ build pkg_descr lbi verbosity = do
sharedLibName = mkSharedLibName pref (showPackageId (package pkg_descr)) (compilerId (compiler lbi))
ghciLibName = mkGHCiLibName pref (showPackageId (package pkg_descr))
stubObjs <- sequence [moduleToFilePath [libTargetDir] (x ++"_stub") [objExtension]
| x <- libModules pkg_descr ] >>= return . concat
stubProfObjs <- sequence [moduleToFilePath [libTargetDir] (x ++"_stub") ["p_" ++ objExtension]
| x <- libModules pkg_descr ] >>= return . concat
stubSharedObjs <- sequence [moduleToFilePath [libTargetDir] (x ++"_stub") ["dyn_" ++ objExtension]
| x <- libModules pkg_descr ] >>= return . concat
stubObjs <- fmap catMaybes $ sequence
[ findFileWithExtension [objExtension] [libTargetDir]
(dotToSep x ++"_stub")
| x <- libModules pkg_descr ]
stubProfObjs <- fmap catMaybes $ sequence
[ findFileWithExtension ["p_" ++ objExtension] [libTargetDir]
(dotToSep x ++"_stub")
| x <- libModules pkg_descr ]
stubSharedObjs <- fmap catMaybes $ sequence
[ findFileWithExtension ["dyn_" ++ objExtension] [libTargetDir]
(dotToSep x ++"_stub")
| x <- libModules pkg_descr ]
hObjs <- getHaskellObjects pkg_descr libBi lbi
pref objExtension True
......@@ -452,7 +459,8 @@ build pkg_descr lbi verbosity = do
ifSharedLib $ runGhcProg ghcSharedLinkArgs
-- build any executables
withExe pkg_descr $ \ (Executable exeName' modPath exeBi) -> do
withExe pkg_descr $ \Executable { exeName = exeName', modulePath = modPath,
buildInfo = exeBi } -> do
info verbosity $ "Building executable: " ++ exeName' ++ "..."
-- exeNameReal, the name that GHC really uses (with .exe on Windows)
......@@ -668,7 +676,7 @@ installExe :: Verbosity -- ^verbosity
-> IO ()
installExe verbosity pref buildPref (progprefix, progsuffix) pkg_descr
= do createDirectoryIfMissingVerbose verbosity True pref
withExe pkg_descr $ \ (Executable e _ _) -> do
withExe pkg_descr $ \Executable { exeName = e } -> do
let exeFileName = e <.> exeExtension
fixedExeFileName = (progprefix ++ e ++ progsuffix) <.> exeExtension
copyFileVerbose verbosity (buildPref </> e </> exeFileName) (pref </> fixedExeFileName)
......
......@@ -70,8 +70,9 @@ import Distribution.Simple.InstallDirs (InstallDirs(..),
import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )
import Distribution.Simple.BuildPaths ( distPref, haddockPref, haddockName,
hscolourPref, autogenModulesDir )
import Distribution.Simple.Utils (die, warn, notice, createDirectoryIfMissingVerbose,
moduleToFilePath, findFile, setupMessage)
import Distribution.Simple.Utils
( die, warn, notice, setupMessage, createDirectoryIfMissingVerbose
, findFileWithExtension, findFile, dotToSep )
import Distribution.Simple.Utils (rawSystemStdout)
import Distribution.Verbosity
......@@ -86,7 +87,7 @@ import Data.Char (isSpace)
import Data.List (nub)
import System.FilePath((</>), (<.>), splitFileName, splitExtension,
replaceExtension)
replaceExtension, normalise)
import Distribution.Version
import Distribution.Simple.Compiler (compilerVersion, extensionsToFlags)
......@@ -364,6 +365,8 @@ hscolour pkg_descr lbi suffixes flags = do
--TODO: where to put this? it's duplicated in .Simple too
getModulePaths :: LocalBuildInfo -> BuildInfo -> [String] -> IO [FilePath]
getModulePaths lbi bi =
fmap concat .
mapM (flip (moduleToFilePath (buildDir lbi : hsSourceDirs bi)) ["hs", "lhs"])
getModulePaths lbi bi modules = sequence
[ findFileWithExtension ["hs", "lhs"] (buildDir lbi : hsSourceDirs bi)
(dotToSep module_) >>= maybe (notFound module_) (return . normalise)
| module_ <- modules ]
where notFound module_ = die $ "can't find source for module " ++ module_
......@@ -61,7 +61,7 @@ import Distribution.Simple.BuildPaths
( autogenModuleName, autogenModulesDir,
dllExtension )
import Distribution.Simple.Utils( createDirectoryIfMissingVerbose, dotToSep,
moduleToFilePath, die, info, notice,
findFileWithExtension, die, info, notice,
smartCopySources, findFile )
import Language.Haskell.Extension
( Extension(..) )
......@@ -72,7 +72,7 @@ import Distribution.Verbosity
import Distribution.Package ( PackageIdentifier(..) )
import Data.Char ( isSpace )
import Data.Maybe ( mapMaybe )
import Data.Maybe ( mapMaybe, catMaybes )
import Control.Monad ( unless, when, filterM )
import Control.Exception ( try )
import Data.List ( nub, sort, isSuffixOf )
......@@ -165,18 +165,19 @@ build pkg_descr lbi verbosity = do
let srcDirs = nub $ srcDir : hsSourceDirs bi ++ mLibSrcDirs
info verbosity $ "Source directories: " ++ show srcDirs
flip mapM_ mods $ \ m -> do
fs <- moduleToFilePath srcDirs m suffixes
fs <- findFileWithExtension suffixes srcDirs (dotToSep m)
case fs of
[] ->
Nothing ->
die ("can't find source for module " ++ m)
srcFile:_ -> do
Just srcFile -> do
let ext = takeExtension srcFile
copyModule useCpp bi srcFile
(destDir </> dotToSep m <.> ext)
-- Pass 2: compile foreign stubs in scratch directory
stubsFileLists <- sequence [moduleToFilePath [destDir] modu suffixes |
modu <- mods]
compileFiles bi destDir (concat stubsFileLists)
stubsFileLists <- fmap catMaybes $ sequence
[ findFileWithExtension suffixes [destDir] (dotToSep modu)
| modu <- mods]
compileFiles bi destDir stubsFileLists
suffixes = ["hs", "lhs"]
......
......@@ -64,7 +64,7 @@ import Distribution.Simple.Program
nhcProgram, hmakeProgram, ldProgram, arProgram,
rawSystemProgramConf )
import Distribution.Simple.Utils
( die, info, moduleToFilePath, dotToSep,
( die, info, findFileWithExtension, dotToSep,
createDirectoryIfMissingVerbose, copyFileVerbose, smartCopySources )
import Distribution.Version
( Version(..), VersionRange(..), orLaterVersion )
......@@ -217,9 +217,11 @@ nhcVerbosityOptions verbosity
--TODO: where to put this? it's duplicated in .Simple too
getModulePaths :: LocalBuildInfo -> BuildInfo -> [String] -> IO [FilePath]
getModulePaths lbi bi =
fmap (map normalise . concat) .
mapM (flip (moduleToFilePath (buildDir lbi : hsSourceDirs bi)) ["hs", "lhs"])
getModulePaths lbi bi modules = sequence
[ findFileWithExtension ["hs", "lhs"] (buildDir lbi : hsSourceDirs bi)
(dotToSep module_) >>= maybe (notFound module_) (return . normalise)
| module_ <- modules ]
where notFound module_ = die $ "can't find source for module " ++ module_
-- -----------------------------------------------------------------------------
-- Installing
......
......@@ -62,8 +62,9 @@ import Distribution.PackageDescription (PackageDescription(..),
import Distribution.Package (showPackageId)
import Distribution.Simple.Compiler (CompilerFlavor(..), Compiler(..), compilerVersion)
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
import Distribution.Simple.Utils (createDirectoryIfMissingVerbose, die, setupMessage,
moduleToFilePath, moduleToFilePath2)
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, die, setupMessage
, findFileWithExtension, findFileWithExtension', dotToSep )
import Distribution.Simple.Program (Program(..), ConfiguredProgram(..),
lookupProgram, programPath,
rawSystemProgramConf, rawSystemProgram,
......@@ -205,15 +206,16 @@ preprocessModule
preprocessModule searchLoc buildLoc forSDist modu verbosity builtinSuffixes handlers = do
-- look for files in the various source dirs with this module name
-- and a file extension of a known preprocessor
psrcFiles <- moduleToFilePath2 searchLoc modu (map fst handlers)
psrcFiles <- findFileWithExtension' (map fst handlers) searchLoc (dotToSep modu)
case psrcFiles of
-- no preprocessor file exists, look for an ordinary source file
[] -> do bsrcFiles <- moduleToFilePath searchLoc modu builtinSuffixes
Nothing -> do
bsrcFiles <- findFileWithExtension builtinSuffixes searchLoc (dotToSep modu)
case bsrcFiles of
[] -> die ("can't find source for " ++ modu ++ " in " ++ show searchLoc)
_ -> return ()
Nothing -> die ("can't find source for " ++ modu ++ " in " ++ show searchLoc)
_ -> return ()
-- found a pre-processable file in one of the source dirs
((psrcLoc, psrcRelFile):_) -> do
Just (psrcLoc, psrcRelFile) -> do
let (srcStem, ext) = splitExtension psrcRelFile
psrcFile = psrcLoc </> psrcRelFile
pp = fromMaybe (error "Internal error in preProcess module: Just expected")
......@@ -229,10 +231,10 @@ preprocessModule searchLoc buildLoc forSDist modu verbosity builtinSuffixes hand
when (not forSDist || forSDist && platformIndependent pp) $ do
-- look for existing pre-processed source file in the dest dir to
-- see if we really have to re-run the preprocessor.
ppsrcFiles <- moduleToFilePath [buildLoc] modu builtinSuffixes
ppsrcFiles <- findFileWithExtension builtinSuffixes [buildLoc] (dotToSep modu)
recomp <- case ppsrcFiles of
[] -> return True
(ppsrcFile:_) -> do
Nothing -> return True
Just ppsrcFile -> do
btime <- getModificationTime ppsrcFile
ptime <- getModificationTime psrcFile
return (btime < ptime)
......
......@@ -139,7 +139,7 @@ prepareTree pkg_descr verbosity mb_lbi snapshot tmpDir pps date = do
withLib pkg_descr () $ \ l ->
prepareDir verbosity targetDir pps (exposedModules l) (libBuildInfo l)
-- move the executables into place
withExe pkg_descr $ \ (Executable _ mainPath exeBi) -> do
withExe pkg_descr $ \Executable { modulePath = mainPath, buildInfo = exeBi } -> do
prepareDir verbosity targetDir pps [] exeBi
srcMainFile <- do
ppFile <- findFileWithExtension (ppSuffixes pps) (hsSourceDirs exeBi) (dropExtension mainPath)
......
......@@ -62,8 +62,6 @@ module Distribution.Simple.Utils (
copyFileVerbose,
copyDirectoryRecursiveVerbose,
copyFiles,
moduleToFilePath,
moduleToFilePath2,
currentDir,
dotToSep,
findFile,
......@@ -77,7 +75,7 @@ module Distribution.Simple.Utils (
) where
import Control.Monad
( when, filterM, unless )
( when, unless )
import Data.List
( nub, unfoldr )
......@@ -312,47 +310,6 @@ xargs maxSize rawSystemFun fixedArgs bigArgs =
-- * File Utilities
-- ------------------------------------------------------------
-- |Get the file path for this particular module. In the IO monad
-- because it looks for the actual file. Might eventually interface
-- with preprocessor libraries in order to correctly locate more
-- filenames.
-- Returns empty list if no such files exist.
moduleToFilePath :: [FilePath] -- ^search locations
-> String -- ^Module Name
-> [String] -- ^possible suffixes
-> IO [FilePath]
moduleToFilePath pref s possibleSuffixes
= filterM doesFileExist $
concatMap (searchModuleToPossiblePaths s possibleSuffixes) pref
where searchModuleToPossiblePaths :: String -> [String] -> FilePath -> [FilePath]
searchModuleToPossiblePaths s' suffs searchP
= moduleToPossiblePaths searchP s' suffs
-- |Like 'moduleToFilePath', but return the location and the rest of
-- the path as separate results.
moduleToFilePath2
:: [FilePath] -- ^search locations
-> String -- ^Module Name
-> [String] -- ^possible suffixes
-> IO [(FilePath, FilePath)] -- ^locations and relative names
moduleToFilePath2 locs mname possibleSuffixes
= filterM exists $
[(loc, fname <.> ext) | loc <- locs, ext <- possibleSuffixes]
where
fname = dotToSep mname
exists (loc, relname) = doesFileExist (loc </> relname)
-- |Get the possible file paths based on this module name.
moduleToPossiblePaths :: FilePath -- ^search prefix
-> String -- ^module name
-> [String] -- ^possible suffixes
-> [FilePath]
moduleToPossiblePaths searchPref s possibleSuffixes =
let fname = searchPref </> (dotToSep s)
in [fname <.> ext | ext <- possibleSuffixes]
findFile :: [FilePath] -- ^search locations
-> FilePath -- ^File Name
-> IO FilePath
......
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