WindowsRoot.hs 2.18 KB
Newer Older
1
{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
2
module Oracles.WindowsRoot (
3
    windowsRoot, fixAbsolutePathOnWindows, lookupInPath, topDirectory, windowsRootOracle
4
    ) where
5

Ben Gamari's avatar
Ben Gamari committed
6
import Data.Char (isSpace)
Moritz Angermann's avatar
Take 2    
Moritz Angermann committed
7
import Data.List.Split (splitOn)
8
import Base
9
import Oracles.Config.Setting
10
11
12
13
14
15
16
17

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

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

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

42
43
-- | Lookup a @command@ in @PATH@ environment.
lookupInPath :: FilePath -> Action FilePath
Moritz Angermann's avatar
Take 2    
Moritz Angermann committed
44
45
lookupInPath c
    | c /= takeFileName c = return c
46
    | otherwise = do
Moritz Angermann's avatar
Take 2    
Moritz Angermann committed
47
        envPaths <- splitOn ":" <$> getEnvWithDefault "" "PATH"
Moritz Angermann's avatar
:(    
Moritz Angermann committed
48
        let candidates = map (-/- c) envPaths
Moritz Angermann's avatar
Moritz Angermann committed
49
50
        -- this will crash if we do not find any valid candidate.
        head <$> filterM doesFileExist candidates
51

52
53
54
55
-- 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
56
    root <- newCache $ \_ -> do
57
58
59
60
        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
61
    _ <- addOracle $ \WindowsRoot{} -> root ()
62
    return ()