WindowsRoot.hs 1.75 KB
Newer Older
1
{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
2
module Oracles.WindowsRoot (
Moritz Angermann's avatar
Moritz Angermann committed
3
    windowsRoot, fixAbsolutePathOnWindows, topDirectory, windowsRootOracle
4
    ) where
5

Ben Gamari's avatar
Ben Gamari committed
6
import Data.Char (isSpace)
7
import Base
8
import Oracles.Config.Setting
9 10 11 12 13 14 15 16

newtype WindowsRoot = WindowsRoot ()
    deriving (Show, Typeable, Eq, Hashable, Binary, NFData)

-- Looks up cygwin/msys root on Windows
windowsRoot :: Action String
windowsRoot = askOracle $ WindowsRoot ()

17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
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

41 42 43 44
-- Oracle for windowsRoot. This operation requires caching as looking up
-- the root is slow (at least the current implementation).
windowsRootOracle :: Rules ()
windowsRootOracle = do
Andrey Mokhov's avatar
Andrey Mokhov committed
45
    root <- newCache $ \_ -> do
46 47 48 49
        Stdout out <- quietly $ cmd ["cygpath", "-m", "/"]
        let root = dropWhileEnd isSpace out
        putOracle $ "Detected root on Windows: " ++ root
        return root
Andrey Mokhov's avatar
Andrey Mokhov committed
50
    _ <- addOracle $ \WindowsRoot{} -> root ()
51
    return ()