[commit: ghc] wip/nfs-locking: Move matchBuildResult to Way.hs. (1711977)

[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/1711977649e14d87093d0f4ff0de132d1c044e42/ghc

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

commit 1711977649e14d87093d0f4ff0de132d1c044e42
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Thu Aug 6 01:34:24 2015 +0100

    Move matchBuildResult to Way.hs.


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

1711977649e14d87093d0f4ff0de132d1c044e42
 src/Way.hs | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/src/Way.hs b/src/Way.hs
index 912ea63..365a949 100644
--- a/src/Way.hs
+++ b/src/Way.hs
@@ -10,7 +10,7 @@ module Way ( -- TODO: rename to "Way"?
     loggingDynamic, threadedLoggingDynamic,
 
     wayPrefix, hisuf, osuf, hcsuf, obootsuf, ssuf, libsuf,
-    detectWay
+    detectWay, matchBuildResult
     ) where
 
 import Base
@@ -20,6 +20,7 @@ import Data.List
 import Data.IntSet (IntSet)
 import Control.Applicative
 import qualified Data.IntSet as Set
+import Data.Maybe
 
 data WayUnit = Threaded
              | Debug
@@ -135,6 +136,13 @@ detectWay file = case reads prefix of
   where
     prefix = dropWhileEnd (== '_') . dropWhileEnd (/= '_') $ takeExtension file
 
+-- Given a path, an extension suffix, and a file name check if the latter:
+-- 1) conforms to pattern 'path//*suffix'
+-- 2) has extension prefixed with a known way tag, i.e. detectWay does not fail
+matchBuildResult :: FilePath -> String -> FilePath -> Bool
+matchBuildResult path suffix file =
+    (path <//> "*" ++ suffix) ?== file && (isJust . detectWay $ file)
+
 -- Instances for storing in the Shake database
 instance Binary Way where
     put = put . show