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 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 :: GlobalOpts
-> LoadConfig (StackT () IO)
-> IO CompilerVersion
loadCompilerVersion go lc = do
bconfig <- runStackTGlobal () go $
lcLoadBuildConfig lc (globalCompiler go)
return $ view wantedCompilerVersionL 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
lc <- loadConfigWithOpts go
withUserFileLock go (configStackRoot $ lcConfig lc) $ \lk ->
runStackTGlobal (lcConfig lc) go $
Docker.reexecWithOptionalContainer
(lcProjectRoot lc)
Nothing
(runStackTGlobal (lcConfig lc) go inner)
Nothing
(Just $ munlockFile lk)
withGlobalConfigAndLock
:: GlobalOpts
-> StackT Config IO ()
-> IO ()
withGlobalConfigAndLock go@GlobalOpts{..} inner = do
lc <- runStackTGlobal () go $
loadConfigMaybeProject
globalConfigMonoid
Nothing
LCSNoProject
withUserFileLock go (configStackRoot $ lcConfig lc) $ \_lk ->
runStackTGlobal (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
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 <- runStackTGlobal () go $
lcLoadBuildConfig lc globalCompiler
envConfig <-
runStackTGlobal
bconfig go
(setupEnv Nothing)
runStackTGlobal
envConfig
go
(inner' lk)
let getCompilerVersion = loadCompilerVersion go lc
runStackTGlobal (lcConfig lc) go $
Docker.reexecWithOptionalContainer
(lcProjectRoot lc)
mbefore
(runStackTGlobal (lcConfig lc) go $
Nix.reexecWithOptionalShell (lcProjectRoot lc) getCompilerVersion (inner'' lk0))
mafter
(Just $ liftIO $
do lk' <- readIORef curLk
munlockFile lk')
loadConfigWithOpts :: GlobalOpts -> IO (LoadConfig (StackT () IO))
loadConfigWithOpts go@GlobalOpts{..} = do
mstackYaml <- forM globalStackYaml resolveFile'
runStackTGlobal () go $ do
lc <- loadConfig globalConfigMonoid globalResolver mstackYaml
case globalDockerEntrypoint of
Just de -> Docker.entrypoint (lcConfig lc) de
Nothing -> return ()
return lc
withMiniConfigAndLock
:: GlobalOpts
-> StackT MiniConfig IO ()
-> IO ()
withMiniConfigAndLock go@GlobalOpts{..} inner = do
miniConfig <-
runStackTGlobal () go $
(loadMiniConfig . lcConfig) <$>
loadConfigMaybeProject
globalConfigMonoid
globalResolver
LCSNoProject
runStackTGlobal miniConfig go inner
munlockFile :: MonadIO m => Maybe FileLock -> m ()
munlockFile Nothing = return ()
munlockFile (Just lk) = liftIO $ unlockFile lk