[commit: ghc] wip/nfs-locking: Replace path with instance ShowAction Builder. (37de3d5)

[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/37de3d57c7e35237dea4f11c2cb2016eedeb49c5/ghc

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

commit 37de3d57c7e35237dea4f11c2cb2016eedeb49c5
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Fri Jan 2 02:34:56 2015 +0000

    Replace path with instance ShowAction Builder.


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

37de3d57c7e35237dea4f11c2cb2016eedeb49c5
 src/Oracles/Builder.hs | 73 +++++++++++++++++++++++---------------------------
 1 file changed, 34 insertions(+), 39 deletions(-)

diff --git a/src/Oracles/Builder.hs b/src/Oracles/Builder.hs
index 6c37ec0..3da6f9a 100644
--- a/src/Oracles/Builder.hs
+++ b/src/Oracles/Builder.hs
@@ -2,7 +2,7 @@
 
 module Oracles.Builder (
     Builder (..),
-    path, with, run, argPath,
+    with, run,
     hsColourSrcs
     ) where
 
@@ -14,39 +14,34 @@ import Oracles.Option
 
 data Builder = Ar | Ld | Gcc | Alex | Happy | HsColour | GhcCabal | GhcPkg Stage | Ghc Stage
 
-path :: Builder -> Action FilePath
-path builder = do
-    let key = case builder of
-            Ar            -> "ar"
-            Ld            -> "ld"
-            Gcc           -> "gcc"
-            Alex          -> "alex"
-            Happy         -> "happy"
-            HsColour      -> "hscolour"
-            GhcCabal      -> "ghc-cabal"
-            Ghc Stage0    -> "system-ghc"     -- Ghc Stage0 is the bootstrapping compiler 
-            Ghc Stage1    -> "ghc-stage1"     -- Ghc StageN, N > 0, is the one built on stage (N - 1)
-            Ghc Stage2    -> "ghc-stage2"
-            Ghc Stage3    -> "ghc-stage3"
-            GhcPkg Stage0 -> "system-ghc-pkg" -- GhcPkg Stage0 is the bootstrapping GhcPkg 
-            GhcPkg _      -> "ghc-pkg"        -- GhcPkg StageN, N > 0, is the one built on stage 0 (TODO: need only Stage1?)
-    cfgPath <- askConfigWithDefault key $
-        error $ "\nCannot find path to '"
-        ++ key
-        ++ "' in configuration files."
-    let cfgPathExe = if cfgPath /= "" then cfgPath -<.> exe else ""
-    windows <- windowsHost
-    if (windows && "/" `isPrefixOf` cfgPathExe)
-    then do
-        Stdout out <- quietly $ cmd ["cygpath", "-m", "/"]
-        return $ dropWhileEnd isSpace out ++ drop 1 cfgPathExe
-    else
-        return cfgPathExe
-
-argPath :: Builder -> Args
-argPath builder = do
-    path <- path builder
-    arg [path]
+instance ShowAction Builder where
+    showAction builder = do
+        let key = case builder of
+                Ar            -> "ar"
+                Ld            -> "ld"
+                Gcc           -> "gcc"
+                Alex          -> "alex"
+                Happy         -> "happy"
+                HsColour      -> "hscolour"
+                GhcCabal      -> "ghc-cabal"
+                Ghc Stage0    -> "system-ghc"     -- Ghc Stage0 is the bootstrapping compiler 
+                Ghc Stage1    -> "ghc-stage1"     -- Ghc StageN, N > 0, is the one built on stage (N - 1)
+                Ghc Stage2    -> "ghc-stage2"
+                Ghc Stage3    -> "ghc-stage3"
+                GhcPkg Stage0 -> "system-ghc-pkg" -- GhcPkg Stage0 is the bootstrapping GhcPkg 
+                GhcPkg _      -> "ghc-pkg"        -- GhcPkg StageN, N > 0, is the one built on stage 0 (TODO: need only Stage1?)
+        cfgPath <- askConfigWithDefault key $
+            error $ "\nCannot find path to '"
+            ++ key
+            ++ "' in configuration files."
+        let cfgPathExe = if cfgPath /= "" then cfgPath -<.> exe else ""
+        windows <- windowsHost
+        if (windows && "/" `isPrefixOf` cfgPathExe)
+        then do
+            Stdout out <- quietly $ cmd ["cygpath", "-m", "/"]
+            return $ dropWhileEnd isSpace out ++ drop 1 cfgPathExe
+        else
+            return cfgPathExe
 
 -- When LaxDeps flag is set (by adding 'lax-dependencies = YES' to user.config),
 -- dependencies on the GHC executable are turned into order-only dependencies to
@@ -55,12 +50,12 @@ argPath builder = do
 -- the flag (at least temporarily).
 needBuilder :: Builder -> Action ()
 needBuilder ghc @ (Ghc stage) = do
-    target  <- path ghc
+    target  <- showAction ghc
     laxDeps <- test LaxDeps
     if laxDeps then orderOnly [target] else need [target]
 
 needBuilder builder = do 
-    target <- path builder
+    target <- showAction builder
     need [target]
 
 -- Action 'with Gcc' returns an argument '--with-gcc=/path/to/gcc' and needs the builder 
@@ -75,18 +70,18 @@ with builder = do
             Happy    -> "--with-happy="
             GhcPkg _ -> "--with-ghc-pkg="
             HsColour -> "--with-hscolour="
-    suffix <- path builder
+    suffix <- showAction builder
     needBuilder builder
     return [prefix ++ suffix]
 
 run :: Builder -> Args -> Action ()
 run builder args = do
     needBuilder builder
-    exe   <- path builder
+    exe   <- showAction builder
     args' <- args
     cmd [exe :: FilePath] args'
 
 hsColourSrcs :: Condition
 hsColourSrcs = do
-    hscolour <- path HsColour
+    hscolour <- showAction HsColour
     return $ hscolour /= ""