[commit: ghc] wip/nfs-locking: Minor revision (72bf4b1)

[git at git.haskell.org]

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

On branch  : wip/nfs-locking
Link       : http://ghc.haskell.org/trac/ghc/changeset/72bf4b180dffa10fb650046b571b756b5262097a/ghc

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

commit 72bf4b180dffa10fb650046b571b756b5262097a
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Sat Aug 12 21:51:16 2017 +0100

    Minor revision


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

72bf4b180dffa10fb650046b571b756b5262097a
 src/Base.hs              | 29 ++---------------------------
 src/Hadrian/Utilities.hs | 23 ++++++++++++++++++++++-
 src/Rules/Library.hs     | 15 +++++++--------
 src/Rules/Register.hs    |  2 +-
 4 files changed, 32 insertions(+), 37 deletions(-)

diff --git a/src/Base.hs b/src/Base.hs
index 6ae3ead..df14d3d 100644
--- a/src/Base.hs
+++ b/src/Base.hs
@@ -17,15 +17,13 @@ module Base (
     configPath, configFile, sourcePath,
 
     -- * Miscellaneous utilities
-    unifyPath, quote, (-/-), matchVersionedFilePath, matchGhcVersionedFilePath,
-    putColoured
+    unifyPath, quote, (-/-), putColoured
     ) where
 
 import Control.Applicative
 import Control.Monad.Extra
 import Control.Monad.Reader
 import Data.Bifunctor
-import Data.Char
 import Data.Function
 import Data.List.Extra
 import Data.Maybe
@@ -58,30 +56,7 @@ configFile = configPath -/- "system.config"
 sourcePath :: FilePath
 sourcePath = hadrianPath -/- "src"
 
--- | Given a @prefix@ and a @suffix@ check whether a @filePath@ matches the
--- template @prefix ++ version ++ suffix@ where @version@ is an arbitrary string
--- comprising digits (@0-9@), dashes (@-@), and dots (@.@). Examples:
---
---- * @'matchVersionedFilePath' "foo/bar"  ".a" "foo/bar.a"     '==' 'True'@
---- * @'matchVersionedFilePath' "foo/bar"  ".a" "foo\bar.a"     '==' 'False'@
---- * @'matchVersionedFilePath' "foo/bar"  "a"  "foo/bar.a"     '==' 'True'@
---- * @'matchVersionedFilePath' "foo/bar"  ""   "foo/bar.a"     '==' 'False'@
---- * @'matchVersionedFilePath' "foo/bar"  "a"  "foo/bar-0.1.a" '==' 'True'@
---- * @'matchVersionedFilePath' "foo/bar-" "a"  "foo/bar-0.1.a" '==' 'True'@
---- * @'matchVersionedFilePath' "foo/bar/" "a"  "foo/bar-0.1.a" '==' 'False'@
-matchVersionedFilePath :: String -> String -> FilePath -> Bool
-matchVersionedFilePath prefix suffix filePath =
-    case stripPrefix prefix filePath >>= stripSuffix suffix of
-        Nothing      -> False
-        Just version -> all (\c -> isDigit c || c == '-' || c == '.') version
-
-matchGhcVersionedFilePath :: String -> String -> FilePath -> Bool
-matchGhcVersionedFilePath prefix ext filePath =
-    case stripPrefix prefix filePath >>= stripSuffix ext of
-        Nothing -> False
-        Just _  -> True
-
--- | A more colourful version of Shake's putNormal.
+-- | A more colourful version of Shake's 'putNormal'.
 putColoured :: ColorIntensity -> Color -> String -> Action ()
 putColoured intensity colour msg = do
     c <- useColour
diff --git a/src/Hadrian/Utilities.hs b/src/Hadrian/Utilities.hs
index 56b53ce..f26a444 100644
--- a/src/Hadrian/Utilities.hs
+++ b/src/Hadrian/Utilities.hs
@@ -7,9 +7,11 @@ module Hadrian.Utilities (
     quote, yesNo,
 
     -- * FilePath manipulation
-    unifyPath, (-/-)
+    unifyPath, (-/-), matchVersionedFilePath
     ) where
 
+import Data.Char
+import Data.List.Extra
 import Development.Shake.FilePath
 
 -- | Extract a value from a singleton list, or terminate with an error message
