Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
f5299c86
Commit
f5299c86
authored
Feb 09, 2016
by
Andrey Mokhov
Browse files
Implement path lookup on Windows.
parent
2fe68f0a
Changes
6
Hide whitespace changes
Inline
Side-by-side
shaking-up-ghc.cabal
View file @
f5299c86
...
...
@@ -34,7 +34,7 @@ executable ghc-shake
, Oracles.PackageData
, Oracles.PackageDb
, Oracles.PackageDeps
, Oracles.Windows
Root
, Oracles.Windows
Path
, Package
, Predicates
, Rules
...
...
src/Oracles.hs
View file @
f5299c86
...
...
@@ -6,7 +6,7 @@ module Oracles (
module
Oracles
.
LookupInPath
,
module
Oracles
.
PackageData
,
module
Oracles
.
PackageDeps
,
module
Oracles
.
Windows
Root
module
Oracles
.
Windows
Path
)
where
import
Oracles.Config
...
...
@@ -16,4 +16,4 @@ import Oracles.Dependencies
import
Oracles.LookupInPath
import
Oracles.PackageData
import
Oracles.PackageDeps
import
Oracles.Windows
Root
import
Oracles.Windows
Path
src/Oracles/WindowsPath.hs
0 → 100644
View file @
f5299c86
{-# 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
deleted
100644 → 0
View file @
2fe68f0a
{-# 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
View file @
f5299c86
...
...
@@ -17,4 +17,4 @@ oracleRules = do
packageDataOracle
-- see Oracles.PackageData
packageDbOracle
-- see Oracles.PackageData
packageDepsOracle
-- see Oracles.PackageDeps
windows
Root
Oracle
-- see Oracles.WindowsRoot
windows
Path
Oracle
-- see Oracles.WindowsRoot
src/Test.hs
View file @
f5299c86
...
...
@@ -6,7 +6,7 @@ import Expression
import
GHC
(
rts
,
libffi
)
import
Oracles.Config.Flag
import
Oracles.Config.Setting
import
Oracles.Windows
Root
-- TODO: rename to Oracles.TopDirectory
import
Oracles.Windows
Path
import
Rules.Actions
import
Settings.Packages
import
Settings.User
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment