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
Packages
Cabal
Commits
47987e2c
Unverified
Commit
47987e2c
authored
Dec 02, 2016
by
ttuegel
Browse files
Add Nix integration
parent
a6e4b59a
Changes
9
Expand all
Hide whitespace changes
Inline
Side-by-side
cabal-install/Distribution/Client/Config.hs
View file @
47987e2c
...
...
@@ -227,7 +227,8 @@ instance Semigroup SavedConfig where
globalRequireSandbox
=
combine
globalRequireSandbox
,
globalIgnoreSandbox
=
combine
globalIgnoreSandbox
,
globalIgnoreExpiry
=
combine
globalIgnoreExpiry
,
globalHttpTransport
=
combine
globalHttpTransport
globalHttpTransport
=
combine
globalHttpTransport
,
globalNix
=
combine
globalNix
}
where
combine
=
combine'
savedGlobalFlags
...
...
cabal-install/Distribution/Client/GlobalFlags.hs
View file @
47987e2c
...
...
@@ -67,7 +67,8 @@ data GlobalFlags = GlobalFlags {
globalRequireSandbox
::
Flag
Bool
,
globalIgnoreSandbox
::
Flag
Bool
,
globalIgnoreExpiry
::
Flag
Bool
,
-- ^ Ignore security expiry dates
globalHttpTransport
::
Flag
String
globalHttpTransport
::
Flag
String
,
globalNix
::
Flag
Bool
-- ^ Integrate with Nix
}
deriving
Generic
defaultGlobalFlags
::
GlobalFlags
...
...
@@ -85,7 +86,8 @@ defaultGlobalFlags = GlobalFlags {
globalRequireSandbox
=
Flag
False
,
globalIgnoreSandbox
=
Flag
False
,
globalIgnoreExpiry
=
Flag
False
,
globalHttpTransport
=
mempty
globalHttpTransport
=
mempty
,
globalNix
=
Flag
False
}
instance
Monoid
GlobalFlags
where
...
...
cabal-install/Distribution/Client/Nix.hs
0 → 100644
View file @
47987e2c
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
module
Distribution.Client.Nix
(
findNixExpr
,
inNixShell
,
nixInstantiate
,
nixShell
,
nixShellIfSandboxed
)
where
#
if
!
MIN_VERSION_base
(
4
,
8
,
0
)
import
Control.Applicative
((
<$>
))
#
endif
import
Control.Exception
(
catch
)
import
Control.Monad
(
filterM
,
when
,
unless
)
import
System.Directory
(
createDirectoryIfMissing
,
doesDirectoryExist
,
doesFileExist
,
makeAbsolute
,
removeDirectoryRecursive
,
removeFile
)
import
System.Environment
(
getExecutablePath
,
getArgs
,
lookupEnv
)
import
System.FilePath
(
(
</>
),
(
<.>
),
replaceExtension
,
takeDirectory
,
takeFileName
)
import
System.IO
(
IOMode
(
..
),
hClose
,
openFile
)
import
System.IO.Error
(
isDoesNotExistError
)
import
System.Process
(
showCommandForUser
)
import
Distribution.Compat.Semigroup
import
Distribution.Verbosity
import
Distribution.Simple.Program
(
Program
(
..
),
ProgramDb
,
addKnownProgram
,
configureProgram
,
emptyProgramDb
,
getDbProgramOutput
,
runDbProgram
,
simpleProgram
)
import
Distribution.Simple.Setup
(
fromFlagOrDefault
)
import
Distribution.Simple.Utils
(
debug
,
existsAndIsMoreRecentThan
)
import
Distribution.Client.Config
(
SavedConfig
(
..
))
import
Distribution.Client.GlobalFlags
(
GlobalFlags
(
..
))
import
Distribution.Client.Sandbox.Types
(
UseSandbox
(
..
))
configureOneProgram
::
Verbosity
->
Program
->
IO
ProgramDb
configureOneProgram
verb
prog
=
configureProgram
verb
prog
(
addKnownProgram
prog
emptyProgramDb
)
touchFile
::
FilePath
->
IO
()
touchFile
path
=
do
catch
(
removeFile
path
)
(
\
e
->
when
(
isDoesNotExistError
e
)
(
return
()
))
createDirectoryIfMissing
True
(
takeDirectory
path
)
openFile
path
WriteMode
>>=
hClose
findNixExpr
::
GlobalFlags
->
SavedConfig
->
IO
(
Maybe
FilePath
)
findNixExpr
globalFlags
config
=
do
-- criteria for deciding to run nix-shell
let
nixEnabled
=
fromFlagOrDefault
False
(
globalNix
(
savedGlobalFlags
config
)
<>
globalNix
globalFlags
)
if
nixEnabled
then
do
let
exprPaths
=
[
"shell.nix"
,
"default.nix"
]
filterM
doesFileExist
exprPaths
>>=
\
case
[]
->
return
Nothing
(
path
:
_
)
->
return
(
Just
path
)
else
return
Nothing
nixInstantiate
::
Verbosity
->
FilePath
->
Bool
->
GlobalFlags
->
SavedConfig
->
IO
()
nixInstantiate
verb
dist
force
globalFlags
config
=
findNixExpr
globalFlags
config
>>=
\
case
Nothing
->
return
()
Just
shellNix
->
do
alreadyInShell
<-
inNixShell
shellDrv
<-
drvPath
dist
shellNix
instantiated
<-
doesFileExist
shellDrv
-- an extra timestamp file is necessary because the derivation lives in
-- the store so its mtime is always 1.
let
timestamp
=
shellDrv
<.>
"timestamp"
upToDate
<-
existsAndIsMoreRecentThan
timestamp
shellNix
let
ready
=
alreadyInShell
||
(
instantiated
&&
upToDate
&&
not
force
)
unless
ready
$
do
let
prog
=
simpleProgram
"nix-instantiate"
progdb
<-
configureOneProgram
verb
prog
removeGCRoots
verb
dist
touchFile
timestamp
_
<-
getDbProgramOutput
verb
prog
progdb
[
"--add-root"
,
shellDrv
,
"--indirect"
,
shellNix
]
return
()
nixShell
::
Verbosity
->
FilePath
->
GlobalFlags
->
SavedConfig
->
IO
()
-- ^ The action to perform inside a nix-shell. This is also the action
-- that will be performed immediately if Nix is disabled.
->
IO
()
nixShell
verb
dist
globalFlags
config
go
=
do
alreadyInShell
<-
inNixShell
if
alreadyInShell
then
go
else
do
findNixExpr
globalFlags
config
>>=
\
case
Nothing
->
go
Just
shellNix
->
do
let
prog
=
simpleProgram
"nix-shell"
progdb
<-
configureOneProgram
verb
prog
cabal
<-
getExecutablePath
-- Run cabal with the same arguments inside nix-shell.
-- When the child process reaches the top of nixShell, it will
-- detect that it is running inside the shell and fall back
-- automatically.
shellDrv
<-
drvPath
dist
shellNix
args
<-
getArgs
runDbProgram
verb
prog
progdb
[
"--add-root"
,
gcrootPath
dist
</>
"result"
,
"--indirect"
,
shellDrv
,
"--run"
,
showCommandForUser
cabal
args
]
drvPath
::
FilePath
->
FilePath
->
IO
FilePath
drvPath
dist
path
=
-- Nix garbage collector roots must be absolute paths
makeAbsolute
(
dist
</>
"nix"
</>
replaceExtension
(
takeFileName
path
)
"drv"
)
gcrootPath
::
FilePath
->
FilePath
gcrootPath
dist
=
dist
</>
"nix"
</>
"gcroots"
inNixShell
::
IO
Bool
inNixShell
=
maybe
False
(
const
True
)
<$>
lookupEnv
"IN_NIX_SHELL"
removeGCRoots
::
Verbosity
->
FilePath
->
IO
()
removeGCRoots
verb
dist
=
do
let
tgt
=
gcrootPath
dist
exists
<-
doesDirectoryExist
tgt
when
exists
$
do
debug
verb
(
"removing Nix gcroots from "
++
tgt
)
removeDirectoryRecursive
tgt
nixShellIfSandboxed
::
Verbosity
->
FilePath
->
GlobalFlags
->
SavedConfig
->
UseSandbox
->
IO
()
-- ^ The action to perform inside a nix-shell. This is also the action
-- that will be performed immediately if Nix is disabled.
->
IO
()
nixShellIfSandboxed
verb
dist
globalFlags
config
useSandbox
go
=
case
useSandbox
of
NoSandbox
->
go
UseSandbox
_
->
nixShell
verb
dist
globalFlags
config
go
cabal-install/Distribution/Client/ProjectConfig/Legacy.hs
View file @
47987e2c
...
...
@@ -472,7 +472,8 @@ convertToLegacySharedConfig
globalRequireSandbox
=
mempty
,
globalIgnoreSandbox
=
mempty
,
globalIgnoreExpiry
=
projectConfigIgnoreExpiry
,
globalHttpTransport
=
projectConfigHttpTransport
globalHttpTransport
=
projectConfigHttpTransport
,
globalNix
=
mempty
}
configFlags
=
mempty
{
...
...
cabal-install/Distribution/Client/Reconfigure.hs
View file @
47987e2c
module
Distribution.Client.Reconfigure
(
Check
(
..
),
reconfigure
)
where
import
Control.Monad
(
unless
,
when
)
import
Data.Maybe
(
isJust
)
import
Data.Monoid
hiding
(
(
<>
)
)
import
System.Directory
(
doesFileExist
)
...
...
@@ -15,6 +16,7 @@ import Distribution.Simple.Utils
import
Distribution.Client.Config
(
SavedConfig
(
..
)
)
import
Distribution.Client.Configure
(
readConfigFlags
)
import
Distribution.Client.Nix
(
findNixExpr
,
inNixShell
,
nixInstantiate
)
import
Distribution.Client.Sandbox
(
WereDepsReinstalled
(
..
),
findSavedDistPref
,
getSandboxConfigFilePath
,
maybeReinstallAddSourceDeps
,
updateInstallDirs
)
...
...
@@ -111,21 +113,42 @@ reconfigure
savedFlags
@
(
_
,
_
)
<-
readConfigFlags
dist
let
checks
=
checkVerb
<>
checkDist
<>
checkOutdated
<>
check
<>
checkAddSourceDeps
(
Any
force
,
flags
@
(
configFlags
,
_
))
<-
runCheck
checks
mempty
savedFlags
let
(
_
,
config'
)
=
updateInstallDirs
(
configUserInstall
configFlags
)
(
useSandbox
,
config
)
when
force
$
configureAction
flags
extraArgs
globalFlags
return
config'
useNix
<-
fmap
isJust
(
findNixExpr
globalFlags
config
)
alreadyInNixShell
<-
inNixShell
if
useNix
&&
not
alreadyInNixShell
then
do
-- If we are using Nix, we must reinstantiate the derivation outside
-- the shell. Eventually, the caller will invoke 'nixShell' which will
-- rerun cabal inside the shell. That will bring us back to 'reconfigure',
-- but inside the shell we'll take the second branch, below.
-- This seems to have a problem: won't 'configureAction' call 'nixShell'
-- yet again, spawning an infinite tree of subprocesses?
-- No, because 'nixShell' doesn't spawn a new process if it is already
-- running in a Nix shell.
nixInstantiate
verbosity
dist
False
globalFlags
config
return
config
else
do
let
checks
=
checkVerb
<>
checkDist
<>
checkOutdated
<>
check
<>
checkAddSourceDeps
(
Any
force
,
flags
@
(
configFlags
,
_
))
<-
runCheck
checks
mempty
savedFlags
let
(
_
,
config'
)
=
updateInstallDirs
(
configUserInstall
configFlags
)
(
useSandbox
,
config
)
when
force
$
configureAction
flags
extraArgs
globalFlags
return
config'
where
...
...
cabal-install/Distribution/Client/Setup.hs
View file @
47987e2c
...
...
@@ -298,6 +298,10 @@ globalCommand commands = CommandUI {
"Set a transport for http(s) requests. Accepts 'curl', 'wget', 'powershell', and 'plain-http'. (default: 'curl')"
globalHttpTransport
(
\
v
flags
->
flags
{
globalHttpTransport
=
v
})
(
reqArgFlag
"HttpTransport"
)
,
option
[]
[
"nix"
]
"Nix integration: run commands through nix-shell if a 'shell.nix' file exists"
globalNix
(
\
v
flags
->
flags
{
globalNix
=
v
})
(
boolOpt
[]
[]
)
]
-- arguments we don't want shown in the help
...
...
cabal-install/Main.hs
View file @
47987e2c
This diff is collapsed.
Click to expand it.
cabal-install/cabal-install.cabal
View file @
47987e2c
...
...
@@ -243,6 +243,7 @@ executable cabal
Distribution.Client.JobControl
Distribution.Client.List
Distribution.Client.Manpage
Distribution.Client.Nix
Distribution.Client.PackageHash
Distribution.Client.PackageUtils
Distribution.Client.ParseUtils
...
...
cabal-install/changelog
View file @
47987e2c
...
...
@@ -29,6 +29,7 @@
*
Support
for
building
Backpack
packages
.
See
https
://
github
.
com
/
ezyang
/
ghc
-
proposals
/
blob
/
backpack
/
proposals
/
0000
-
backpack
.
rst
for
more
details
.
*
Support
the
Nix
package
manager
(#
3651
).
1.24.0.0
Ryan
Thomas
<
ryan
@
ryant
.
org
>
March
2016
*
If
there
are
multiple
remote
repos
,
'cabal update'
now
updates
...
...
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