@@ -79,3 +81,22 @@ a  -/- b
     | otherwise     = a ++ '/' : b
 
 infixr 6 -/-
+
+-- | Given a @prefix@ and a @suffix@ check whether a 'FilePath' matches the
+-- template @prefix ++ version ++ suffix@ where @version@ is an arbitrary string
+-- comprising digits (@0-9@), dashes (@-@), and dots (@.@). Examples:
+--
+-- @
+-- 'matchVersionedFilePath' "foo/bar"  ".a" "foo/bar.a"     '==' 'True'
+-- 'matchVersionedFilePath' "foo/bar"  ".a" "foo\bar.a"     '==' 'False'
+-- 'matchVersionedFilePath' "foo/bar"  "a"  "foo/bar.a"     '==' 'True'
+-- 'matchVersionedFilePath' "foo/bar"  ""   "foo/bar.a"     '==' 'False'
+-- 'matchVersionedFilePath' "foo/bar"  "a"  "foo/bar-0.1.a" '==' 'True'
+-- 'matchVersionedFilePath' "foo/bar-" "a"  "foo/bar-0.1.a" '==' 'True'
+-- 'matchVersionedFilePath' "foo/bar/" "a"  "foo/bar-0.1.a" '==' 'False'
+-- @
+matchVersionedFilePath :: String -> String -> FilePath -> Bool
+matchVersionedFilePath prefix suffix filePath =
+    case stripPrefix prefix filePath >>= stripSuffix suffix of
+        Nothing      -> False
+        Just version -> all (\c -> isDigit c || c == '-' || c == '.') version
diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs
index ba3138a..7b32f55 100644
--- a/src/Rules/Library.hs
+++ b/src/Rules/Library.hs
@@ -3,6 +3,7 @@ module Rules.Library (
 ) where
 
 import Data.Char
+import Hadrian.Utilities
 import qualified System.Directory as IO
 
 import Base
@@ -38,24 +39,22 @@ libraryObjects context at Context{..} = do
 
 buildDynamicLib :: Context -> Rules ()
 buildDynamicLib context at Context{..} = do
-    let path       = buildPath context
-        libPrefix  = path -/- "libHS" ++ pkgNameString package
+    let libPrefix = buildPath context -/- "libHS" ++ pkgNameString package
     -- OS X
-    matchGhcVersionedFilePath libPrefix "dylib" ?> buildDynamicLibUnix
+    libPrefix ++ "*.dylib" %> buildDynamicLibUnix
     -- Linux
-    matchGhcVersionedFilePath libPrefix "so"    ?> buildDynamicLibUnix
+    libPrefix ++ "*.so"    %> buildDynamicLibUnix
     -- TODO: Windows
   where
-    buildDynamicLibUnix so = do
+    buildDynamicLibUnix lib = do
         deps <- contextDependencies context
         need =<< mapM pkgLibraryFile deps
         objs <- libraryObjects context
-        build $ target context (Ghc LinkHs stage) objs [so]
+        build $ target context (Ghc LinkHs stage) objs [lib]
 
 buildPackageLibrary :: Context -> Rules ()
 buildPackageLibrary context at Context {..} = do
-    let path       = buildPath context
-        libPrefix  = path -/- "libHS" ++ pkgNameString package
+    let libPrefix  = buildPath context -/- "libHS" ++ pkgNameString package
     matchVersionedFilePath libPrefix (waySuffix way <.> "a") ?> \a -> do
         objs <- libraryObjects context
         asuf <- libsuf way
diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs
index 1f5f64a..7ec8bcd 100644
--- a/src/Rules/Register.hs
+++ b/src/Rules/Register.hs
@@ -16,7 +16,7 @@ registerPackage rs context at Context {..} = when (stage <= Stage1) $ do
     let confIn = pkgInplaceConfig context
         dir    = inplacePackageDbDirectory stage
 
-    matchVersionedFilePath (dir -/- pkgNameString package) "conf" ?> \conf -> do
+    dir -/- pkgNameString package ++ "*.conf" %> \conf -> do
         need [confIn]
         buildWithResources rs $
             target context (GhcPkg Update stage) [confIn] [conf]