{-# LANGUAGE NoImplicitPrelude  #-}
{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE OverloadedStrings  #-}

-- | Run commands in a nix-shell

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

import qualified Data.Text as T
import           Path.IO ( resolveFile )
import           RIO.Process ( exec, processContextL )
import           Stack.Config ( getInContainer, withBuildConfig )
import           Stack.Config.Nix ( nixCompiler, nixCompilerVersion )
import           Stack.Constants
                   ( inContainerEnvVar, inNixShellEnvVar
                   , platformVariantEnvVar
                   )
import           Stack.Prelude
import           Stack.Types.BuildConfig ( wantedCompilerVersionL )
import           Stack.Types.Config
                   ( Config (..), HasConfig (..), configProjectRoot )
import           Stack.Types.Docker ( reExecArgName )
import           Stack.Types.Nix ( NixOpts (..) )
import           Stack.Types.Version ( showStackVersion )
import           System.Environment ( getArgs, getExecutablePath, lookupEnv )
import qualified System.FilePath as F

-- | Type representing exceptions thrown by functions exported by the

-- "Stack.Nix" module.

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

  deriving (Int -> NixException -> ShowS
[NixException] -> ShowS
NixException -> [Char]
(Int -> NixException -> ShowS)
-> (NixException -> [Char])
-> ([NixException] -> ShowS)
-> Show NixException
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NixException -> ShowS
showsPrec :: Int -> NixException -> ShowS
$cshow :: NixException -> [Char]
show :: NixException -> [Char]
$cshowList :: [NixException] -> ShowS
showList :: [NixException] -> ShowS
Show, Typeable)

instance Exception NixException where
  displayException :: NixException -> [Char]
displayException NixException
CannotDetermineProjectRoot =
    [Char]
"Error: [S-7384]\n"
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"Cannot determine project root directory."

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

  [[Char]]
origArgs <- IO [[Char]] -> RIO Config [[Char]]
forall a. IO a -> RIO Config a
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]
"--" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
reExecArgName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
showStackVersion) [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
origArgs
  [Char]
exePath <- IO [Char] -> RIO Config [Char]
forall a. IO a -> RIO Config a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Char]
getExecutablePath
  Config
config <- Getting Config Config Config -> RIO Config Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Config Config Config
forall env. HasConfig env => Lens' env Config
Lens' Config Config
configL
  ProcessContext
envOverride <- Getting ProcessContext Config ProcessContext
-> RIO Config ProcessContext
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProcessContext Config ProcessContext
forall env. HasProcessContext env => Lens' env ProcessContext
Lens' Config ProcessContext
processContextL
  (Config -> Config) -> RIO Config void -> RIO Config void
forall a. (Config -> Config) -> RIO Config a -> RIO Config a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (ASetter Config Config ProcessContext ProcessContext
-> ProcessContext -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Config Config ProcessContext ProcessContext
forall env. HasProcessContext env => Lens' env ProcessContext
Lens' Config ProcessContext
processContextL ProcessContext
envOverride) (RIO Config void -> RIO Config void)
-> RIO Config void -> RIO Config void
forall a b. (a -> b) -> a -> b
$ do
    let cmnd :: [Char]
cmnd = ShowS
escape [Char]
exePath
        args' :: [[Char]]
args' = ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
escape [[Char]]
args

    Maybe (Path Abs File)
mshellFile <- case Config -> Maybe (Path Abs Dir)
configProjectRoot Config
config of
      Just Path Abs Dir
projectRoot ->
        ([Char] -> RIO Config (Path Abs File))
-> Maybe [Char] -> RIO Config (Maybe (Path Abs File))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (Path Abs Dir -> [Char] -> RIO Config (Path Abs File)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> [Char] -> m (Path Abs File)
resolveFile Path Abs Dir
projectRoot) (Maybe [Char] -> RIO Config (Maybe (Path Abs File)))
-> Maybe [Char] -> RIO Config (Maybe (Path Abs File))
forall a b. (a -> b) -> a -> b
$ NixOpts -> Maybe [Char]
nixInitFile (Config -> NixOpts
configNix Config
config)
      Maybe (Path Abs Dir)
Nothing -> Maybe (Path Abs File) -> RIO Config (Maybe (Path Abs File))
forall a. a -> RIO Config a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Path Abs File)
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 <- RIO BuildConfig WantedCompiler -> RIO Config WantedCompiler
forall a. RIO BuildConfig a -> RIO Config a
withBuildConfig (RIO BuildConfig WantedCompiler -> RIO Config WantedCompiler)
-> RIO BuildConfig WantedCompiler -> RIO Config WantedCompiler
forall a b. (a -> b) -> a -> b
$ Getting WantedCompiler BuildConfig WantedCompiler
-> RIO BuildConfig WantedCompiler
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting WantedCompiler BuildConfig WantedCompiler
forall s r. HasBuildConfig s => Getting r s WantedCompiler
wantedCompilerVersionL

    Text
