{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
module Distribution.Client.Nix
( findNixExpr
, inNixShell
, nixInstantiate
, nixShell
) where
import Distribution.Client.Compat.Prelude
import Control.Exception (bracket)
import System.Directory
( canonicalizePath, createDirectoryIfMissing, doesDirectoryExist
, doesFileExist, removeDirectoryRecursive, removeFile )
import System.Environment (getArgs, getExecutablePath)
import System.FilePath
( (</>), replaceExtension, takeDirectory, takeFileName )
import System.IO (IOMode(..), hClose, openFile)
import System.IO.Error (isDoesNotExistError)
import System.Process (showCommandForUser)
import Distribution.Compat.Environment
( lookupEnv, setEnv, unsetEnv )
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(..))
configureOneProgram :: Verbosity -> Program -> IO ProgramDb
configureOneProgram :: Verbosity -> Program -> IO ProgramDb
configureOneProgram Verbosity
verb Program
prog =
Verbosity -> Program -> ProgramDb -> IO ProgramDb
configureProgram Verbosity
verb Program
prog (Program -> ProgramDb -> ProgramDb
addKnownProgram Program
prog ProgramDb
emptyProgramDb)
touchFile :: FilePath -> IO ()
touchFile :: FilePath -> IO ()
touchFile FilePath
path = do
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (FilePath -> IO ()
removeFile FilePath
path) (\IOError
e -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IOError -> Bool
isDoesNotExistError IOError
e) (forall (m :: * -> *) a. Monad m => a -> m a
return ()))
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> FilePath
takeDirectory FilePath
path)
FilePath -> IOMode -> IO Handle
openFile FilePath
path IOMode
WriteMode forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> IO ()
hClose
findNixExpr :: GlobalFlags -> SavedConfig -> IO (Maybe FilePath)
findNixExpr :: GlobalFlags -> SavedConfig -> IO (Maybe FilePath)
findNixExpr GlobalFlags
globalFlags SavedConfig
config = do
let nixEnabled :: Bool
nixEnabled =
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False
(GlobalFlags -> Flag Bool
globalNix (SavedConfig -> GlobalFlags
savedGlobalFlags SavedConfig
config) forall a. Semigroup a => a -> a -> a
<> GlobalFlags -> Flag Bool
globalNix GlobalFlags
globalFlags)
if Bool
nixEnabled
then do
let exprPaths :: [FilePath]
exprPaths = [ FilePath
"shell.nix", FilePath
"default.nix" ]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesFileExist [FilePath]
exprPaths forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
(FilePath
path : [FilePath]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just FilePath
path)
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
inFakeNixShell :: IO a -> IO a
inFakeNixShell :: forall a. IO a -> IO a
inFakeNixShell IO a
f =
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (FilePath -> FilePath -> IO (Maybe FilePath)
fakeEnv FilePath
"IN_NIX_SHELL" FilePath
"1") (FilePath -> Maybe FilePath -> IO ()
resetEnv FilePath
"IN_NIX_SHELL") (\Maybe FilePath
_ -> IO a
f)
where
fakeEnv :: FilePath -> FilePath -> IO (Maybe FilePath)
fakeEnv FilePath
var FilePath
new = do
Maybe FilePath
old <- FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
var
FilePath -> FilePath -> IO ()
setEnv FilePath
var FilePath
new
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
old
resetEnv :: FilePath -> Maybe FilePath -> IO ()
resetEnv FilePath
var = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> IO ()
unsetEnv FilePath
var) (FilePath -> FilePath -> IO ()
setEnv FilePath
var)
nixInstantiate
:: Verbosity
-> FilePath
-> Bool
-> GlobalFlags
-> SavedConfig
-> IO ()
nixInstantiate :: Verbosity
-> FilePath -> Bool -> GlobalFlags -> SavedConfig -> IO ()
nixInstantiate Verbosity
verb FilePath
dist Bool
force' GlobalFlags
globalFlags SavedConfig
config =
GlobalFlags -> SavedConfig -> IO (Maybe FilePath)
findNixExpr GlobalFlags
globalFlags SavedConfig
config forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe FilePath
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just FilePath
shellNix -> do
Bool
alreadyInShell <- IO Bool
inNixShell
FilePath
shellDrv <- FilePath -> FilePath -> IO FilePath
drvPath FilePath
dist FilePath
shellNix
Bool
instantiated <- FilePath -> IO Bool
doesFileExist FilePath
shellDrv
let timestamp :: FilePath
timestamp = FilePath -> FilePath -> FilePath
timestampPath FilePath
dist FilePath
shellNix
Bool
upToDate <- FilePath -> FilePath -> IO Bool
existsAndIsMoreRecentThan FilePath
timestamp FilePath
shellNix
let ready :: Bool
ready = Bool
alreadyInShell Bool -> Bool -> Bool
|| (Bool
instantiated Bool -> Bool -> Bool
&& Bool
upToDate Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
force')
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ready forall a b. (a -> b) -> a -> b
$ do
let prog :: Program
prog = FilePath -> Program
simpleProgram FilePath
"nix-instantiate"
ProgramDb
progdb <- Verbosity -> Program -> IO ProgramDb
configureOneProgram Verbosity
verb Program
prog
Verbosity -> FilePath -> IO ()
removeGCRoots Verbosity
verb FilePath
dist
FilePath -> IO ()
touchFile FilePath
timestamp
FilePath
_ <- forall a. IO a -> IO a
inFakeNixShell
(Verbosity -> Program -> ProgramDb -> [FilePath] -> IO FilePath
getDbProgramOutput Verbosity
verb Program
prog ProgramDb
progdb
[ FilePath
"--add-root", FilePath
shellDrv, FilePath
"--indirect", FilePath
shellNix ])
forall (m :: * -> *) a. Monad m => a -> m a
return ()
nixShell
:: Verbosity
-> FilePath
-> GlobalFlags
-> SavedConfig
-> IO ()
-> IO ()
nixShell :: Verbosity
-> FilePath -> GlobalFlags -> SavedConfig -> IO () -> IO ()
nixShell Verbosity
verb FilePath
dist GlobalFlags
globalFlags SavedConfig
config IO ()
go = do
Bool
alreadyInShell <- IO Bool
inNixShell
if Bool
alreadyInShell
then IO ()
go
else do
GlobalFlags -> SavedConfig -> IO (Maybe FilePath)
findNixExpr GlobalFlags
globalFlags SavedConfig
config forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe FilePath
Nothing -> IO ()
go
Just FilePath
shellNix -> do
let prog :: Program
prog = FilePath -> Program
simpleProgram FilePath
"nix-shell"
ProgramDb
progdb <- Verbosity -> Program -> IO ProgramDb
configureOneProgram Verbosity
verb Program
prog
FilePath
cabal <- IO FilePath
getExecutablePath
FilePath -> FilePath -> IO ()
setEnv FilePath
"CABAL_IN_NIX_SHELL" FilePath
"1"
FilePath
shellDrv <- FilePath -> FilePath -> IO FilePath
drvPath FilePath
dist FilePath
shellNix
[FilePath]
args <- IO [FilePath]
getArgs
Verbosity -> Program -> ProgramDb -> [FilePath] -> IO ()
runDbProgram Verbosity
verb Program
prog ProgramDb
progdb
[ FilePath
"--add-root", FilePath -> FilePath
gcrootPath FilePath
dist FilePath -> FilePath -> FilePath
</> FilePath
"result", FilePath
"--indirect", FilePath
shellDrv
, FilePath
"--run", FilePath -> [FilePath] -> FilePath
showCommandForUser FilePath
cabal [FilePath]
args
]
drvPath :: FilePath -> FilePath -> IO FilePath
drvPath :: FilePath -> FilePath -> IO FilePath
drvPath FilePath
dist FilePath
path = do
FilePath
distNix <- FilePath -> IO FilePath
canonicalizePath (FilePath
dist FilePath -> FilePath -> FilePath
</> FilePath
"nix")
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
distNix FilePath -> FilePath -> FilePath
</> FilePath -> FilePath -> FilePath
replaceExtension (FilePath -> FilePath
takeFileName FilePath
path) FilePath
"drv")
timestampPath :: FilePath -> FilePath -> FilePath
timestampPath :: FilePath -> FilePath -> FilePath
timestampPath FilePath
dist FilePath
path =
FilePath
dist FilePath -> FilePath -> FilePath
</> FilePath
"nix" FilePath -> FilePath -> FilePath
</> FilePath -> FilePath -> FilePath
replaceExtension (FilePath -> FilePath
takeFileName FilePath
path) FilePath
"drv.timestamp"
gcrootPath :: FilePath -> FilePath
gcrootPath :: FilePath -> FilePath
gcrootPath FilePath
dist = FilePath
dist FilePath -> FilePath -> FilePath
</> FilePath
"nix" FilePath -> FilePath -> FilePath
</> FilePath
"gcroots"
inNixShell :: IO Bool
inNixShell :: IO Bool
inNixShell = forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"CABAL_IN_NIX_SHELL"
removeGCRoots :: Verbosity -> FilePath -> IO ()
removeGCRoots :: Verbosity -> FilePath -> IO ()
removeGCRoots Verbosity
verb FilePath
dist = do
let tgt :: FilePath
tgt = FilePath -> FilePath
gcrootPath FilePath
dist
Bool
exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
tgt
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
debug Verbosity
verb (FilePath
"removing Nix gcroots from " forall a. [a] -> [a] -> [a]
++ FilePath
tgt)
FilePath -> IO ()
removeDirectoryRecursive FilePath
tgt