From da1c53e5baba5be8c491955e86471d18b2d72e75 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Tue, 16 Aug 2016 17:02:02 +0530 Subject: [PATCH 1/2] Move package install before preparing ghc command So that we can use the installed package-ids to prepare the ghc command (to be done in the next commit). This commit does not change behavior. --- src/main/Main.hs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/main/Main.hs b/src/main/Main.hs index b741777535..a28155f635 100644 --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -740,7 +740,14 @@ execCmd ExecOpts {..} go@GlobalOpts{..} = Nothing -- Unlocked already above. ExecOptsEmbellished {..} -> withBuildConfigAndLock go $ \lk -> do + let targets = concatMap words eoPackages + unless (null targets) $ + Stack.Build.build (const $ return ()) lk defaultBuildOptsCLI + { boptsCLITargets = map T.pack targets + } + config <- asks getConfig + menv <- liftIO $ configEnvOverride config eoEnvSettings (cmd, args) <- case (eoCmd, eoArgs) of (ExecCmd cmd, args) -> return (cmd, args) (ExecGhc, args) -> execCompiler "" args @@ -749,13 +756,7 @@ execCmd ExecOpts {..} go@GlobalOpts{..} = (ExecRunGhc, args) -> let opts = concatMap (\x -> ["-package", x]) eoPackages in execCompiler "" (opts ++ ("-e" : "Main.main" : args)) - let targets = concatMap words eoPackages - unless (null targets) $ - Stack.Build.build (const $ return ()) lk defaultBuildOptsCLI - { boptsCLITargets = map T.pack targets - } munlockFile lk -- Unlock before transferring control away. - menv <- liftIO $ configEnvOverride config eoEnvSettings exec menv cmd args where execCompiler cmdPrefix args = do From 1aecd68a29733f298596cbb3bbd1838f6fe088e2 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Tue, 16 Aug 2016 17:07:34 +0530 Subject: [PATCH 2/2] When possible, use package-id arg to ghc/runghc Current mechanism of using GHC_PACKAGE_PATH for runghc and ghc commands does not seem to work well when we have multiple versions of the same package. GHC does not always pick up the packages in the same order as GHC_PACKAGE_PATH. This fix determines the package-ids using ghc-pkg and then passes package-ids on command line of ghc or runghc invocation. This works only when the user explicitly passes --package to runghc or ghc commands. When --package is not specified we have no easy way to determine what all packages will be used by the file being compiled. This will make sure that scripts which explicitly list all packages will always run reliably even in presence of packages which have multiple instances of the same version or multiple versions installed. fixes #1957 (Requires all packages to be listed explicitly) --- src/Stack/GhcPkg.hs | 1 + src/main/Main.hs | 27 ++++++++++++++++++++------- 2 files changed, 21 insertions(+), 7 deletions(-) diff --git a/src/Stack/GhcPkg.hs b/src/Stack/GhcPkg.hs index f99250699b..4bf201cd4f 100644 --- a/src/Stack/GhcPkg.hs +++ b/src/Stack/GhcPkg.hs @@ -13,6 +13,7 @@ module Stack.GhcPkg (getGlobalDB ,EnvOverride ,envHelper + ,findGhcPkgField ,createDatabase ,unregisterGhcPkgId ,getCabalPkgVer diff --git a/src/main/Main.hs b/src/main/Main.hs index a28155f635..558f089572 100644 --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -1,6 +1,7 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} @@ -61,6 +62,7 @@ import Stack.Coverage import qualified Stack.Docker as Docker import Stack.Dot import Stack.Exec +import Stack.GhcPkg (findGhcPkgField) import qualified Stack.Nix as Nix import Stack.Fetch import Stack.FileWatch @@ -750,19 +752,30 @@ execCmd ExecOpts {..} go@GlobalOpts{..} = menv <- liftIO $ configEnvOverride config eoEnvSettings (cmd, args) <- case (eoCmd, eoArgs) of (ExecCmd cmd, args) -> return (cmd, args) - (ExecGhc, args) -> execCompiler "" args + (ExecGhc, args) -> getGhcCmd menv eoPackages [] args -- NOTE: this won't currently work for GHCJS, because it doesn't have -- a runghcjs binary. It probably will someday, though. (ExecRunGhc, args) -> - let opts = concatMap (\x -> ["-package", x]) eoPackages - in execCompiler "" (opts ++ ("-e" : "Main.main" : args)) + getGhcCmd menv eoPackages ["-e", "Main.main"] args munlockFile lk -- Unlock before transferring control away. exec menv cmd args where - execCompiler cmdPrefix args = do - wc <- getWhichCompiler - let cmd = cmdPrefix ++ compilerExeName wc - return (cmd, args) + -- return the package-id of the first package in GHC_PACKAGE_PATH + getPkgId menv wc name = do + mId <- findGhcPkgField menv wc [] name "id" + case mId of + Just i -> return (head $ words (T.unpack i)) + -- should never happen as we have already installed the packages + _ -> error ("Could not find package id of package " ++ name) + + getPkgOpts menv wc pkgs = do + ids <- mapM (getPkgId menv wc) pkgs + return $ concatMap (\x -> ["-package-id", x]) ids + + getGhcCmd menv pkgs prefix args = do + wc <- getWhichCompiler + pkgopts <- getPkgOpts menv wc pkgs + return (compilerExeName wc, prefix ++ pkgopts ++ args) -- | Evaluate some haskell code inline. evalCmd :: EvalOpts -> GlobalOpts -> IO ()