cabal-install/src/Distribution/Client/Nix.hs

   1 {-# LANGUAGE LambdaCase #-}
   2 {-# LANGUAGE ViewPatterns #-}
   3
   4 module Distribution.Client.Nix
   5   ( findNixExpr
   6   , inNixShell
   7   , nixInstantiate
   8   , nixShell
   9   ) where
  10
  11 import Distribution.Client.Compat.Prelude
  12
  13 import Control.Exception (bracket)
  14 import System.Directory
  15   ( canonicalizePath
  16   , createDirectoryIfMissing
  17   , doesDirectoryExist
  18   , doesFileExist
  19   , removeDirectoryRecursive
  20   , removeFile
  21   )
  22 import System.Environment (getArgs, getExecutablePath)
  23 import System.FilePath
  24   ( replaceExtension
  25   , takeDirectory
  26   , takeFileName
  27   , (</>)
  28   )
  29 import System.IO (IOMode (..), hClose, openFile)
  30 import System.IO.Error (isDoesNotExistError)
  31 import System.Process (showCommandForUser)
  32
  33 import Distribution.Compat.Environment
  34   ( lookupEnv
  35   , setEnv
  36   , unsetEnv
  37   )
  38
  39 import Distribution.Simple.Program
  40   ( Program (..)
  41   , ProgramDb
  42   , addKnownProgram
  43   , configureProgram
  44   , emptyProgramDb
  45   , getDbProgramOutput
  46   , runDbProgram
  47   , simpleProgram
  48   )
  49 import Distribution.Simple.Setup (fromFlagOrDefault)
  50 import Distribution.Simple.Utils (debug, existsAndIsMoreRecentThan, warn)
  51
  52 import Distribution.Client.Config (SavedConfig (..))
  53 import Distribution.Client.GlobalFlags (GlobalFlags (..))
  54
  55 configureOneProgram :: Verbosity -> Program -> IO ProgramDb
  56 configureOneProgram verb prog =
  57   configureProgram verb prog (addKnownProgram prog emptyProgramDb)
  58
  59 touchFile :: FilePath -> IO ()
  60 touchFile path = do
  61   catch (removeFile path) (\e -> when (isDoesNotExistError e) (return ()))
  62   createDirectoryIfMissing True (takeDirectory path)
  63   openFile path WriteMode >>= hClose
  64
  65 findNixExpr :: GlobalFlags -> SavedConfig -> IO (Maybe FilePath)
  66 findNixExpr globalFlags config = do
  67   -- criteria for deciding to run nix-shell
  68   let nixEnabled =
  69         fromFlagOrDefault
  70           False
  71           (globalNix (savedGlobalFlags config) <> globalNix globalFlags)
  72
  73   if nixEnabled
  74     then do
  75       let exprPaths = ["shell.nix", "default.nix"]
  76       filterM doesFileExist exprPaths >>= \case
  77         [] -> return Nothing
  78         (path : _) -> return (Just path)
  79     else return Nothing
  80
  81 -- set IN_NIX_SHELL so that builtins.getEnv in Nix works as in nix-shell
  82 inFakeNixShell :: IO a -> IO a
  83 inFakeNixShell f =
  84   bracket (fakeEnv "IN_NIX_SHELL" "1") (resetEnv "IN_NIX_SHELL") (\_ -> f)
  85   where
  86     fakeEnv var new = do
  87       old <- lookupEnv var
  88       setEnv var new
  89       return old
  90     resetEnv var = maybe (unsetEnv var) (setEnv var)
  91
  92 nixInstantiate
  93   :: Verbosity
  94   -> FilePath
  95   -> Bool
  96   -> GlobalFlags
  97   -> SavedConfig
  98   -> IO ()
  99 nixInstantiate verb dist force' globalFlags config =
 100   findNixExpr globalFlags config >>= \case
 101     Nothing -> return ()
 102     Just shellNix -> do
 103       alreadyInShell <- inNixShell
 104       shellDrv <- drvPath dist shellNix
 105       instantiated <- doesFileExist shellDrv
 106       -- an extra timestamp file is necessary because the derivation lives in
 107       -- the store so its mtime is always 1.
 108       let timestamp = timestampPath dist shellNix
 109       upToDate <- existsAndIsMoreRecentThan timestamp shellNix
 110
 111       let ready = alreadyInShell || (instantiated && upToDate && not force')
 112       unless ready $ do
 113         let prog = simpleProgram "nix-instantiate"
 114         progdb <- configureOneProgram verb prog
 115
 116         removeGCRoots verb dist
 117         touchFile timestamp
 118
 119         _ <-
 120           inFakeNixShell
 121             ( getDbProgramOutput
 122                 verb
 123                 prog
 124                 progdb
 125                 ["--add-root", shellDrv, "--indirect", shellNix]
 126             )
 127         return ()
 128
 129 nixShell
 130   :: Verbosity
 131   -> FilePath
 132   -> GlobalFlags
 133   -> SavedConfig
 134   -> IO ()
 135   -- ^ The action to perform inside a nix-shell. This is also the action
 136   -- that will be performed immediately if Nix is disabled.
 137   -> IO ()
 138 nixShell verb dist globalFlags config go = do
 139   alreadyInShell <- inNixShell
 140
 141   if alreadyInShell
 142     then go
 143     else do
 144       findNixExpr globalFlags config >>= \case
 145         Nothing -> go
 146         Just shellNix -> do
 147           -- Nix integration never worked with cabal-install v2 commands ...
 148           warn verb "Nix integration has been deprecated and will be removed in a future release. You can learn more about it here: https://cabal.readthedocs.io/en/latest/nix-integration.html"
 149
 150           let prog = simpleProgram "nix-shell"
 151           progdb <- configureOneProgram verb prog
 152
 153           cabal <- getExecutablePath
 154
 155           -- alreadyInShell == True in child process
 156           setEnv "CABAL_IN_NIX_SHELL" "1"
 157
 158           -- Run cabal with the same arguments inside nix-shell.
 159           -- When the child process reaches the top of nixShell, it will
 160           -- detect that it is running inside the shell and fall back
 161           -- automatically.
 162           shellDrv <- drvPath dist shellNix
 163           args <- getArgs
 164           runDbProgram
 165             verb
 166             prog
 167             progdb
 168             [ "--add-root"
 169             , gcrootPath dist </> "result"
 170             , "--indirect"
 171             , shellDrv
 172             , "--run"
 173             , showCommandForUser cabal args
 174             ]
 175
 176 drvPath :: FilePath -> FilePath -> IO FilePath
 177 drvPath dist path = do
 178   -- We do not actually care about canonicity, but makeAbsolute is only
 179   -- available in newer versions of directory.
 180   -- We expect the path to be a symlink if it exists, so we do not canonicalize
 181   -- the entire path because that would dereference the symlink.
 182   distNix <- canonicalizePath (dist </> "nix")
 183   -- Nix garbage collector roots must be absolute paths
 184   return (distNix </> replaceExtension (takeFileName path) "drv")
 185
 186 timestampPath :: FilePath -> FilePath -> FilePath
 187 timestampPath dist path =
 188   dist </> "nix" </> replaceExtension (takeFileName path) "drv.timestamp"
 189
 190 gcrootPath :: FilePath -> FilePath
 191 gcrootPath dist = dist </> "nix" </> "gcroots"
 192
 193 inNixShell :: IO Bool
 194 inNixShell = isJust <$> lookupEnv "CABAL_IN_NIX_SHELL"
 195
 196 removeGCRoots :: Verbosity -> FilePath -> IO ()
 197 removeGCRoots verb dist = do
 198   let tgt = gcrootPath dist
 199   exists <- doesDirectoryExist tgt
 200   when exists $ do
 201     debug verb ("removing Nix gcroots from " ++ tgt)
 202     removeDirectoryRecursive tgt