[commit: ghc] wip/nfs-locking: Handle dyamic libraries in detectWay. (83cd6c5)

[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/83cd6c55ba8eeebe877cc643308435afe3c3d785/ghc

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

commit 83cd6c55ba8eeebe877cc643308435afe3c3d785
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Fri Aug 7 01:07:24 2015 +0100

    Handle dyamic libraries in detectWay.


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

83cd6c55ba8eeebe877cc643308435afe3c3d785
 src/Way.hs | 14 ++++++++++----
 1 file changed, 10 insertions(+), 4 deletions(-)

diff --git a/src/Way.hs b/src/Way.hs
index 365a949..3046867 100644
--- a/src/Way.hs
+++ b/src/Way.hs
@@ -126,15 +126,21 @@ libsuf way @ (Way set) =
         return $ prefix ++ "ghc" ++ version ++ extension
 
 -- 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 "foo/bar.hi"                 == Just vanilla
+-- * detectWay "baz.thr_p_o"                == Just threadedProfiling
+-- * detectWay "qwe.phi"                    == Nothing (expected "qwe.p_hi")
+-- * detectWay "xru.p_ghc7.11.20141222.dll" == Just profiling
 detectWay :: FilePath -> Maybe Way
 detectWay file = case reads prefix of
     [(way, "")] -> Just way
     _           -> Nothing
   where
-    prefix = dropWhileEnd (== '_') . dropWhileEnd (/= '_') $ takeExtension file
+    extension = takeExtension file
+    prefixed  = if extension `notElem` ["so", "dll", "dynlib"]
+                then extension
+                else takeExtension . dropExtension .
+                     dropExtension . dropExtension $ file
+    prefix    = dropWhileEnd (== '_') . dropWhileEnd (/= '_') $ prefixed
 
 -- Given a path, an extension suffix, and a file name check if the latter:
 -- 1) conforms to pattern 'path//*suffix'