module Stack.Build
(build
,clean)
where
import Control.Monad
import Control.Monad.Catch (MonadCatch, MonadMask)
import Control.Monad.IO.Class
import Control.Monad.Logger
import Control.Monad.Reader (MonadReader, asks)
import Control.Monad.Trans.Resource
import Data.Function
import Data.Map.Strict (Map)
import qualified Data.Map as Map
import Network.HTTP.Client.Conduit (HasHttpManager)
import Path.IO
import Prelude hiding (FilePath, writeFile)
import Stack.Build.ConstructPlan
import Stack.Build.Execute
import Stack.Build.Haddock
import Stack.Build.Installed
import Stack.Build.Source
import Stack.Build.Types
import Stack.Constants
import Stack.Fetch as Fetch
import Stack.GhcPkg
import Stack.Package
import Stack.Types
import Stack.Types.Internal
type M env m = (MonadIO m,MonadReader env m,HasHttpManager env,HasBuildConfig env,MonadLogger m,MonadBaseControl IO m,MonadCatch m,MonadMask m,HasLogLevel env,HasEnvConfig env,HasTerminal env)
build :: M env m => BuildOpts -> m ()
build bopts = do
menv <- getMinimalEnvOverride
(mbp, locals, extraToBuild, sourceMap) <- loadSourceMap bopts
(installedMap, locallyRegistered) <-
getInstalled menv
GetInstalledOpts
{ getInstalledProfiling = profiling
, getInstalledHaddock = shouldHaddockDeps bopts }
sourceMap
baseConfigOpts <- mkBaseConfigOpts bopts
plan <- withLoadPackage menv $ \loadPackage ->
constructPlan mbp baseConfigOpts locals extraToBuild locallyRegistered loadPackage sourceMap installedMap
when (boptsPreFetch bopts) $
preFetch plan
if boptsDryrun bopts
then printPlan (boptsFinalAction bopts) plan
else executePlan menv bopts baseConfigOpts locals sourceMap plan
where
profiling = boptsLibProfile bopts || boptsExeProfile bopts
mkBaseConfigOpts :: (MonadIO m, MonadReader env m, HasEnvConfig env, MonadThrow m)
=> BuildOpts -> m BaseConfigOpts
mkBaseConfigOpts bopts = do
snapDBPath <- packageDatabaseDeps
localDBPath <- packageDatabaseLocal
snapInstallRoot <- installationRootDeps
localInstallRoot <- installationRootLocal
return BaseConfigOpts
{ bcoSnapDB = snapDBPath
, bcoLocalDB = localDBPath
, bcoSnapInstallRoot = snapInstallRoot
, bcoLocalInstallRoot = localInstallRoot
, bcoBuildOpts = bopts
}
withLoadPackage :: M env m
=> EnvOverride
-> ((PackageName -> Version -> Map FlagName Bool -> IO Package) -> m a)
-> m a
withLoadPackage menv inner = do
econfig <- asks getEnvConfig
withCabalLoader menv $ \cabalLoader ->
inner $ \name version flags -> do
bs <- cabalLoader $ PackageIdentifier name version
readPackageBS (depPackageConfig econfig flags) bs
where
depPackageConfig :: EnvConfig -> Map FlagName Bool -> PackageConfig
depPackageConfig econfig flags = PackageConfig
{ packageConfigEnableTests = False
, packageConfigEnableBenchmarks = False
, packageConfigFlags = flags
, packageConfigGhcVersion = envConfigGhcVersion econfig
, packageConfigPlatform = configPlatform (getConfig econfig)
}
clean :: (M env m) => m ()
clean = do
bconfig <- asks getBuildConfig
forM_
(Map.keys (bcPackages bconfig))
(distDirFromDir >=> removeTreeIfExists)