From 9675f08d26ab3094cadb8dd39cdd296d84b072bc Mon Sep 17 00:00:00 2001 From: Chris Done Date: Thu, 6 Aug 2015 15:41:46 +0200 Subject: [PATCH 1/2] Add Bool fields for enabled test/benchmarks --- src/Stack/Build/Source.hs | 13 ++++--------- src/Stack/Build/Types.hs | 4 ++++ src/Stack/Options.hs | 4 +++- src/main/Main.hs | 14 +++++++++++++- 4 files changed, 24 insertions(+), 11 deletions(-) diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs index f234cf5b57..b731149b08 100644 --- a/src/Stack/Build/Source.hs +++ b/src/Stack/Build/Source.hs @@ -200,20 +200,15 @@ loadLocals bopts latestVersion = do name <- parsePackageNameFromFilePath cabalfp let wanted = validWanted && isWanted' dir name config = PackageConfig - { packageConfigEnableTests = False - , packageConfigEnableBenchmarks = False + { packageConfigEnableTests = wanted && boptsEnableTests bopts + , packageConfigEnableBenchmarks = wanted && boptsEnableBenchmarks bopts , packageConfigFlags = localFlags (boptsFlags bopts) bconfig name , packageConfigGhcVersion = envConfigGhcVersion econfig , packageConfigPlatform = configPlatform $ getConfig bconfig } configFinal = config - { packageConfigEnableTests = - case boptsFinalAction bopts of - DoTests _ -> wanted - _ -> False - , packageConfigEnableBenchmarks = wanted && case boptsFinalAction bopts of - (DoBenchmarks _) -> True - _ -> False + { packageConfigEnableTests = wanted && boptsEnableTests bopts + , packageConfigEnableBenchmarks = wanted && boptsEnableBenchmarks bopts } pkg <- readPackage config cabalfp pkgFinal <- readPackage configFinal cabalfp diff --git a/src/Stack/Build/Types.hs b/src/Stack/Build/Types.hs index b6f2150aa0..d45b6e78d1 100644 --- a/src/Stack/Build/Types.hs +++ b/src/Stack/Build/Types.hs @@ -337,6 +337,8 @@ data BuildOpts = ,boptsLibProfile :: !Bool ,boptsExeProfile :: !Bool ,boptsEnableOptimizations :: !(Maybe Bool) + ,boptsEnableTests :: !Bool + ,boptsEnableBenchmarks :: !Bool ,boptsHaddock :: !Bool -- ^ Build haddocks? ,boptsHaddockDeps :: !(Maybe Bool) @@ -379,6 +381,8 @@ defaultBuildOpts = BuildOpts , boptsFileWatch = False , boptsKeepGoing = Nothing , boptsForceDirty = False + , boptsEnableBenchmarks = False + , boptsEnableTests = False } -- | Options for the 'FinalAction' 'DoTests' diff --git a/src/Stack/Options.hs b/src/Stack/Options.hs index c7eb8932cb..4a9c0da2d8 100644 --- a/src/Stack/Options.hs +++ b/src/Stack/Options.hs @@ -62,12 +62,14 @@ buildOptsParser :: Command -> Parser BuildOpts buildOptsParser cmd defCopyBins = BuildOpts <$> target <*> libProfiling <*> exeProfiling <*> - optimize <*> haddock <*> haddockDeps <*> finalAction <*> dryRun <*> ghcOpts <*> + optimize <*> enableTests <*> enableBench <*> haddock <*> haddockDeps <*> finalAction <*> dryRun <*> ghcOpts <*> flags <*> copyBins <*> preFetch <*> ((||) <$> onlySnapshot <*> onlyDependencies) <*> fileWatch' <*> keepGoing <*> forceDirty where optimize = maybeBoolFlags "optimizations" "optimizations for TARGETs and all its dependencies" idm + enableTests = pure False + enableBench = pure False target = fmap (map T.pack) (many (strArgument diff --git a/src/main/Main.hs b/src/main/Main.hs index 3c71f2aa7b..71d4902663 100644 --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -626,7 +626,19 @@ buildCmdHelper beforeBuild finalAction opts go where inner setLocalFiles = withBuildConfigAndLock go $ \lk -> do beforeBuild - Stack.Build.build setLocalFiles (Just lk) opts { boptsFinalAction = finalAction } + Stack.Build.build + setLocalFiles + (Just lk) + opts { boptsFinalAction = finalAction + , boptsEnableTests = + case finalAction of + DoTests{} -> True + _ -> False + , boptsEnableBenchmarks = + case finalAction of + DoBenchmarks{} -> True + _ -> False + } -- | Build the project. buildCmd :: FinalAction -> BuildOpts -> GlobalOpts -> IO () From 0729c47f31ff306c2bc7a6edb935879be3ff737b Mon Sep 17 00:00:00 2001 From: Chris Done Date: Thu, 6 Aug 2015 16:38:20 +0200 Subject: [PATCH 2/2] Automatically run build on stack ghci --- src/Stack/Ghci.hs | 25 +++++++++++++++++++++---- src/Stack/Ide.hs | 8 ++++++-- 2 files changed, 27 insertions(+), 6 deletions(-) diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs index 9c95a1509a..200e2bc585 100644 --- a/src/Stack/Ghci.hs +++ b/src/Stack/Ghci.hs @@ -21,18 +21,22 @@ import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T import Data.Typeable +import Network.HTTP.Client.Conduit import Path import Path.IO +import Stack.Build (build) import Stack.Build.Source import Stack.Exec import Stack.Package import Stack.Types +import Stack.Build.Types +import Stack.Types.Internal -- | Launch a GHCi session for the given local project targets with the -- given options and configure it with the load paths and extensions -- of those targets. ghci - :: (HasConfig r, HasBuildConfig r, HasEnvConfig r, MonadReader r m, MonadIO m, MonadThrow m, MonadLogger m, MonadCatch m, MonadBaseControl IO m) + :: (HasConfig r, HasBuildConfig r, HasEnvConfig r, MonadReader r m, MonadIO m, MonadThrow m, MonadLogger m, MonadCatch m, MonadBaseControl IO m, HasTerminal r, HasHttpManager r, MonadMask m , HasLogLevel r) => [Text] -- ^ Targets. -> [String] -- ^ GHC options. -> FilePath @@ -59,8 +63,7 @@ data GhciPkgInfo = GhciPkgInfo , ghciPkgModules :: [Path Abs File] } -ghciSetup :: (HasConfig r, HasBuildConfig r, HasEnvConfig r, MonadReader r m, MonadIO m, MonadThrow m, MonadLogger m, MonadCatch m) - => [Text] -> m [GhciPkgInfo] +ghciSetup :: (HasConfig r, HasBuildConfig r, HasEnvConfig r, MonadReader r m, MonadIO m, MonadThrow m, MonadLogger m, MonadCatch m, MonadBaseControl IO m, HasTerminal r, HasHttpManager r, MonadMask m, HasLogLevel r) => [Text] -> m [GhciPkgInfo] ghciSetup targets = do econfig <- asks getEnvConfig bconfig <- asks getBuildConfig @@ -77,7 +80,8 @@ ghciSetup targets = do let findTarget x = find ((x ==) . packageNameText . fst) locals unmetTargets = filter (isNothing . findTarget) targets when (not (null unmetTargets)) $ throwM (TargetsNotFound unmetTargets) - forM locals $ + infos <- + forM locals $ \(name,cabalfp) -> do let config = PackageConfig @@ -99,6 +103,19 @@ ghciSetup targets = do , ghciPkgDir = parent cabalfp , ghciPkgModules = S.toList srcfiles } + let lock = Nothing -- I'm not sure this lock business is a good + -- idea, it complicates things. + -- We build the necessary targets, including any dependencies, + -- with tests and benchmarks enabled, before launching GHCi. + build + (const (return ())) + lock + (defaultBuildOpts + { boptsTargets = targets + , boptsEnableTests = True + , boptsEnableBenchmarks = True + } :: BuildOpts) + return infos where wanted pwd cabalfp name = isInWantedList || targetsEmptyAndInDir where diff --git a/src/Stack/Ide.hs b/src/Stack/Ide.hs index 48a182ca71..8f34b71d88 100644 --- a/src/Stack/Ide.hs +++ b/src/Stack/Ide.hs @@ -2,6 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} -- | Run a IDE configured with the user's project(s). @@ -13,6 +14,7 @@ import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.Logger import Control.Monad.Reader +import Control.Monad.Trans.Control (MonadBaseControl) import Data.Aeson import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 @@ -23,13 +25,15 @@ import Data.Maybe import Data.Monoid import Data.Text (Text) import qualified Data.Text as T +import Network.HTTP.Client.Conduit import Path import Path.IO import Stack.Constants import Stack.Exec (defaultEnvSettings) -import Stack.Package import Stack.Ghci (GhciPkgInfo(..), ghciSetup) +import Stack.Package import Stack.Types +import Stack.Types.Internal import System.Directory (doesFileExist) import System.Environment (lookupEnv) import System.Exit @@ -41,7 +45,7 @@ import System.Process.Read -- given options and configure it with the load paths and extensions -- of those targets. ide - :: (HasConfig r, HasBuildConfig r, HasEnvConfig r, MonadReader r m, MonadIO m, MonadThrow m, MonadLogger m, MonadCatch m) + :: (HasConfig r, HasBuildConfig r, HasEnvConfig r, MonadReader r m, MonadIO m, MonadThrow m, MonadLogger m, MonadCatch m, MonadBaseControl IO m, HasTerminal r, HasHttpManager r, MonadMask m, HasLogLevel r) => [Text] -- ^ Targets. -> [String] -- ^ GHC options. -> m ()