{-# LANGUAGE NoImplicitPrelude  #-}
{-# LANGUAGE ConstraintKinds    #-}
{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE OverloadedStrings  #-}

-- | Run commands in a nix-shell

module Stack.Nix
  (nixCmdName
  ,nixHelpOptName
  ,runShellAndExit
  ) where

import           Stack.Prelude
import qualified Data.Text as T
import           Data.Version (showVersion)
import           Path.IO
import qualified Paths_stack as Meta
import           Stack.Config (getInContainer, withBuildConfig)
import           Stack.Config.Nix (nixCompiler, nixCompilerVersion)
import           Stack.Constants (platformVariantEnvVar,inNixShellEnvVar,inContainerEnvVar)
import           Stack.Types.Config
import           Stack.Types.Docker
import           Stack.Types.Nix
import           System.Environment (getArgs,getExecutablePath,lookupEnv)
import qualified System.FilePath  as F
import           RIO.Process (processContextL, exec)

runShellAndExit :: RIO Config void
runShellAndExit :: forall void. RIO Config void
runShellAndExit = do
   Bool
inContainer <- forall (m :: * -> *). MonadIO m => m Bool
getInContainer -- TODO we can probably assert that this is False based on Stack.Runners now

   [[Char]]
origArgs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [[Char]]
getArgs
   let args :: [[Char]]
args | Bool
inContainer = [[Char]]
origArgs  -- internal-re-exec version already passed

              -- first stack when restarting in the container

            | Bool
otherwise =
                ([Char]
"--" forall a. [a] -> [a] -> [a]
++ [Char]
reExecArgName forall a. [a] -> [a] -> [a]
++ [Char]
"=" forall a. [a] -> [a] -> [a]
++ Version -> [Char]
showVersion Version
Meta.version) forall a. a -> [a] -> [a]
: [[Char]]
origArgs
   [Char]
exePath <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Char]
getExecutablePath
   Config
config <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL
   ProcessContext
envOverride <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
   forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (forall s t a b. ASetter s t a b -> b -> s -> t
set forall env. HasProcessContext env => Lens' env ProcessContext
processContextL ProcessContext
envOverride) forall a b. (a -> b) -> a -> b
$ do
     let cmnd :: [Char]
cmnd = [Char] -> [Char]
escape [Char]
exePath
         args' :: [[Char]]
args' = forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
escape [[Char]]
args

     Maybe (Path Abs File)
mshellFile <- case Config -> Maybe (Path Abs Dir)
configProjectRoot Config
config of
         Just Path Abs Dir
projectRoot ->
             forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> [Char] -> m (Path Abs File)
resolveFile Path Abs Dir
projectRoot) forall a b. (a -> b) -> a -> b
$ NixOpts -> Maybe [Char]
nixInitFile (Config -> NixOpts
configNix Config
config)
         Maybe (Path Abs Dir)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

     -- This will never result in double loading the build config, since:

     --

     -- 1. This function explicitly takes a Config, not a HasConfig

     --

     -- 2. This function ends up exiting before running other code

     -- (thus the void return type)

     WantedCompiler
compilerVersion <- forall a. RIO BuildConfig a -> RIO Config a
withBuildConfig forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s r. HasBuildConfig s => Getting r s WantedCompiler
wantedCompilerVersionL

     Text
ghc <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ WantedCompiler -> Either StringException Text
nixCompiler WantedCompiler
compilerVersion
     Text
ghcVersion <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ WantedCompiler -> Either StringException Text
nixCompilerVersion WantedCompiler
compilerVersion
     let pkgsInConfig :: [Text]
pkgsInConfig = NixOpts -> [Text]
nixPackages (Config -> NixOpts
configNix Config
config)
         pkgs :: [Text]
pkgs = [Text]
pkgsInConfig forall a. [a] -> [a] -> [a]
++ [Text
ghc, Text
"git", Text
"gcc", Text
"gmp"]
         pkgsStr :: Text
pkgsStr = Text
"[" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" " [Text]
pkgs forall a. Semigroup a => a -> a -> a
<> Text
"]"
         pureShell :: Bool
pureShell = NixOpts -> Bool
nixPureShell (Config -> NixOpts
configNix Config
config)
         addGCRoots :: Bool
addGCRoots = NixOpts -> Bool
nixAddGCRoots (Config -> NixOpts
configNix Config
config)
         nixopts :: [[Char]]
nixopts = case Maybe (Path Abs File)
mshellFile of
           Just Path Abs File
fp -> [forall b t. Path b t -> [Char]
toFilePath Path Abs File
fp
                      ,[Char]
"--arg", [Char]
"ghc", [Char]
"with (import <nixpkgs> {}); " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
ghc
                      ,[Char]
"--argstr", [Char]
"ghcVersion", Text -> [Char]
T.unpack Text
ghcVersion]
           Maybe (Path Abs File)
Nothing -> [[Char]
"-E", Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
                              [Text
"with (import <nixpkgs> {}); "
                              ,Text
"let inputs = ",Text
pkgsStr,Text
"; "
                              ,    Text
"libPath = lib.makeLibraryPath inputs; "
                              ,    Text
"stackExtraArgs = lib.concatMap (pkg: "
                              ,    Text
"[ ''--extra-lib-dirs=${lib.getLib pkg}/lib'' "
                              ,    Text
"  ''--extra-include-dirs=${lib.getDev pkg}/include'' ]"
                              ,    Text
") inputs; in "
                              ,Text
"runCommand ''myEnv'' { "
                              ,Text
"buildInputs = lib.optional stdenv.isLinux glibcLocales ++ inputs; "
                              ,[Char] -> Text
T.pack [Char]
platformVariantEnvVar forall a. Semigroup a => a -> a -> a
<> Text
"=''nix''; "
                              ,[Char] -> Text
T.pack [Char]
inNixShellEnvVar forall a. Semigroup a => a -> a -> a
<> Text
"=1; "
                              ,if Bool
inContainer
                                  -- If shell is pure, this env var would not

                                  -- be seen by stack inside nix

                                  then [Char] -> Text
T.pack [Char]
inContainerEnvVar forall a. Semigroup a => a -> a -> a
<> Text
"=1; "
                                  else Text
""
                              ,Text
"LD_LIBRARY_PATH = libPath;"  -- LD_LIBRARY_PATH is set because for now it's

                               -- needed by builds using Template Haskell

                              ,Text
"STACK_IN_NIX_EXTRA_ARGS = stackExtraArgs; "
                               -- overriding default locale so Unicode output using base won't be broken

                              ,Text
"LANG=\"en_US.UTF-8\";"
                              ,Text
"} \"\""]]
                    -- glibcLocales is necessary on Linux to avoid warnings about GHC being incapable to set the locale.

         fullArgs :: [[Char]]
fullArgs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [if Bool
pureShell then [[Char]
"--pure"] else []
                           ,if Bool
addGCRoots then [[Char]
"--indirect", [Char]
"--add-root"
                                               ,forall b t. Path b t -> [Char]
toFilePath (Config -> Path Rel Dir
configWorkDir Config
config)
                                                [Char] -> [Char] -> [Char]
F.</> [Char]
"nix-gc-symlinks" [Char] -> [Char] -> [Char]
F.</> [Char]
"gc-root"] else []
                           ,forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
T.unpack (NixOpts -> [Text]
nixShellOptions (Config -> NixOpts
configNix Config
config))
                           ,[[Char]]
nixopts
                           ,[[Char]
"--run", [[Char]] -> [Char]
unwords ([Char]
cmndforall a. a -> [a] -> [a]
:[Char]
"$STACK_IN_NIX_EXTRA_ARGS"forall a. a -> [a] -> [a]
:[[Char]]
args')]
                           ]
                           -- Using --run instead of --command so we cannot

                           -- end up in the nix-shell if stack build is Ctrl-C'd

     Maybe [Char]
pathVar <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"PATH"
     forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Utf8Builder
"PATH is: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow Maybe [Char]
pathVar
     forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall a b. (a -> b) -> a -> b
$
       Utf8Builder
"Using a nix-shell environment " forall a. Semigroup a => a -> a -> a
<> (case Maybe (Path Abs File)
mshellFile of
            Just Path Abs File
path -> Utf8Builder
"from file: " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall b t. Path b t -> [Char]
toFilePath Path Abs File
path)
            Maybe (Path Abs File)
Nothing -> Utf8Builder
"with nix packages: " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display (Text -> [Text] -> Text
T.intercalate Text
", " [Text]
pkgs))
     forall env b.
(HasProcessContext env, HasLogFunc env) =>
[Char] -> [[Char]] -> RIO env b
exec [Char]
"nix-shell" [[Char]]
fullArgs

-- | Shell-escape quotes inside the string and enclose it in quotes.

escape :: String -> String
escape :: [Char] -> [Char]
escape [Char]
str = [Char]
"'" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Char
c -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
'\'' then
                                   ([Char]
"'\"'\"'"forall a. [a] -> [a] -> [a]
++)
                                 else (Char
cforall a. a -> [a] -> [a]
:)) [Char]
"" [Char]
str
                 forall a. [a] -> [a] -> [a]
++ [Char]
"'"

-- | Command-line argument for "nix"

nixCmdName :: String
nixCmdName :: [Char]
nixCmdName = [Char]
"nix"

nixHelpOptName :: String
nixHelpOptName :: [Char]
nixHelpOptName = [Char]
nixCmdName forall a. [a] -> [a] -> [a]
++ [Char]
"-help"

-- | Exceptions thrown by "Stack.Nix".

data StackNixException
  = CannotDetermineProjectRoot
    -- ^ Can't determine the project root (location of the shell file if any).

  deriving (Typeable)

instance Exception StackNixException

instance Show StackNixException where
  show :: StackNixException -> [Char]
show StackNixException
CannotDetermineProjectRoot =
    [Char]
"Cannot determine project root directory."