Commit d1975ee2 authored by ijones's avatar ijones
Browse files

glob of CVS changes; PError, NHC options, system.directory, NHC builds

Authors: Malcolm Wallace, Ross Paterson, Krasimir Angelov

  move createIfNotExists and removeFileRecursive functions from
  Distribution.Simple.Utils to System.Directory. The functions are renamed
  to createDirectoryIfMissing and removeDirectoryRecursive.

  avoid a few GHC warnings

  get IOError stuff from System.IO.Error instead of System.IO

  Minor tweaks to build with nhc98.

  OPTIONS pragma stuff for nhc98 and compat w/ ghc

  Use a custom monad ParseResult for parse results instead of Either PError,
  removing the need for Distribution.Compat.Error and the dependency on mtl.
  
parent e50f3aca
module Distribution.Compat.Directory (
findExecutable, copyFile, getHomeDirectory
findExecutable, copyFile, getHomeDirectory, createDirectoryIfMissing, removeDirectoryRecursive
) where
#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 603
......@@ -8,7 +8,7 @@ module Distribution.Compat.Directory (
#if !__GLASGOW_HASKELL__ || __GLASGOW_HASKELL__ > 602
import System.Directory ( findExecutable, copyFile, getHomeDirectory )
import System.Directory ( findExecutable, copyFile, getHomeDirectory,createDirectoryIfMissing,removeDirectoryRecursive )
#else /* to end of file... */
......@@ -18,7 +18,7 @@ import System.IO
import Foreign
import System.Directory
import Distribution.Compat.Exception (bracket)
import Control.Monad (when)
import Control.Monad (when, unless)
#ifndef mingw32_TARGET_OS
import System.Posix (getFileStatus,setFileMode,fileMode,accessTime,
setFileMode,modificationTime,setFileTimes)
......@@ -92,4 +92,30 @@ copyFile src dest
getHomeDirectory :: IO FilePath
getHomeDirectory = getEnv "HOME"
createDirectoryIfMissing :: Bool -- ^ Create its parents too?
-> FilePath -- ^ The path to the directory you want to make
-> IO ()
createDirectoryIfMissing parents file = do
b <- doesDirectoryExist file
case (b,parents, file) of
(_, _, "") -> return ()
(True, _, _) -> return ()
(_, True, _) -> mapM_ (createDirectoryIfMissing False) (tail (pathParents file))
(_, False, _) -> createDirectory file
removeDirectoryRecursive :: FilePath -> IO ()
removeDirectoryRecursive startLoc = do
cont <- getDirectoryContents startLoc
sequence_ [rm (startLoc `joinFileName` x) | x <- cont, x /= "." && x /= ".."]
removeDirectory startLoc
where
rm :: FilePath -> IO ()
rm f = do temp <- try (removeFile f)
case temp of
Left e -> do isDir <- doesDirectoryExist f
-- If f is not a directory, re-throw the error
unless isDir $ ioError e
removeDirectoryRecursive f
Right _ -> return ()
#endif
module Distribution.Compat.Error (Error(..)) where
#ifndef __NHC__
import Control.Monad.Error (Error(..))
#endif
#ifdef __NHC__
class Error e where
strMsg :: String -> e
-- This is a horrible hack, but H98 doesn't allow
-- instance Error [Char]
instance Error Char where
strMsg s = head s
instance Error e => Error [e] where
strMsg s = map (strMsg . (:[])) s
instance Error e => Monad (Either e) where
return = Right
fail = Left . strMsg
Left e >>= f = Left e
Right x >>= f = f x
#endif
......@@ -2,19 +2,12 @@ module Distribution.Compat.Exception (bracket,finally) where
#ifdef __NHC__
import System.IO.Error (catch, ioError)
import IO (bracket)
#else
import Control.Exception (bracket,finally)
#endif
#ifdef __NHC__
bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket before after thing
= do a <- before
r <- thing a `catch` \e -> do after a
ioError e
after a
return r
finally :: IO a -> IO b -> IO a
finally thing after = bracket (return ()) (const after) thing
finally thing after = bracket (return ()) (const after) (const thing)
#endif
......@@ -55,7 +55,7 @@ module Distribution.InstalledPackageInfo (
) where
import Distribution.ParseUtils (
StanzaField(..), singleStanza, PError(..),
StanzaField(..), singleStanza, ParseResult,
simpleField, listField, licenseField,
parseFilePathQ, parseLibNameQ, parseModuleNameQ, parsePackageNameQ,
showFilePath, parseReadS, parseOptVersion, parseQuoted,
......@@ -144,7 +144,7 @@ noVersion = Version{ versionBranch=[], versionTags=[] }
-- -----------------------------------------------------------------------------
-- Parsing
parseInstalledPackageInfo :: String -> Either PError InstalledPackageInfo
parseInstalledPackageInfo :: String -> ParseResult InstalledPackageInfo
parseInstalledPackageInfo inp = do
lines <- singleStanza inp
-- not interested in stanzas, so just allow blank lines in
......
......@@ -59,7 +59,6 @@ import Distribution.Version (Version(..))
import System.Environment(getArgs)
import Data.Maybe (maybe)
import Data.List ( intersperse )
import System.IO (hPutStr, stderr)
import System.Cmd
......
......@@ -40,7 +40,7 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
module Distribution.Package (
PackageIdentifier(..),
PackageIdentifier(..),
showPackageId, parsePackageId, parsePackageName,
) where
......
......@@ -67,7 +67,6 @@ module Distribution.PackageDescription (
import Control.Monad(foldM, when)
import Data.Char
import Data.List(concatMap)
import Data.Maybe(fromMaybe, fromJust)
import Text.PrettyPrint.HughesPJ(text, render, ($$), empty, space, vcat, fsep)
import System.Directory(doesFileExist)
......@@ -455,11 +454,11 @@ readPackageDescription fpath = do
when (not exists) (die $ "Error: description file \"" ++ fpath ++ "\" doesn't exist. Cannot continue.")
str <- readFile fpath
case parseDescription str of
Left e -> error (showError e) -- FIXME
-- Right PackageDescription{library=Nothing, executables=[]} -> error "no library listed, and no executable stanza."
Right x -> return x
ParseFailed e -> error (showError e) -- FIXME
-- ParseOk PackageDescription{library=Nothing, executables=[]} -> error "no library listed, and no executable stanza."
ParseOk x -> return x
parseDescription :: String -> Either PError PackageDescription
parseDescription :: String -> ParseResult PackageDescription
parseDescription inp = do (st:sts) <- splitStanzas inp
pkg <- foldM (parseBasicStanza basicStanzaFields) emptyPackageDescription st
exes <- mapM parseExecutableStanza sts
......@@ -618,47 +617,47 @@ testPkgDescAnswer =
hunitTests :: [Test]
hunitTests = [
TestLabel "license parsers" $ TestCase $
sequence_ [assertRight ("license " ++ show lVal) lVal
sequence_ [assertParseOk ("license " ++ show lVal) lVal
(runP 1 "license" parseLicenseQ (show lVal))
| lVal <- [GPL,LGPL,BSD3,BSD4]],
TestLabel "Required fields" $ TestCase $
do assertRight "some fields"
do assertParseOk "some fields"
emptyPackageDescription{package=(PackageIdentifier "foo"
(Version [0,0] ["asdf"]))}
(parseDescription "Name: foo\nVersion: 0.0-asdf")
assertRight "more fields foo"
assertParseOk "more fields foo"
emptyPackageDescription{package=(PackageIdentifier "foo"
(Version [0,0]["asdf"])),
license=GPL}
(parseDescription "Name: foo\nVersion:0.0-asdf\nLicense: GPL")
assertRight "required fields for foo"
assertParseOk "required fields for foo"
emptyPackageDescription{package=(PackageIdentifier "foo"
(Version [0,0]["asdf"])),
license=GPL, copyright="2004 isaac jones"}
(parseDescription "Name: foo\nVersion:0.0-asdf\nCopyright: 2004 isaac jones\nLicense: GPL"),
TestCase $ assertRight "no library" Nothing
TestCase $ assertParseOk "no library" Nothing
(library `liftM` parseDescription "Name: foo\nVersion: 1\nLicense: GPL\nMaintainer: someone\n\nExecutable: script\nMain-is: SomeFile.hs\n"),
TestLabel "Package description" $ TestCase $
assertRight "entire package description" testPkgDescAnswer
assertParseOk "entire package description" testPkgDescAnswer
(parseDescription testPkgDesc),
TestLabel "Package description pretty" $ TestCase $
case parseDescription testPkgDesc of
Left _ -> assertBool "can't parse description" False
Right d -> assertRight "parse . show . parse not identity"
ParseFailed _ -> assertBool "can't parse description" False
ParseOk d -> assertParseOk "parse . show . parse not identity"
testPkgDescAnswer (parseDescription $ showPackageDescription d)
]
assertRight :: (Eq val) => String -> val -> (Either a val) -> Assertion
assertRight mes expected actual
assertParseOk :: (Eq val) => String -> val -> ParseResult val -> Assertion
assertParseOk mes expected actual
= assertBool mes
(case actual of
(Right v) -> v == expected
ParseOk v -> v == expected
_ -> False)
test = runTestTT (TestList hunitTests)
......
......@@ -45,6 +45,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
-- #hide
module Distribution.ParseUtils (
LineNo, PError(..), showError, myError, runP,
ParseResult(..),
StanzaField(..), splitStanzas, Stanza, singleStanza,
parseFilePathQ, parseLibNameQ,
parseModuleNameQ, parseDependency, parseOptVersion,
......@@ -61,7 +62,6 @@ import Distribution.Version
import Distribution.Extension
import Distribution.Package ( parsePackageName )
import Distribution.Compat.ReadP as ReadP hiding (get)
import Distribution.Compat.Error
import Distribution.Setup(CompilerFlavor(..))
import Data.Char
......@@ -75,18 +75,24 @@ data PError = AmbigousParse String LineNo
| FromString String (Maybe LineNo)
deriving Show
instance Error PError where
strMsg s = FromString s Nothing
data ParseResult a = ParseFailed PError | ParseOk a
deriving Show
instance Monad ParseResult where
return x = ParseOk x
ParseFailed err >>= _ = ParseFailed err
ParseOk x >>= f = f x
fail s = ParseFailed (FromString s Nothing)
runP :: LineNo -> String -> ReadP a a -> String -> Either PError a
runP :: LineNo -> String -> ReadP a a -> String -> ParseResult a
runP lineNo field p s =
case [ x | (x,"") <- results ] of
[a] -> Right a
[a] -> ParseOk a
[] -> case [ x | (x,ys) <- results, all isSpace ys ] of
[a] -> Right a
[] -> Left (NoParse field lineNo)
_ -> Left (AmbigousParse field lineNo)
_ -> Left (AmbigousParse field lineNo)
[a] -> ParseOk a
[] -> ParseFailed (NoParse field lineNo)
_ -> ParseFailed (AmbigousParse field lineNo)
_ -> ParseFailed (AmbigousParse field lineNo)
where results = readP_to_S p s
showError :: PError -> String
......@@ -95,15 +101,15 @@ showError (NoParse f n) = "Line "++show n++": Parse of field '"++f++"'
showError (FromString s (Just n)) = "Line "++show n++": " ++ s
showError (FromString s Nothing) = s
myError :: LineNo -> String -> Either PError a
myError n s = Left $ FromString s (Just n)
myError :: LineNo -> String -> ParseResult a
myError n s = ParseFailed $ FromString s (Just n)
data StanzaField a
= StanzaField
{ fieldName :: String
, fieldShow :: a -> Doc
, fieldGet :: a -> Doc
, fieldSet :: LineNo -> String -> a -> Either PError a
, fieldSet :: LineNo -> String -> a -> ParseResult a
}
simpleField :: String -> (a -> Doc) -> (ReadP a a) -> (b -> a) -> (a -> b -> b) -> StanzaField b
......@@ -170,7 +176,7 @@ type Stanza = [(LineNo,String,String)]
-- |Split a string into blank line-separated stanzas of
-- "Field: value" groups
splitStanzas :: String -> Either PError [Stanza]
splitStanzas :: String -> ParseResult [Stanza]
splitStanzas = mapM (mapM brk) . map merge . groupStanzas . filter validLine . zip [1..] . lines
where validLine (_,s) = case dropWhile isSpace s of
'-':'-':_ -> False -- Comment
......@@ -185,7 +191,7 @@ allSpaces (_,xs) = all isSpace xs
-- |Split a file into "Field: value" groups, but blank lines have no
-- significance, unlike 'splitStanzas'. A field value may span over blank
-- lines.
singleStanza :: String -> Either PError Stanza
singleStanza :: String -> ParseResult Stanza
singleStanza = mapM brk . merge . filter validLine . zip [1..] . lines
where validLine (_,s) = case dropWhile isSpace s of
'-':'-':_ -> False -- Comment
......@@ -199,7 +205,7 @@ merge ((n,x):(_,c:s):ys)
merge ((n,x):ys) = (n,x) : merge ys
merge [] = []
brk :: (Int,String) -> Either PError (Int,String,String)
brk :: (Int,String) -> ParseResult (Int,String,String)
brk (n,xs) = case break (==':') xs of
(fld, ':':val) -> return (n, map toLower fld, dropWhile isSpace val)
(_, _) -> fail $ "Line "++show n++": Invalid syntax (no colon after field name)"
......
......@@ -48,13 +48,13 @@ import Distribution.PreProcess.Unlit(unlit)
import Distribution.PackageDescription (setupMessage, PackageDescription(..),
BuildInfo(..), Executable(..),
biModules, withLib)
import Distribution.Setup (CompilerFlavor(..), compilerFlavor)
import Distribution.Setup (CompilerFlavor(..), Compiler(compilerFlavor))
import Distribution.Simple.Configure (LocalBuildInfo(..))
import Distribution.Simple.Utils (rawSystemPath, moduleToFilePath, die)
import Control.Monad (when)
import Data.Maybe (fromMaybe, maybeToList)
import System.Exit (ExitCode(..))
import System.Directory (removeFile)
import System.Directory (removeFile, getModificationTime)
import Distribution.Compat.FilePath
(splitFileExt, joinFileName, joinFileExt)
......@@ -82,40 +82,49 @@ preprocessSources pkg_descr lbi handlers = do
withLib pkg_descr () $ \ bi -> do
let biHandlers = localHandlers bi
sequence_ [preprocessModule [hsSourceDir bi] mod biHandlers |
sequence_ [preprocessModule [hsSourceDir bi] mod builtinSuffixes biHandlers |
mod <- biModules bi] -- FIX: output errors?
setupMessage "Preprocessing executables for" pkg_descr
foreachBuildInfo False pkg_descr $ \ bi -> do
let biHandlers = localHandlers bi
sequence_ [preprocessModule ((hsSourceDir bi)
:(maybeToList (library pkg_descr >>= Just . hsSourceDir)))
mod biHandlers |
mod builtinSuffixes biHandlers |
mod <- biModules bi] -- FIX: output errors?
where hc = compilerFlavor (compiler lbi)
builtinSuffixes
| hc == NHC = ["hs", "lhs", "gc"]
| otherwise = ["hs", "lhs"]
trivialHandlers = [(ext, Nothing) | ext <- builtinSuffixes]
localHandlers bi = trivialHandlers ++
[(ext, Just (h pkg_descr bi lbi)) | (ext, h) <- handlers]
localHandlers bi = [(ext, h pkg_descr bi lbi) | (ext, h) <- handlers]
-- |Find the first extension of the file that exists, and preprocess it
-- if required.
preprocessModule
:: [FilePath] -- ^source directories
-> String -- ^module name
-> [(String, Maybe PreProcessor)] -- ^possible preprocessors
-> [String] -- ^builtin suffixes
-> [(String, PreProcessor)] -- ^possible preprocessors
-> IO ExitCode
preprocessModule searchLoc mod handlers = do
srcFiles <- moduleToFilePath searchLoc mod (map fst handlers)
case srcFiles of
[] -> die ("can't find source for " ++ mod ++ " in " ++ show searchLoc )
(srcFile:_) -> do
let (srcStem, ext) = splitFileExt srcFile
case fromMaybe (error "Internal error in preProcess module: Just expected")
(lookup ext handlers) of -- FIX: can't fail?
Nothing -> return ExitSuccess
Just pp -> pp srcFile (srcStem `joinFileExt` "hs")
preprocessModule searchLoc mod builtinSuffixes handlers = do
bsrcFiles <- moduleToFilePath searchLoc mod builtinSuffixes
psrcFiles <- moduleToFilePath searchLoc mod (map fst handlers)
case psrcFiles of
[] -> case bsrcFiles of
[] -> die ("can't find source for " ++ mod ++ " in " ++ show searchLoc)
_ -> return ExitSuccess
(psrcFile:_) -> do
let (srcStem, ext) = splitFileExt psrcFile
pp = fromMaybe (error "Internal error in preProcess module: Just expected")
(lookup ext handlers)
recomp <- case bsrcFiles of
[] -> return True
(bsrcFile:_) -> do
btime <- getModificationTime bsrcFile
ptime <- getModificationTime psrcFile
return (btime < ptime)
if recomp
then pp psrcFile (srcStem `joinFileExt` "hs")
else return ExitSuccess
removePreprocessedPackage :: PackageDescription
-> FilePath -- ^root of source tree (where to look for hsSources)
......
......@@ -69,9 +69,9 @@ import Distribution.Simple.Register ( register, unregister,
import Distribution.Simple.Configure(LocalBuildInfo(..), getPersistBuildConfig,
configure, writePersistBuildConfig, localBuildInfoFile)
import Distribution.Simple.Install(install)
import Distribution.Simple.Utils (die, removeFileRecursive, currentDir,
import Distribution.Simple.Utils (die, currentDir,
defaultPackageDesc, hookedPackageDesc,
createIfNotExists, moduleToFilePath)
moduleToFilePath)
import Distribution.License (License(..))
import Distribution.Extension (Extension(..))
import Distribution.Version (Version(..), VersionRange(..), Dependency(..),
......@@ -86,8 +86,10 @@ import System.Directory(removeFile, doesFileExist)
import Control.Monad(when)
import Data.List ( intersperse )
import System.IO (try)
import System.IO.Error (try)
import Distribution.GetOpt
import Distribution.Compat.Directory(createDirectoryIfMissing,removeDirectoryRecursive)
import Distribution.Compat.FilePath(joinFileName, dropAbsolutePrefix,
joinPaths, splitFileName, joinFileExt,
splitFileExt, changeFileExt)
......@@ -190,7 +192,7 @@ defaultMainWorker pkg_descr_in action args hooks
do lbi <- getPersistBuildConfig
let targetDir = joinPaths "dist" (joinPaths "doc" "html")
let tmpDir = joinPaths (buildDir lbi) "tmp"
createIfNotExists True targetDir
createDirectoryIfMissing True targetDir
preprocessSources pkg_descr lbi knownSuffixHandlers
inFiles <- sequence [moduleToFilePath [hsSourceDir bi] m ["hs", "lhs"]
| m <- exposedModules bi] >>= return . concat
......@@ -198,7 +200,7 @@ defaultMainWorker pkg_descr_in action args hooks
let outFiles = map (joinFileName tmpDir)
(map ((flip changeFileExt) "hs") inFiles)
code <- rawSystem "haddock" (["-h", "-o" ++ targetDir] ++ outFiles)
removeFileRecursive tmpDir
removeDirectoryRecursive tmpDir
when (code /= ExitSuccess) (exitWith code)
return code)
CleanCmd -> do
......@@ -206,7 +208,7 @@ defaultMainWorker pkg_descr_in action args hooks
pkg_descr <- hookOrInput preClean args
localbuildinfo <- getPersistBuildConfig
let buildPref = buildDir localbuildinfo
try $ removeFileRecursive buildPref
try $ removeDirectoryRecursive buildPref
try $ removeFile installedPkgConfigFile
try $ removeFile localBuildInfoFile
removePreprocessedPackage pkg_descr currentDir (ppSuffixes knownSuffixHandlers)
......@@ -288,7 +290,7 @@ defaultMainWorker pkg_descr_in action args hooks
let targetDir = joinPaths pref filePref
let targetFile = joinFileName targetDir fileName
let (targetFileNoext, targetFileExt) = splitFileExt targetFile
createIfNotExists True targetDir
createDirectoryIfMissing True targetDir
ret <- ppCpp pkg_descr bi lbi file targetFile
when (targetFileExt == "lhs")
(ppUnlit targetFile (joinFileExt targetFileNoext "hs") >> return ())
......@@ -359,20 +361,16 @@ defaultUserHooks
where readHook a = no_extra_flags a >> readHookedPackageDesc
readHook2 a _ = no_extra_flags a >> readHookedPackageDesc
defaultPreConf :: [String] -> ConfigFlags -> IO (Maybe PackageDescription)
#ifdef mingw32_TARGET_OS
defaultPreConf = readHook2
#else
defaultPreConf args (_, _, _, mb_prefix)
= do let prefix_opt pref opts = ("--prefix=" ++ pref) : opts
confExists <- doesFileExist "configure"
if confExists then do
rawSystem "./configure"
(maybe id prefix_opt mb_prefix args)
rawSystem "sh"
("configure" : maybe id prefix_opt mb_prefix args)
return ()
else
no_extra_flags args
readHookedPackageDesc
#endif
readHookedPackageDesc
= do exists <- doesFileExist hookedPackageDesc
if exists then do
......
......@@ -55,20 +55,24 @@ import Distribution.PackageDescription (PackageDescription(..), BuildInfo(..),
import Distribution.Package (PackageIdentifier(..), showPackageId)
import Distribution.PreProcess (preprocessSources, PPSuffixHandler)
import Distribution.PreProcess.Unlit (unlit)
import Distribution.Simple.Configure (LocalBuildInfo(..), compiler, exeDeps)
import Distribution.Simple.Configure (LocalBuildInfo(..), exeDeps)
import Distribution.Simple.Install (hugsMainFilename)
import Distribution.Simple.Utils (rawSystemExit, die, rawSystemPathExit,
createIfNotExists, mkLibName, dotToSep,
mkLibName, dotToSep,
moduleToFilePath, currentDir,
getOptionsFromSource, stripComments
)
import Data.Maybe(maybeToList)
import Control.Monad (unless, when)
#ifndef __NHC__
import Control.Exception (try)
#else
import IO (try)
#endif
import Data.List(nub, sort, isSuffixOf)
import System.Directory (removeFile)
import Distribution.Compat.Directory (copyFile)
import Distribution.Compat.Directory (copyFile,createDirectoryIfMissing)
import Distribution.Compat.FilePath (splitFilePath, joinFileName, joinFileExt,
searchPathSeparator, objExtension, joinPaths)
import qualified Distribution.Simple.GHCPackageConfig
......@@ -86,7 +90,7 @@ build :: PackageDescription
-> [ PPSuffixHandler ]
-> IO ()
build pkg_descr lbi suffixes = do
createIfNotExists True (buildDir lbi)
createDirectoryIfMissing True (buildDir lbi)
preprocessSources pkg_descr lbi suffixes
setupMessage "Building" pkg_descr
case compilerFlavor (compiler lbi) of
......@@ -116,9 +120,9 @@ buildGHC pkg_descr lbi = do
pkgConfReadable <- GHC.canReadLocalPackageConfig
-- Build lib
withLib pkg_descr () $ \buildInfo' -> do
createIfNotExists True (pref `joinFileName` (hsSourceDir buildInfo'))
createDirectoryIfMissing True (pref `joinFileName` (hsSourceDir buildInfo'))
let args = ["-I" ++ dir | dir <- includeDirs buildInfo']
++ ccOptions pkg_descr
++ ["-optc" ++ opt | opt <- ccOptions pkg_descr]
++ (if pkgConfReadable then ["-package-conf", pkgConf] else [])
++ ["-package-name", pkgName (package pkg_descr),
"-odir", pref `joinFileName` (hsSourceDir buildInfo'),
......@@ -132,9 +136,9 @@ buildGHC pkg_descr lbi = do
-- build any C sources
unless (null (cSources buildInfo')) $
sequence_ [do let odir = pref `joinFileName` dirOf c
createIfNotExists True odir
createDirectoryIfMissing True odir
let args = ["-I" ++ dir | dir <- includeDirs buildInfo']
++ ccOptions pkg_descr
++ ["-optc" ++ opt | opt <- ccOptions pkg_descr]
++ ["-odir", odir, "-hidir", pref, "-c"]
rawSystemExit ghcPath (args ++ [c])
| c <- cSources buildInfo']
......@@ -150,12 +154,12 @@ buildGHC pkg_descr lbi = do
rawSystemPathExit "ar" (["q", lib] ++ [pref `joinFileName` x | x <- hObjs ++ cObjs])
-- build any executables
sequence_ [ do createIfNotExists True (pref `joinFileName` (hsSourceDir exeBi))
sequence_ [ do createDirectoryIfMissing True (pref `joinFileName` (hsSourceDir exeBi))
let targetDir = pref `joinFileName` hsSourceDir exeBi
let exeDir = joinPaths targetDir (exeName' ++ "-tmp")
createIfNotExists True exeDir
createDirectoryIfMissing True exeDir
let args = ["-I" ++ dir | dir <- includeDirs exeBi]
++ ccOptions pkg_descr
++ ["-optc" ++ opt | opt <- ccOptions pkg_descr]
++ (if pkgConfReadable then ["-package-conf", pkgConf] else [])
++ ["-odir", exeDir,
"-hidir", exeDir,
......@@ -226,7 +230,7 @@ buildHugs pkg_descr lbi = do
-- Copy or cpp a file from the source directory to the build directory.
copyModule :: Bool -> BuildInfo -> FilePath -> FilePath -> IO ()
copyModule cppAll bi srcFile destFile = do
createIfNotExists True (dirOf destFile)
createDirectoryIfMissing True (dirOf destFile)
(exts, opts) <- getOptionsFromSource srcFile
let ghcOpts = hcOptions GHC opts
if cppAll || CPP `elem` exts || "-cpp" `elem` ghcOpts then
......
......@@ -25,7 +25,11 @@ import Distribution.Package (PackageIdentifier(..), showPackageId)
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
import Distribution.Simple.Install (mkLibDir)
#ifndef __NHC__
import Control.Exception (try)
#else
import IO (try)
#endif
import Control.Monad(unless)
import Text.PrettyPrint.HughesPJ
import System.Directory (doesFileExist, getPermissions, Permissions (..))
......
......@@ -60,15 +60,14 @@ import Distribution.PackageDescription (
PackageDescription(..), BuildInfo(..), Executable(..),
setupMessage, hasLibs, withLib, libModules, exeModules, biModules,
hcOptions)
import Distribution.Package (showPackageId, pkgName)
import Distribution.Package (showPackageId, PackageIdentifier(pkgName))
import Distribution.Simple.LocalBuildInfo(LocalBuildInfo(..))
import Distribution.Simple.Utils(moveSources, mkLibName, removeFileRecursive,
die, createIfNotExists)
import Distribution.Simple.Utils(moveSources, mkLibName, die)
import Distribution.Setup (CompilerFlavor(..), Compiler(..))
import Control.Monad(when, unless)
import Data.Maybe(fromMaybe)
import Distribution.Compat.Directory(copyFile)
import Distribution.Compat.Directory(copyFile,createDirectoryIfMissing,removeDirectoryRecursive)
import Distribution.Compat.FilePath(joinFileName, dllExtension,
splitFileExt, joinFileExt)
import System.IO.Error(try)
......@@ -102,7 +101,7 @@ installExeGhc :: FilePath -- ^install location
-> FilePath -- ^Build location
-> PackageDescription -> IO ()
installExeGhc pref buildPref pkg_descr
= do createIfNotExists True pref