{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Stack.Runners
( withGlobalConfigAndLock
, withConfigAndLock
, withMiniConfigAndLock
, withBuildConfigAndLock
, withBuildConfigAndLockNoDocker
, withBuildConfig
, withBuildConfigExt
, withBuildConfigDot
, loadConfigWithOpts
, loadCompilerVersion
, withUserFileLock
, munlockFile
) where
import Stack.Prelude
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, CVType (..))
import Stack.Types.Config
import Stack.Types.Runner
import System.Environment (getEnvironment)
import System.IO
import System.FileLock
import Stack.Dot
loadCompilerVersion :: GlobalOpts
-> LoadConfig
-> IO (CompilerVersion 'CVWanted)
loadCompilerVersion go lc =
view wantedCompilerVersionL <$> lcLoadBuildConfig lc (globalCompiler go)
withUserFileLock :: MonadUnliftIO 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
bracket (liftIO $ tryLockFile (toFilePath pth) Exclusive)
(maybe (return ()) (liftIO . unlockFile))
(\fstTry ->
case fstTry of
Just lk -> 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..."
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
-> RIO Config ()
-> IO ()
withConfigAndLock go@GlobalOpts{..} inner = loadConfigWithOpts go $ \lc -> do
withUserFileLock go (view stackRootL lc) $ \lk ->
runRIO (lcConfig lc) $
Docker.reexecWithOptionalContainer
(lcProjectRoot lc)
Nothing
(runRIO (lcConfig lc) inner)
Nothing
(Just $ munlockFile lk)
withGlobalConfigAndLock
:: GlobalOpts
-> RIO Config ()
-> IO ()
withGlobalConfigAndLock go@GlobalOpts{..} inner = withRunnerGlobal go $ \runner -> do
lc <- runRIO runner $
loadConfigMaybeProject
globalConfigMonoid
Nothing
LCSNoProject
withUserFileLock go (view stackRootL lc) $ \_lk ->
runRIO (lcConfig lc) inner
withBuildConfig
:: GlobalOpts
-> RIO EnvConfig ()
-> IO ()
withBuildConfig go inner =
withBuildConfigAndLock go (\lk -> do munlockFile lk
inner)
withBuildConfigAndLock
:: GlobalOpts
-> (Maybe FileLock -> RIO EnvConfig ())
-> IO ()
withBuildConfigAndLock go inner =
withBuildConfigExt False go Nothing inner Nothing
withBuildConfigAndLockNoDocker
:: GlobalOpts
-> (Maybe FileLock -> RIO EnvConfig ())
-> IO ()
withBuildConfigAndLockNoDocker go inner =
withBuildConfigExt True go Nothing inner Nothing
withBuildConfigExt
:: Bool
-> GlobalOpts
-> Maybe (RIO Config ())
-> (Maybe FileLock -> RIO EnvConfig ())
-> Maybe (RIO Config ())
-> IO ()
withBuildConfigExt skipDocker go@GlobalOpts{..} mbefore inner mafter = loadConfigWithOpts go $ \lc -> do
withUserFileLock go (view stackRootL 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 <- lcLoadBuildConfig lc globalCompiler
envConfig <- runRIO bconfig (setupEnv Nothing)
runRIO envConfig (inner' lk)
let getCompilerVersion = loadCompilerVersion go lc
if skipDocker
then runRIO (lcConfig lc) $ do
forM_ mbefore id
Nix.reexecWithOptionalShell (lcProjectRoot lc) getCompilerVersion (inner'' lk0)
forM_ mafter id
else runRIO (lcConfig lc) $
Docker.reexecWithOptionalContainer
(lcProjectRoot lc)
mbefore
(runRIO (lcConfig lc) $
Nix.reexecWithOptionalShell (lcProjectRoot lc) getCompilerVersion (inner'' lk0))
mafter
(Just $ liftIO $
do lk' <- readIORef curLk
munlockFile lk')
loadConfigWithOpts
:: GlobalOpts
-> (LoadConfig -> IO a)
-> IO a
loadConfigWithOpts go@GlobalOpts{..} inner = withRunnerGlobal go $ \runner -> do
mstackYaml <- forM globalStackYaml resolveFile'
runRIO runner $ do
lc <- loadConfig globalConfigMonoid globalResolver mstackYaml
forM_ globalDockerEntrypoint $ Docker.entrypoint (lcConfig lc)
liftIO $ inner lc
withRunnerGlobal :: GlobalOpts -> (Runner -> IO a) -> IO a
withRunnerGlobal GlobalOpts{..} = withRunner
globalLogLevel
globalTimeInLog
globalTerminal
globalColorWhen
globalTermWidth
(isJust globalReExecVersion)
withMiniConfigAndLock
:: GlobalOpts
-> RIO MiniConfig ()
-> IO ()
withMiniConfigAndLock go@GlobalOpts{..} inner = withRunnerGlobal go $ \runner -> do
miniConfig <-
runRIO runner $
loadMiniConfig . lcConfig <$>
loadConfigMaybeProject
globalConfigMonoid
globalResolver
LCSNoProject
runRIO miniConfig inner
munlockFile :: MonadIO m => Maybe FileLock -> m ()
munlockFile Nothing = return ()
munlockFile (Just lk) = liftIO $ unlockFile lk
withBuildConfigDot :: DotOpts -> GlobalOpts -> RIO EnvConfig () -> IO ()
withBuildConfigDot opts go f = withBuildConfig go' f
where
go' =
(if dotTestTargets opts then set (globalOptsBuildOptsMonoidL.buildOptsMonoidTestsL) (Just True) else id) $
(if dotBenchTargets opts then set (globalOptsBuildOptsMonoidL.buildOptsMonoidBenchmarksL) (Just True) else id)
go