[commit: hadrian] master: Fix lint error (#575) (5b8f442)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/hadrian

On branch  : master
Link       : http://git.haskell.org/hadrian.git/commitdiff/5b8f442f1ac886496ac1b7f8c0234171f8f5f199

>---------------------------------------------------------------

commit 5b8f442f1ac886496ac1b7f8c0234171f8f5f199
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Tue Apr 17 01:31:33 2018 +0100

    Fix lint error (#575)
    
    * Minor revision
    
    * Use untracked doesFileExist


>---------------------------------------------------------------

5b8f442f1ac886496ac1b7f8c0234171f8f5f199
 src/Rules/Register.hs | 44 ++++++++++++++++++++++++--------------------
 1 file changed, 24 insertions(+), 20 deletions(-)

diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs
index ed0cb2b..b66f085 100644
--- a/src/Rules/Register.hs
+++ b/src/Rules/Register.hs
@@ -10,6 +10,7 @@ import Utilities
 import Distribution.ParseUtils
 import qualified Distribution.Compat.ReadP as Parse
 import Distribution.Version (Version)
+import qualified System.Directory as IO
 
 import Hadrian.Expression
 import Hadrian.Haskell.Cabal.Parse as Cabal
@@ -22,24 +23,24 @@ parseCabalName = readPToMaybe parse
 -- by running the @ghc-pkg@ utility.
 registerPackages :: [(Resource, Int)] -> Context -> Rules ()
 registerPackages rs context at Context {..} = do
-  root <- buildRootRules
-  root -/- relativePackageDbPath stage %>
-    buildStamp rs context
-
-  root -/- relativePackageDbPath stage -/- packageDbStamp %> \stamp ->
-    writeFileLines stamp []
-
-  root -/- relativePackageDbPath stage -/- "*.conf" %> \conf -> do
-    settings <- libPath context <&> (-/- "settings")
-    platformConstants <- libPath context <&> (-/- "platformConstants")
-    need [settings, platformConstants]
-    let Just pkgName | takeBaseName conf == "rts" = Just "rts"
-                     | otherwise = fst <$> parseCabalName (takeBaseName conf)
-    let Just pkg = findPackageByName pkgName
-    bootLibs <- filter isLibrary <$> stagePackages Stage0
-    case stage of
-      Stage0 | pkg `notElem` bootLibs -> copyConf rs (context { package = pkg }) conf
-      _                               -> buildConf rs (context { package = pkg }) conf
+    root <- buildRootRules
+    root -/- relativePackageDbPath stage %> buildStamp rs context
+
+    root -/- relativePackageDbPath stage -/- packageDbStamp %> \stamp ->
+        writeFileLines stamp []
+
+    -- TODO: Add proper error handling for partial functions.
+    root -/- relativePackageDbPath stage -/- "*.conf" %> \conf -> do
+        settings <- libPath context <&> (-/- "settings")
+        platformConstants <- libPath context <&> (-/- "platformConstants")
+        need [settings, platformConstants]
+        let Just pkgName | takeBaseName conf == "rts" = Just "rts"
+                         | otherwise = fst <$> parseCabalName (takeBaseName conf)
+        let Just pkg = findPackageByName pkgName
+        isBoot <- (pkg `notElem`) <$> stagePackages Stage0
+        case stage of
+            Stage0 | isBoot -> copyConf  rs (context { package = pkg }) conf
+            _               -> buildConf rs (context { package = pkg }) conf
 
 buildConf :: [(Resource, Int)] -> Context -> FilePath -> Action ()
 buildConf _ context at Context {..} _conf = do
@@ -76,13 +77,16 @@ buildConf _ context at Context {..} _conf = do
 copyConf :: [(Resource, Int)] -> Context -> FilePath -> Action ()
 copyConf rs context at Context {..} conf = do
     depPkgIds <- fmap stdOutToPkgIds . askWithResources rs $
-      target context (GhcPkg Dependencies stage) [pkgName package] []
+        target context (GhcPkg Dependencies stage) [pkgName package] []
     need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds
     -- We should unregister if the file exists since @ghc-pkg@ will complain
     -- about existing package: https://github.com/snowleopard/hadrian/issues/543.
     -- Also, we don't always do the unregistration + registration to avoid
     -- repeated work after a full build.
-    unlessM (doesFileExist conf) $ do
+    -- We do not track 'doesFileExist' since we are going to create the file if
+    -- it is currently missing. TODO: Is this the right thing to do?
+    -- See https://github.com/snowleopard/hadrian/issues/569.
+    unlessM (liftIO $ IO.doesFileExist conf) $ do
         buildWithResources rs $
             target context (GhcPkg Unregister stage) [pkgName package] []
         buildWithResources rs $