[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:34:46 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