[commit: ghc] wip/nfs-locking: Add removeFile to Util.hs. (6b0b4ab)
git at git.haskell.org
git at git.haskell.org
Thu Oct 26 23:17:44 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/nfs-locking
Link : http://ghc.haskell.org/trac/ghc/changeset/6b0b4ab1c3d88df4e67d9ade22f45fcd8369708b/ghc
>---------------------------------------------------------------
commit 6b0b4ab1c3d88df4e67d9ade22f45fcd8369708b
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date: Tue Aug 11 02:48:11 2015 +0100
Add removeFile to Util.hs.
>---------------------------------------------------------------
6b0b4ab1c3d88df4e67d9ade22f45fcd8369708b
src/Rules/Compile.hs | 2 --
src/Rules/Dependencies.hs | 3 +--
src/Rules/Library.hs | 10 +++++-----
src/Util.hs | 12 +++++++++++-
4 files changed, 17 insertions(+), 10 deletions(-)
diff --git a/src/Rules/Compile.hs b/src/Rules/Compile.hs
index 43659b9..30a77cb 100644
--- a/src/Rules/Compile.hs
+++ b/src/Rules/Compile.hs
@@ -17,8 +17,6 @@ compilePackage _ target = do
pkg = Target.package target
path = targetPath stage pkg
buildPath = path -/- "build"
- cDepsFile = buildPath -/- "c.deps"
- hDepsFile = buildPath -/- "haskell.deps"
matchBuildResult buildPath "hi" ?> \hi ->
need [ hi -<.> osuf (detectWay hi) ]
diff --git a/src/Rules/Dependencies.hs b/src/Rules/Dependencies.hs
index 8fb890e..e63d27d 100644
--- a/src/Rules/Dependencies.hs
+++ b/src/Rules/Dependencies.hs
@@ -11,7 +11,6 @@ import Settings.Util
import Settings.TargetDirectory
import Rules.Actions
import Rules.Resources
-import qualified System.Directory as IO
buildPackageDependencies :: Resources -> StagePackageTarget -> Rules ()
buildPackageDependencies _ target =
@@ -31,7 +30,7 @@ buildPackageDependencies _ target =
srcs <- interpret target getPackageSources
need srcs
build $ fullTarget target (GhcM stage) srcs [file]
- liftIO . IO.removeFile $ file <.> "bak"
+ removeFile $ file <.> "bak"
(buildPath -/- ".dependencies") %> \file -> do
cSrcs <- pkgDataList $ CSrcs path
diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs
index 4619651..5956030 100644
--- a/src/Rules/Library.hs
+++ b/src/Rules/Library.hs
@@ -25,7 +25,7 @@ buildPackageLibrary _ target = do
-- TODO: handle dynamic libraries
matchBuildResult buildPath "a" ?> \a -> do
- liftIO $ IO.removeFile a
+ removeFile a
cSrcs <- interpret target $ getPkgDataList CSrcs
modules <- interpret target $ getPkgDataList Modules
@@ -34,17 +34,17 @@ buildPackageLibrary _ target = do
cObjs = [ buildPath -/- src -<.> osuf way | src <- cSrcs ]
hObjs = [ buildPath -/- src <.> osuf way | src <- hSrcs ]
- -- This will create split objects if required (we don't track them)
+ -- This will create split objects if required (we don't track them
+ -- explicitly as this would needlessly bloat the Shake database).
need $ cObjs ++ hObjs
split <- interpret target splitObjects
- splitObjs <- if split
- then fmap concat $ forM hSrcs $ \src -> do
+ splitObjs <- if not split then return [] else
+ fmap concat $ forM hSrcs $ \src -> do
let splitPath = buildPath -/- src ++ "_" ++ osuf way ++ "_split"
contents <- liftIO $ IO.getDirectoryContents splitPath
return . map (splitPath -/-)
. filter (not . all (== '.')) $ contents
- else return []
build $ fullTarget target Ar (cObjs ++ hObjs ++ splitObjs) [a]
diff --git a/src/Util.hs b/src/Util.hs
index dd0f2d8..b78592a 100644
--- a/src/Util.hs
+++ b/src/Util.hs
@@ -5,13 +5,16 @@ module Util (
unifyPath, (-/-),
chunksOfSize,
putColoured, putOracle, putBuild, putSuccess, putError,
- bimap, minusOrd, intersectOrd
+ bimap, minusOrd, intersectOrd,
+ removeFile
) where
import Base
import Data.Char
+import Control.Monad
import System.IO
import System.Console.ANSI
+import qualified System.Directory as IO
replaceIf :: (a -> Bool) -> a -> [a] -> [a]
replaceIf p to = map (\from -> if p from then to else from)
@@ -100,3 +103,10 @@ intersectOrd cmp = loop
LT -> loop xs (y:ys)
EQ -> x : loop xs ys
GT -> loop (x:xs) ys
+
+-- Convenient helper function for removing a single file that doesn't
+-- necessarily exist.
+removeFile :: FilePath -> Action ()
+removeFile file = do
+ exists <- liftIO $ IO.doesFileExist file
+ when exists . liftIO $ IO.removeFile file
More information about the ghc-commits
mailing list