[commit: ghc] wip/nfs-locking: Make detectWay safe, add comments. (7ebd24f)

[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/7ebd24fe9d9177e65d5823d02a73c6a1776d85b2/ghc

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

commit 7ebd24fe9d9177e65d5823d02a73c6a1776d85b2
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Wed Aug 5 23:24:15 2015 +0100

    Make detectWay safe, add comments.


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

7ebd24fe9d9177e65d5823d02a73c6a1776d85b2
 src/Way.hs | 13 +++++++++----
 1 file changed, 9 insertions(+), 4 deletions(-)

diff --git a/src/Way.hs b/src/Way.hs
index b48a29d..912ea63 100644
--- a/src/Way.hs
+++ b/src/Way.hs
@@ -124,11 +124,16 @@ libsuf way @ (Way set) =
         -- e.g., p_ghc7.11.20141222.dll (the result)
         return $ prefix ++ "ghc" ++ version ++ extension
 
--- Detect way from a given file extension. Fails if there is no match.
-detectWay :: FilePath -> Way
-detectWay extension = read prefix
+-- Detect way from a given filename. Returns Nothing if there is no match:
+-- * detectWay "foo/bar.hi"  == Just vanilla
+-- * detectWay "baz.thr_p_o" == Just threadedProfiling
+-- * detectWay "qwe.phi"     == Nothing (expected "qwe.p_hi")
+detectWay :: FilePath -> Maybe Way
+detectWay file = case reads prefix of
+    [(way, "")] -> Just way
+    _           -> Nothing
   where
-    prefix = dropWhileEnd (== '_') . dropWhileEnd (/= '_') $ extension
+    prefix = dropWhileEnd (== '_') . dropWhileEnd (/= '_') $ takeExtension file
 
 -- Instances for storing in the Shake database
 instance Binary Way where