From b448b3490f84d89951e7b584a88856cef07ced56 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Wed, 3 Feb 2016 20:32:04 -0500 Subject: [PATCH 1/4] Add command 'stack ghcCmd' This is like the 'stack ghc' command, but adds package arguments similar to the ones 'stack ghci' would add. --- src/Stack/Ghci.hs | 9 +++++++++ src/main/Main.hs | 15 +++++++++++++++ 2 files changed, 24 insertions(+) diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs index 88d595ea82..aa07c46e58 100644 --- a/src/Stack/Ghci.hs +++ b/src/Stack/Ghci.hs @@ -13,6 +13,7 @@ module Stack.Ghci , GhciPkgInfo(..) , GhciException(..) , ghciSetup + , ghciSetup' , ghci ) where @@ -101,6 +102,14 @@ instance Show GhciException where , "Use --no-load to try to start it anyway, without loading any modules (but these are still likely to cause errors)" ] +ghciSetup' :: (MonadIO f, HasHttpManager r, MonadReader r f, MonadBaseControl IO f, MonadMask f, MonadLogger f, HasEnvConfig r, HasTerminal r, HasLogLevel r) => GhciOpts -> f [String] +ghciSetup' opts = genOpts . extract <$> ghciSetup opts + where + extract (_, _, x) = x + genOpts :: [GhciPkgInfo] -> [String] + genOpts pkgs = nubOrd (concatMap (concatMap (oneWordOpts . snd) . ghciPkgOpts) pkgs) + oneWordOpts bio = bioOneWordOpts bio ++ bioPackageFlags bio + -- | Launch a GHCi session for the given local package targets with the -- given options and configure it with the load paths and extensions -- of those targets. diff --git a/src/main/Main.hs b/src/main/Main.hs index 27e745b531..f634e2d369 100644 --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -304,6 +304,10 @@ commandLineHandler progName isInterpreter = complicatedOptions "Run ghc" execCmd (execOptsParser $ Just ExecGhc) + addCommand' "ghcCmd" + "Run ghc with package context" + ghcCmd + (execOptsParser $ Just ExecGhc) addCommand' "ghci" "Run ghci in the context of package(s) (experimental)" ghciCmd @@ -1049,6 +1053,17 @@ ghciCmd ghciOpts go@GlobalOpts{..} = munlockFile lk -- Don't hold the lock while in the GHCI. ghci ghciOpts +-- | Run GHC in the context of a project. +ghcCmd :: ExecOpts -> GlobalOpts -> IO () +ghcCmd execOpts go@GlobalOpts { .. } = + withBuildConfig go $ do + pkgOpts <- ghciSetup' ghciOpts + let e = execOpts { eoArgs = ("-i" : "-hide-all-packages" : pkgOpts) ++ eoArgs execOpts } + liftIO $ execCmd e go + where + ghciOpts :: GhciOpts + ghciOpts = GhciOpts False [] Nothing False [] Nothing False False False defaultBuildOpts + -- | Run ide-backend in the context of a project. ideCmd :: ([Text], [String]) -> GlobalOpts -> IO () ideCmd (targets,args) go@GlobalOpts{..} = From 58a8b66f28d2b018e7c45ece0c276f37b4f1c810 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Wed, 3 Feb 2016 22:48:58 -0500 Subject: [PATCH 2/4] Change 'stack ghc' to provide package context Also, --add-ghci-packages is now available to do the same thing for 'stack exec'. --- src/Stack/Options.hs | 4 ++++ src/Stack/Types/Config.hs | 1 + src/main/Main.hs | 10 +++++++++- 3 files changed, 14 insertions(+), 1 deletion(-) diff --git a/src/Stack/Options.hs b/src/Stack/Options.hs index dcf94cedef..9c1cbc0af6 100644 --- a/src/Stack/Options.hs +++ b/src/Stack/Options.hs @@ -621,6 +621,10 @@ execOptsExtraParser = eoPlainParser <|> ExecOptsEmbellished <$> eoEnvSettingsParser <*> eoPackagesParser + <*> boolFlags False + "add-ghci-packages" + "prefix the executed command line with the same -package (etc.) args that would be used for GHCI" + idm where eoEnvSettingsParser :: Parser EnvSettings eoEnvSettingsParser = EnvSettings diff --git a/src/Stack/Types/Config.hs b/src/Stack/Types/Config.hs index d9b70125ef..b07670ab84 100644 --- a/src/Stack/Types/Config.hs +++ b/src/Stack/Types/Config.hs @@ -383,6 +383,7 @@ data ExecOptsExtra | ExecOptsEmbellished { eoEnvSettings :: !EnvSettings , eoPackages :: ![String] + , eoGhciPackages :: !Bool } deriving (Show) diff --git a/src/main/Main.hs b/src/main/Main.hs index f634e2d369..387e5fada3 100644 --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -1029,12 +1029,20 @@ execCmd ExecOpts {..} go@GlobalOpts{..} = } munlockFile lk -- Unlock before transferring control away. menv <- liftIO $ configEnvOverride config eoEnvSettings - exec menv cmd args + + if eoCmd == ExecGhc || eoGhciPackages + then do + pkgOpts <- ghciSetup' ghciOpts + exec menv cmd $ ("-i" : "-hide-all-packages" : pkgOpts) ++ args + else + exec menv cmd args where execCompiler cmdPrefix args = do wc <- getWhichCompiler let cmd = cmdPrefix ++ compilerExeName wc return (cmd, args) + ghciOpts :: GhciOpts + ghciOpts = GhciOpts True [] Nothing False [] Nothing False False False defaultBuildOpts -- | Evaluate some haskell code inline. evalCmd :: EvalOpts -> GlobalOpts -> IO () From 64a610bc10580b686815e4d6ba9d07414b6ea674 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Wed, 3 Feb 2016 22:54:15 -0500 Subject: [PATCH 3/4] remove now-redundant 'stack ghcCmd' command --- src/main/Main.hs | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/src/main/Main.hs b/src/main/Main.hs index 387e5fada3..9d52c8475f 100644 --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -304,10 +304,6 @@ commandLineHandler progName isInterpreter = complicatedOptions "Run ghc" execCmd (execOptsParser $ Just ExecGhc) - addCommand' "ghcCmd" - "Run ghc with package context" - ghcCmd - (execOptsParser $ Just ExecGhc) addCommand' "ghci" "Run ghci in the context of package(s) (experimental)" ghciCmd @@ -1061,17 +1057,6 @@ ghciCmd ghciOpts go@GlobalOpts{..} = munlockFile lk -- Don't hold the lock while in the GHCI. ghci ghciOpts --- | Run GHC in the context of a project. -ghcCmd :: ExecOpts -> GlobalOpts -> IO () -ghcCmd execOpts go@GlobalOpts { .. } = - withBuildConfig go $ do - pkgOpts <- ghciSetup' ghciOpts - let e = execOpts { eoArgs = ("-i" : "-hide-all-packages" : pkgOpts) ++ eoArgs execOpts } - liftIO $ execCmd e go - where - ghciOpts :: GhciOpts - ghciOpts = GhciOpts False [] Nothing False [] Nothing False False False defaultBuildOpts - -- | Run ide-backend in the context of a project. ideCmd :: ([Text], [String]) -> GlobalOpts -> IO () ideCmd (targets,args) go@GlobalOpts{..} = From 93220b60b031bf3a3adf477537bac4b9c3bdac42 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Wed, 3 Feb 2016 23:56:51 -0500 Subject: [PATCH 4/4] don't touch module Stack.Ghci unnecessarily --- src/Stack/Ghci.hs | 9 --------- src/main/Main.hs | 8 +++++++- stack.cabal | 1 + 3 files changed, 8 insertions(+), 10 deletions(-) diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs index aa07c46e58..88d595ea82 100644 --- a/src/Stack/Ghci.hs +++ b/src/Stack/Ghci.hs @@ -13,7 +13,6 @@ module Stack.Ghci , GhciPkgInfo(..) , GhciException(..) , ghciSetup - , ghciSetup' , ghci ) where @@ -102,14 +101,6 @@ instance Show GhciException where , "Use --no-load to try to start it anyway, without loading any modules (but these are still likely to cause errors)" ] -ghciSetup' :: (MonadIO f, HasHttpManager r, MonadReader r f, MonadBaseControl IO f, MonadMask f, MonadLogger f, HasEnvConfig r, HasTerminal r, HasLogLevel r) => GhciOpts -> f [String] -ghciSetup' opts = genOpts . extract <$> ghciSetup opts - where - extract (_, _, x) = x - genOpts :: [GhciPkgInfo] -> [String] - genOpts pkgs = nubOrd (concatMap (concatMap (oneWordOpts . snd) . ghciPkgOpts) pkgs) - oneWordOpts bio = bioOneWordOpts bio ++ bioPackageFlags bio - -- | Launch a GHCi session for the given local package targets with the -- given options and configure it with the load paths and extensions -- of those targets. diff --git a/src/main/Main.hs b/src/main/Main.hs index 9d52c8475f..81a8f53285 100644 --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -23,6 +23,7 @@ import Data.Attoparsec.Interpreter (getInterpreterArgs) import qualified Data.ByteString.Lazy as L import Data.IORef import Data.List +import Data.List.Extra (nubOrd) import qualified Data.Map as Map import qualified Data.Map.Strict as M import Data.Maybe @@ -1028,7 +1029,7 @@ execCmd ExecOpts {..} go@GlobalOpts{..} = if eoCmd == ExecGhc || eoGhciPackages then do - pkgOpts <- ghciSetup' ghciOpts + pkgOpts <- genOpts . extract <$> ghciSetup ghciOpts exec menv cmd $ ("-i" : "-hide-all-packages" : pkgOpts) ++ args else exec menv cmd args @@ -1039,6 +1040,11 @@ execCmd ExecOpts {..} go@GlobalOpts{..} = return (cmd, args) ghciOpts :: GhciOpts ghciOpts = GhciOpts True [] Nothing False [] Nothing False False False defaultBuildOpts + extract (_, _, x) = x + genOpts :: [GhciPkgInfo] -> [String] + genOpts pkgs = nubOrd (concatMap (concatMap (oneWordOpts . snd) . ghciPkgOpts) pkgs) + oneWordOpts bio = bioOneWordOpts bio ++ bioPackageFlags bio + -- | Evaluate some haskell code inline. evalCmd :: EvalOpts -> GlobalOpts -> IO () diff --git a/stack.cabal b/stack.cabal index af18a91f3d..aae3418161 100644 --- a/stack.cabal +++ b/stack.cabal @@ -257,6 +257,7 @@ executable stack , conduit , transformers , http-client + , extra default-language: Haskell2010 if os(windows) build-depends: Win32