[commit: ghc] wip/nfs-locking: Move generic helper functions to Util.hs. (4e5f1b7)

[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/4e5f1b74b9b5946ad614bc354f01697f953a072b/ghc

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

commit 4e5f1b74b9b5946ad614bc354f01697f953a072b
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Tue Dec 30 15:06:13 2014 +0000

    Move generic helper functions to Util.hs.


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

4e5f1b74b9b5946ad614bc354f01697f953a072b
 src/Base.hs    |  8 +-------
 src/Oracles.hs |  9 ++++-----
 src/Package.hs |  5 +++--
 src/Util.hs    | 16 ++++++++++++++++
 4 files changed, 24 insertions(+), 14 deletions(-)

diff --git a/src/Base.hs b/src/Base.hs
index eaebaf3..24943e4 100644
--- a/src/Base.hs
+++ b/src/Base.hs
@@ -9,8 +9,7 @@ module Base (
     Stage (..),
     Args, arg,
     joinArgs, joinArgsWithSpaces,
-    filterOut,
-    replaceChar
+    filterOut
     ) where
 
 import Development.Shake hiding ((*>))
@@ -43,8 +42,3 @@ joinArgs = intercalateArgs ""
 
 filterOut :: Args -> [String] -> Args
 filterOut args list = filter (`notElem` list) <$> args
-
-replaceChar :: Char -> Char -> String -> String
-replaceChar from to = (go from) . if from == '/' then go '\\' else id
-  where
-    go from' = map (\c -> if c == from' then to else c)
diff --git a/src/Oracles.hs b/src/Oracles.hs
index 6a03a6d..98321c9 100644
--- a/src/Oracles.hs
+++ b/src/Oracles.hs
@@ -20,8 +20,8 @@ import Control.Monad hiding (when, unless)
 import qualified Data.HashMap.Strict as M
 import qualified Prelude
 import Prelude hiding (not, (&&), (||))
-import Data.Char
 import Base
+import Util
 import Config
 
 data Builder = Ar | Ld | Gcc | Alex | Happy | HsColour | GhcCabal | GhcPkg Stage | Ghc Stage
@@ -241,7 +241,6 @@ instance ToCondition a => AndOr Flag a where
 
 newtype ConfigKey = ConfigKey String deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
 
-
 askConfigWithDefault :: String -> Action String -> Action String
 askConfigWithDefault key defaultAction = do
     maybeValue <- askOracle $ ConfigKey key 
@@ -266,20 +265,20 @@ packagaDataOptionWithDefault file key defaultAction = do
         Just value -> return value
         Nothing    -> do
                         result <- defaultAction
-                        return result   
+                        return result   -- TODO: simplify
 
 data PackageDataKey = Modules | SrcDirs
 
 packagaDataOption :: FilePath -> PackageDataKey -> Action String
 packagaDataOption file key = do
-    let keyName = replaceChar '/' '_' $ takeDirectory file ++ case key of
+    let keyName = replaceIf isSlash '_' $ takeDirectory file ++ case key of
            Modules -> "_MODULES"
            SrcDirs -> "_HS_SRC_DIRS"
     packagaDataOptionWithDefault file keyName $ error $ "\nCannot find key '"
                                          ++ keyName
                                          ++ "' in "
                                          ++ file
-                                         ++ "."
+                                         ++ "." -- TODO: Improve formatting
 
 
 oracleRules :: Rules ()
diff --git a/src/Package.hs b/src/Package.hs
index a6df921..8488044 100644
--- a/src/Package.hs
+++ b/src/Package.hs
@@ -4,6 +4,7 @@ module Package (
     ) where
 
 import Base
+import Util
 import Ways
 import Oracles
 
@@ -129,7 +130,7 @@ buildPackageData pkg @ (Package name path _) (stage, dist, settings) =
             when (registerPackage settings) $ run (GhcPkg stage) ghcPkgArgs
             let pkgDataFile = path </> dist </> "package-data.mk"                 
             pkgData <- lines <$> liftIO (readFile pkgDataFile)
-            length pkgData `seq` writeFileLines pkgDataFile $ map (replaceChar '/' '_') $ filter ('$' `notElem`) pkgData
+            length pkgData `seq` writeFileLines pkgDataFile $ map (replaceIf isSlash '_') $ filter ('$' `notElem`) pkgData
               where
                 cabalArgs, ghcPkgArgs :: Args
                 cabalArgs = mconcat
@@ -225,7 +226,7 @@ buildPackageDeps pkg @ (Package name path _) (stage, dist, settings) =
             autogen = dist </> "build" </> "autogen"
         mods <- words <$> packagaDataOption pkgData Modules
         src  <- getDirectoryFiles "" $ do
-                    start <- map (replaceChar '.' '/') mods
+                    start <- map (replaceEq '.' '/') mods
                     end   <- [".hs", ".lhs"]
                     return $ path ++ "//" ++ start ++ end
         run (Ghc stage) $ mconcat
diff --git a/src/Util.hs b/src/Util.hs
new file mode 100644
index 0000000..8afd6cb
--- /dev/null
+++ b/src/Util.hs
@@ -0,0 +1,16 @@
+module Util (
+    module Data.Char,
+    isSlash,
+    replaceIf, replaceEq
+    ) where
+
+import Data.Char
+
+isSlash :: Char -> Bool
+isSlash = (`elem` ['/', '\\']) 
+
+replaceIf :: (a -> Bool) -> a -> [a] -> [a]
+replaceIf p to = map (\from -> if p from then to else from) 
+
+replaceEq :: Eq a => a -> a -> [a] -> [a]
+replaceEq from = replaceIf (== from)