ghc <- (ConfigNixException -> RIO Config Text)
-> (Text -> RIO Config Text)
-> Either ConfigNixException Text
-> RIO Config Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ConfigNixException -> RIO Config Text
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO Text -> RIO Config Text
forall a. a -> RIO Config a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ConfigNixException Text -> RIO Config Text)
-> Either ConfigNixException Text -> RIO Config Text
forall a b. (a -> b) -> a -> b
$ WantedCompiler -> Either ConfigNixException Text
nixCompiler WantedCompiler
compilerVersion
    Text
ghcVersion <- (ConfigNixException -> RIO Config Text)
-> (Text -> RIO Config Text)
-> Either ConfigNixException Text
-> RIO Config Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ConfigNixException -> RIO Config Text
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO Text -> RIO Config Text
forall a. a -> RIO Config a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ConfigNixException Text -> RIO Config Text)
-> Either ConfigNixException Text -> RIO Config Text
forall a b. (a -> b) -> a -> b
$ WantedCompiler -> Either ConfigNixException Text
nixCompilerVersion WantedCompiler
compilerVersion
    let pkgsInConfig :: [Text]
pkgsInConfig = NixOpts -> [Text]
nixPackages (Config -> NixOpts
configNix Config
config)
        pkgs :: [Text]
pkgs = [Text]
pkgsInConfig [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
ghc, Text
"git", Text
"gcc", Text
"gmp"]
        pkgsStr :: Text
pkgsStr = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" " [Text]
pkgs Text -> Text -> Text
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 ->
            [ Path Abs File -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs File
fp
            , [Char]
"--arg"
            , [Char]
"ghc"
            , [Char]
"with (import <nixpkgs> {}); " [Char] -> ShowS
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 (Text -> [Char]) -> Text -> [Char]
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; "
                  -- glibcLocales is necessary on Linux to avoid warnings about

                  -- GHC being incapable to set the locale.

                , [Char] -> Text
T.pack [Char]
platformVariantEnvVar Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=''nix''; "
                , [Char] -> Text
T.pack [Char]
inNixShellEnvVar Text -> Text -> Text
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 Text -> Text -> Text
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
"} \"\""
                ]
            ]

        fullArgs :: [[Char]]
fullArgs = [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ [ [Char]
"--pure" | Bool
pureShell ]
          , if Bool
addGCRoots
              then [ [Char]
"--indirect"
                   , [Char]
"--add-root"
                   , Path Rel Dir -> [Char]
forall b t. Path b t -> [Char]
toFilePath
                             (Config -> Path Rel Dir
configWorkDir Config
config)
                       [Char] -> ShowS
F.</> [Char]
"nix-gc-symlinks"
                       [Char] -> ShowS
F.</> [Char]
"gc-root"
                   ]
              else []
          , (Text -> [Char]) -> [Text] -> [[Char]]
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]
cmnd[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[Char]
"$STACK_IN_NIX_EXTRA_ARGS"[Char] -> [[Char]] -> [[Char]]
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 <- IO (Maybe [Char]) -> RIO Config (Maybe [Char])
forall a. IO a -> RIO Config a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Char]) -> RIO Config (Maybe [Char]))
-> IO (Maybe [Char]) -> RIO Config (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"PATH"
    Utf8Builder -> RIO Config ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO Config ()) -> Utf8Builder -> RIO Config ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"PATH is: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Maybe [Char] -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow Maybe [Char]
pathVar
    Utf8Builder -> RIO Config ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO Config ()) -> Utf8Builder -> RIO Config ()
forall a b. (a -> b) -> a -> b
$
         Utf8Builder
"Using a nix-shell environment "
      Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> ( case Maybe (Path Abs File)
mshellFile of
             Just Path Abs File
path ->
                  Utf8Builder
"from file: "
               Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Path Abs File -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs File
path)
             Maybe (Path Abs File)
Nothing ->
                  Utf8Builder
"with nix packages: "
               Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Text -> [Text] -> Text
T.intercalate Text
", " [Text]
pkgs)
         )
    [Char] -> [[Char]] -> RIO Config void
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 :: ShowS
escape [Char]
str =
     [Char]
"'"
  [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Char -> ShowS) -> [Char] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' then ([Char]
"'\"'\"'"++) else (Char
c:)) [Char]
"" [Char]
str
  [Char] -> ShowS
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 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"-help"