Implement path lookup on Windows.

shaking-up-ghc.cabal

@@ -34,7 +34,7 @@ executable ghc-shake
                        , Oracles.PackageData
                        , Oracles.PackageDb
                        , Oracles.PackageDeps
-                       , Oracles.WindowsRoot
+                       , Oracles.WindowsPath
                        , Package
                        , Predicates
                        , Rules

src/Oracles.hs

@@ -6,7 +6,7 @@ module Oracles (
     module Oracles.LookupInPath,
     module Oracles.PackageData,
     module Oracles.PackageDeps,
-    module Oracles.WindowsRoot
+    module Oracles.WindowsPath
     ) where
 
 import Oracles.Config
@@ -16,4 +16,4 @@ import Oracles.Dependencies
 import Oracles.LookupInPath
 import Oracles.PackageData
 import Oracles.PackageDeps
-import Oracles.WindowsRoot
+import Oracles.WindowsPath

src/Oracles/WindowsPath.hs

+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
+module Oracles.WindowsPath (
+    fixAbsolutePathOnWindows, topDirectory, windowsPathOracle
+    ) where
+
+import Data.Char (isSpace)
+import Base
+import Oracles.Config.Setting
+
+newtype WindowsPath = WindowsPath FilePath
+    deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
+
+topDirectory :: Action FilePath
+topDirectory = do
+    ghcSourcePath <- setting GhcSourcePath
+    fixAbsolutePathOnWindows ghcSourcePath
+
+-- Fix an absolute path on Windows:
+-- * "/c/" => "C:/"
+-- * "/usr/bin/tar.exe" => "C:/msys/usr/bin/tar.exe"
+fixAbsolutePathOnWindows :: FilePath -> Action FilePath
+fixAbsolutePathOnWindows path = do
+    windows <- windowsHost
+    if windows
+    then do
+        let (dir, file) = splitFileName path
+        winDir <- askOracle $ WindowsPath dir
+        return $ winDir -/- file
+    else
+        return path
+
+-- Detecting path mapping on Windows. This is slow and requires caching.
+windowsPathOracle :: Rules ()
+windowsPathOracle = do
+    answer <- newCache $ \path -> do
+        Stdout out <- quietly $ cmd ["cygpath", "-m", path]
+        let windowsPath = dropWhileEnd isSpace out
+        putOracle $ "Windows path mapping: " ++ path ++ " => " ++ windowsPath
+        return windowsPath
+    _ <- addOracle $ \(WindowsPath query) -> answer query
+    return ()

src/Oracles/WindowsRoot.hs

-{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
-module Oracles.WindowsRoot (
-    windowsRoot, fixAbsolutePathOnWindows, topDirectory, windowsRootOracle
-    ) where
-
-import Data.Char (isSpace)
-import Base
-import Oracles.Config.Setting
-
-newtype WindowsRoot = WindowsRoot ()
-    deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
-
--- Looks up cygwin/msys root on Windows
-windowsRoot :: Action String
-windowsRoot = askOracle $ WindowsRoot ()
-
-topDirectory :: Action FilePath
-topDirectory = do
-    ghcSourcePath <- setting GhcSourcePath
-    fixAbsolutePathOnWindows ghcSourcePath
-
--- TODO: this is fragile, e.g. we currently only handle C: drive
--- On Windows:
--- * if the path starts with "/c/" change the prefix to "C:/"
--- * otherwise, if the path starts with "/", prepend it with the correct path
--- to the root, e.g: "/usr/local/bin/ghc.exe" => "C:/msys/usr/local/bin/ghc.exe"
-fixAbsolutePathOnWindows :: FilePath -> Action FilePath
-fixAbsolutePathOnWindows path = do
-    windows <- windowsHost
-    -- Note, below is different from FilePath.isAbsolute:
-    if (windows && "/" `isPrefixOf` path)
-    then do
-        if ("/c/" `isPrefixOf` path)
-        then return $ "C:" ++ drop 2 path
-        else do
-            root <- windowsRoot
-            return . unifyPath $ root ++ drop 1 path
-    else
-        return path
-
--- Oracle for windowsRoot. This operation requires caching as looking up
--- the root is slow (at least the current implementation).
-windowsRootOracle :: Rules ()
-windowsRootOracle = do
-    root <- newCache $ \_ -> do
-        Stdout out <- quietly $ cmd ["cygpath", "-m", "/"]
-        let root = dropWhileEnd isSpace out
-        putOracle $ "Detected root on Windows: " ++ root
-        return root
-    _ <- addOracle $ \WindowsRoot{} -> root ()
-    return ()

src/Rules/Oracles.hs

@@ -17,4 +17,4 @@ oracleRules = do
     packageDataOracle  -- see Oracles.PackageData
     packageDbOracle    -- see Oracles.PackageData
     packageDepsOracle  -- see Oracles.PackageDeps
-    windowsRootOracle  -- see Oracles.WindowsRoot
+    windowsPathOracle  -- see Oracles.WindowsRoot

src/Test.hs

@@ -6,7 +6,7 @@ import Expression
 import GHC (rts, libffi)
 import Oracles.Config.Flag
 import Oracles.Config.Setting
-import Oracles.WindowsRoot -- TODO: rename to Oracles.TopDirectory
+import Oracles.WindowsPath
 import Rules.Actions
 import Settings.Packages
 import Settings.User