{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
module Stack.Build
(build
,clean
,withLoadPackage
,mkBaseConfigOpts)
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 qualified Data.Map as Map
import Data.Map.Strict (Map)
import Data.Set (Set)
import qualified Data.Set as Set
import Network.HTTP.Client.Conduit (HasHttpManager)
import Path
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.Target
import Stack.Constants
import Stack.Fetch as Fetch
import Stack.GhcPkg
import Stack.Package
import Stack.Types
import Stack.Types.Internal
import System.FileLock (FileLock, unlockFile)
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
=> (Set (Path Abs File) -> IO ())
-> Maybe FileLock
-> BuildOpts
-> m ()
build setLocalFiles mbuildLk bopts = do
menv <- getMinimalEnvOverride
(_, mbp, locals, extraToBuild, sourceMap) <- loadSourceMap NeedTargets bopts
stackYaml <- asks $ bcStackYaml . getBuildConfig
liftIO $ setLocalFiles
$ Set.insert stackYaml
$ Set.unions
$ map lpFiles locals
(installedMap, globallyRegistered, 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
case (mbuildLk, allLocal plan) of
(Just lk,True) -> do $logDebug "All installs are local; releasing snapshot lock early."
liftIO $ unlockFile lk
_ -> return ()
when (boptsPreFetch bopts) $
preFetch plan
if boptsDryrun bopts
then printPlan plan
else executePlan menv bopts baseConfigOpts locals
globallyRegistered
sourceMap
installedMap
plan
where
profiling = boptsLibProfile bopts || boptsExeProfile bopts
allLocal :: Plan -> Bool
allLocal =
all (== Local) .
map taskLocation .
Map.elems .
planTasks
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 :: ( MonadIO m
, HasHttpManager env
, MonadReader env m
, MonadBaseControl IO m
, MonadCatch m
, MonadLogger m
, HasEnvConfig env)
=> 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
(_warnings,pkg) <- readPackageBS (depPackageConfig econfig flags) bs
return pkg
where
depPackageConfig :: EnvConfig -> Map FlagName Bool -> PackageConfig
depPackageConfig econfig flags = PackageConfig
{ packageConfigEnableTests = False
, packageConfigEnableBenchmarks = False
, packageConfigFlags = flags
, packageConfigCompilerVersion = envConfigCompilerVersion econfig
, packageConfigPlatform = configPlatform (getConfig econfig)
}
clean :: (M env m) => m ()
clean = do
econfig <- asks getEnvConfig
forM_
(Map.keys (envConfigPackages econfig))
(distDirFromDir >=> removeTreeIfExists)