{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Stack.Nix
(reexecWithOptionalShell
,nixCmdName
,nixHelpOptName
) where
import Control.Applicative
import Control.Arrow ((***))
import Control.Exception (Exception,throw)
import Control.Monad
import Control.Monad.Catch (try,MonadCatch)
import Control.Monad.IO.Class (MonadIO,liftIO)
import Control.Monad.Logger (MonadLogger,logDebug)
import Control.Monad.Reader (MonadReader,asks)
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Char (toUpper)
import Data.List (intercalate)
import Data.Traversable
import Data.Maybe
import Data.Monoid
import Data.Streaming.Process (ProcessExitedUnsuccessfully(..))
import qualified Data.Text as T
import Data.Version (showVersion)
import Data.Typeable (Typeable)
import Network.HTTP.Client.Conduit (HasHttpManager)
import Path
import Path.IO
import qualified Paths_stack as Meta
import Prelude
import Stack.Constants (stackProgName,platformVariantEnvVar)
import Stack.Docker (reExecArgName)
import Stack.Exec (exec)
import System.Process.Read (getEnvOverride)
import Stack.Types
import Stack.Types.Internal
import System.Environment (lookupEnv,getArgs,getExecutablePath)
import System.Exit (exitSuccess, exitWith)
reexecWithOptionalShell
:: M env m
=> Maybe (Path Abs Dir)
-> IO ()
-> m ()
reexecWithOptionalShell mprojectRoot inner =
do config <- asks getConfig
inShell <- getInShell
isReExec <- asks getReExec
if nixEnable (configNix config) && not inShell && not isReExec
then runShellAndExit mprojectRoot getCmdArgs
else liftIO inner
where
getCmdArgs = do
args <-
fmap
(("--" ++ reExecArgName ++ "=" ++ showVersion Meta.version) :)
(liftIO getArgs)
exePath <- liftIO getExecutablePath
return (exePath, args)
runShellAndExit
:: M env m
=> Maybe (Path Abs Dir)
-> m (String, [String])
-> m ()
runShellAndExit mprojectRoot getCmdArgs = do
config <- asks getConfig
envOverride <- getEnvOverride (configPlatform config)
(cmnd,args) <- fmap (escape *** map escape) getCmdArgs
mshellFile <-
traverse (resolveFile (fromMaybeProjectRoot mprojectRoot)) $
nixInitFile (configNix config)
let pkgsInConfig = nixPackages (configNix config)
pureShell = nixPureShell (configNix config)
nixopts = case mshellFile of
Just fp -> [toFilePath fp]
Nothing -> ["-E", T.unpack $ T.intercalate " " $ concat
[["with (import <nixpkgs> {});"
,"runCommand \"myEnv\" {"
,"buildInputs=lib.optional stdenv.isLinux glibcLocales ++ ["],pkgsInConfig,["];"
,T.pack platformVariantEnvVar <> "=''nix'';"
,T.pack inShellEnvVar <> "=1;"
,"STACK_IN_NIX_EXTRA_ARGS=''"]
, (map (\p -> T.concat
["--extra-lib-dirs=${",p,"}/lib"
," --extra-include-dirs=${",p,"}/include "])
pkgsInConfig), ["'' ;"
,"} \"\""]]]
fullArgs = concat [if pureShell then ["--pure"] else [],
map T.unpack (nixShellOptions (configNix config))
,nixopts
,["--command", intercalate " " (cmnd:"$STACK_IN_NIX_EXTRA_ARGS":args)]
]
$logDebug $
"Using a nix-shell environment " <> (case mshellFile of
Just path -> "from file: " <> (T.pack (toFilePath path))
Nothing -> "with nix packages: " <> (T.intercalate ", " pkgsInConfig))
e <- try (exec envOverride "nix-shell" fullArgs)
case e of
Left (ProcessExitedUnsuccessfully _ ec) -> liftIO (exitWith ec)
Right () -> liftIO exitSuccess
escape :: String -> String
escape str = "'" ++ foldr (\c -> if c == '\'' then
("'\"'\"'"++)
else (c:)) "" str
++ "'"
fromMaybeProjectRoot :: Maybe (Path Abs Dir) -> Path Abs Dir
fromMaybeProjectRoot = fromMaybe (throw CannotDetermineProjectRootException)
getInShell :: (MonadIO m) => m Bool
getInShell = liftIO (isJust <$> lookupEnv inShellEnvVar)
inShellEnvVar :: String
inShellEnvVar = concat [map toUpper stackProgName,"_IN_NIXSHELL"]
nixCmdName :: String
nixCmdName = "nix"
nixHelpOptName :: String
nixHelpOptName = nixCmdName ++ "-help"
data StackNixException
= CannotDetermineProjectRootException
deriving (Typeable)
instance Exception StackNixException
instance Show StackNixException where
show CannotDetermineProjectRootException =
"Cannot determine project root directory."
type M env m =
(MonadIO m
,MonadReader env m
,MonadLogger m
,MonadBaseControl IO m
,MonadCatch m
,HasConfig env
,HasTerminal env
,HasReExec env
,HasHttpManager env
)