module Stack.Runners
( withGlobalConfigAndLock
, withConfigAndLock
, withMiniConfigAndLock
, withBuildConfigAndLock
, withBuildConfig
, withBuildConfigExt
, loadConfigWithOpts
, loadCompilerVersion
, withUserFileLock
, munlockFile
) where
import Control.Monad hiding (forM)
import Control.Monad.Logger
import Control.Exception.Lifted as EL
import Control.Monad.IO.Class
import Control.Monad.Trans.Control
import Data.IORef
import Data.Traversable
import Network.HTTP.Client
import Path
import Path.IO
import Stack.Config
import qualified Stack.Docker as Docker
import qualified Stack.Nix as Nix
import Stack.Setup
import Stack.Types.Compiler (CompilerVersion)
import Stack.Types.Config
import Stack.Types.StackT
import System.Environment (getEnvironment)
import System.IO
import System.FileLock
loadCompilerVersion :: Manager
-> GlobalOpts
-> LoadConfig (StackLoggingT IO)
-> IO CompilerVersion
loadCompilerVersion manager go lc = do
bconfig <- runStackLoggingTGlobal manager go $
lcLoadBuildConfig lc (globalCompiler go)
return $ bcWantedCompiler bconfig
withUserFileLock :: (MonadBaseControl IO m, MonadIO m)
=> GlobalOpts
-> Path Abs Dir
-> (Maybe FileLock -> m a)
-> m a
withUserFileLock go@GlobalOpts{} dir act = do
env <- liftIO getEnvironment
let toLock = lookup "STACK_LOCK" env == Just "true"
if toLock
then do
let lockfile = $(mkRelFile "lockfile")
let pth = dir </> lockfile
ensureDir dir
EL.bracket (liftIO $ tryLockFile (toFilePath pth) Exclusive)
(maybe (return ()) (liftIO . unlockFile))
(\fstTry ->
case fstTry of
Just lk -> EL.finally (act $ Just lk) (liftIO $ unlockFile lk)
Nothing ->
do let chatter = globalLogLevel go /= LevelOther "silent"
when chatter $
liftIO $ hPutStrLn stderr $ "Failed to grab lock ("++show pth++
"); other stack instance running. Waiting..."
EL.bracket (liftIO $ lockFile (toFilePath pth) Exclusive)
(liftIO . unlockFile)
(\lk -> do
when chatter $
liftIO $ hPutStrLn stderr "Lock acquired, proceeding."
act $ Just lk))
else act Nothing
withConfigAndLock
:: GlobalOpts
-> StackT Config IO ()
-> IO ()
withConfigAndLock go@GlobalOpts{..} inner = do
(manager, lc) <- loadConfigWithOpts go
withUserFileLock go (configStackRoot $ lcConfig lc) $ \lk ->
runStackTGlobal manager (lcConfig lc) go $
Docker.reexecWithOptionalContainer
(lcProjectRoot lc)
Nothing
(runStackTGlobal manager (lcConfig lc) go inner)
Nothing
(Just $ munlockFile lk)
withGlobalConfigAndLock
:: GlobalOpts
-> StackT Config IO ()
-> IO ()
withGlobalConfigAndLock go@GlobalOpts{..} inner = do
manager <- newTLSManager
lc <- runStackLoggingTGlobal manager go $
loadConfigMaybeProject globalConfigMonoid Nothing Nothing
withUserFileLock go (configStackRoot $ lcConfig lc) $ \_lk ->
runStackTGlobal manager (lcConfig lc) go inner
withBuildConfig
:: GlobalOpts
-> StackT EnvConfig IO ()
-> IO ()
withBuildConfig go inner =
withBuildConfigAndLock go (\lk -> do munlockFile lk
inner)
withBuildConfigAndLock
:: GlobalOpts
-> (Maybe FileLock -> StackT EnvConfig IO ())
-> IO ()
withBuildConfigAndLock go inner =
withBuildConfigExt go Nothing inner Nothing
withBuildConfigExt
:: GlobalOpts
-> Maybe (StackT Config IO ())
-> (Maybe FileLock -> StackT EnvConfig IO ())
-> Maybe (StackT Config IO ())
-> IO ()
withBuildConfigExt go@GlobalOpts{..} mbefore inner mafter = do
(manager, lc) <- loadConfigWithOpts go
withUserFileLock go (configStackRoot $ lcConfig lc) $ \lk0 -> do
curLk <- newIORef lk0
let inner' lk =
do dir <- installationRootDeps
withUserFileLock go dir $ \lk2 -> do
liftIO $ writeIORef curLk lk2
liftIO $ munlockFile lk
$logDebug "Starting to execute command inside EnvConfig"
inner lk2
let inner'' lk = do
bconfig <- runStackLoggingTGlobal manager go $
lcLoadBuildConfig lc globalCompiler
envConfig <-
runStackTGlobal
manager bconfig go
(setupEnv Nothing)
runStackTGlobal
manager
envConfig
go
(inner' lk)
let getCompilerVersion = loadCompilerVersion manager go lc
runStackTGlobal manager (lcConfig lc) go $
Docker.reexecWithOptionalContainer
(lcProjectRoot lc)
mbefore
(runStackTGlobal manager (lcConfig lc) go $
Nix.reexecWithOptionalShell (lcProjectRoot lc) getCompilerVersion (inner'' lk0))
mafter
(Just $ liftIO $
do lk' <- readIORef curLk
munlockFile lk')
loadConfigWithOpts :: GlobalOpts -> IO (Manager,LoadConfig (StackLoggingT IO))
loadConfigWithOpts go@GlobalOpts{..} = do
manager <- newTLSManager
mstackYaml <- forM globalStackYaml resolveFile'
lc <- runStackLoggingTGlobal manager go $ do
lc <- loadConfig globalConfigMonoid globalResolver mstackYaml
case globalDockerEntrypoint of
Just de -> Docker.entrypoint (lcConfig lc) de
Nothing -> return ()
return lc
return (manager,lc)
withMiniConfigAndLock
:: GlobalOpts
-> StackT MiniConfig IO ()
-> IO ()
withMiniConfigAndLock go@GlobalOpts{..} inner = do
manager <- newTLSManager
miniConfig <- runStackLoggingTGlobal manager go $ do
lc <- loadConfigMaybeProject globalConfigMonoid globalResolver Nothing
loadMiniConfig manager (lcConfig lc)
runStackTGlobal manager miniConfig go inner
munlockFile :: MonadIO m => Maybe FileLock -> m ()
munlockFile Nothing = return ()
munlockFile (Just lk) = liftIO $ unlockFile lk