From 21705e1b015867f568f822f391a39996b7331f51 Mon Sep 17 00:00:00 2001 From: Mathieu Boespflug Date: Mon, 11 Jan 2016 18:28:49 +0100 Subject: [PATCH 1/4] Nix: select the right GHC version in more cases. Stack now selects the correct GHC version in the following cases: * an abstract resolver was given, * a concrete resolver was given, * a compiler version was given. Previously, we could only deal with concrete resolvers correctly. Fixes #1641. --- ChangeLog.md | 4 ++++ src/Stack/Config.hs | 2 +- src/Stack/Config/Nix.hs | 33 +++++++++++++++++---------------- src/Stack/Nix.hs | 22 ++++++++++++++-------- src/Stack/Types/Config.hs-boot | 5 +++++ src/Stack/Types/Nix.hs | 9 +++++++-- src/main/Main.hs | 6 ++++-- 7 files changed, 52 insertions(+), 29 deletions(-) create mode 100644 src/Stack/Types/Config.hs-boot diff --git a/ChangeLog.md b/ChangeLog.md index d03061acd1..0bc9408a4d 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -23,6 +23,10 @@ Bug fixes: [Mailing list discussion](https://groups.google.com/d/msg/haskell-stack/iVGDG5OHYxs/FjUrR5JsDQAJ) - Gracefully handle invalid paths in error/warning messages [#1561](https://github.com/commercialhaskell/stack/issues/1561) +- Nix: select the correct GHC version corresponding to the snapshot + even when an abstract resolver is passed via `--resolver` on the + command-line. + [#1641](https://github.com/commercialhaskell/stack/issues/1641) ## 1.0.0 diff --git a/src/Stack/Config.hs b/src/Stack/Config.hs index 151da4d682..3ef8e8d3ab 100644 --- a/src/Stack/Config.hs +++ b/src/Stack/Config.hs @@ -234,7 +234,7 @@ configFromConfigMonoid configStackRoot configUserConfigPath mresolver mproject c configDocker <- dockerOptsFromMonoid (fmap fst mproject) configStackRoot mresolver configMonoidDockerOpts - configNix <- nixOptsFromMonoid (fmap fst mproject) mresolver configMonoidNixOpts os + configNix <- nixOptsFromMonoid (fmap fst mproject) configMonoidNixOpts os rawEnv <- liftIO getEnvironment pathsEnv <- augmentPathMap (map toFilePath configMonoidExtraPath) diff --git a/src/Stack/Config/Nix.hs b/src/Stack/Config/Nix.hs index ebea98dcce..92098c3450 100644 --- a/src/Stack/Config/Nix.hs +++ b/src/Stack/Config/Nix.hs @@ -6,7 +6,8 @@ module Stack.Config.Nix ,StackNixException(..) ) where -import Control.Monad (when) +import Control.Applicative +import Control.Monad (join, when) import qualified Data.Text as T import Data.Maybe import Data.Typeable @@ -14,37 +15,37 @@ import Distribution.System (OS (..)) import Stack.Types import Control.Exception.Lifted import Control.Monad.Catch (throwM,MonadCatch) - +import Prelude -- | Interprets NixOptsMonoid options. nixOptsFromMonoid :: (Monad m, MonadCatch m) => Maybe Project - -> Maybe AbstractResolver -> NixOptsMonoid -> OS -> m NixOpts -nixOptsFromMonoid mproject maresolver NixOptsMonoid{..} os = do +nixOptsFromMonoid mproject NixOptsMonoid{..} os = do let nixEnable = fromMaybe nixMonoidDefaultEnable nixMonoidEnable defaultPure = case os of OSX -> False _ -> True nixPureShell = fromMaybe defaultPure nixMonoidPureShell - mresolver = case maresolver of - Just (ARResolver resolver) -> Just resolver - Just _ -> Nothing - Nothing -> fmap projectResolver mproject - pkgs = fromMaybe [] nixMonoidPackages - nixPackages = case mproject of - Nothing -> pkgs - Just _ -> pkgs ++ [case mresolver of - Just (ResolverSnapshot (LTS x y)) -> - T.pack ("haskell.packages.lts-" ++ show x ++ "_" ++ show y ++ ".ghc") - _ -> T.pack "ghc"] + nixPackages = fromMaybe [] nixMonoidPackages nixInitFile = nixMonoidInitFile nixShellOptions = fromMaybe [] nixMonoidShellOptions ++ prefixAll (T.pack "-I") (fromMaybe [] nixMonoidPath) - when (not (null pkgs) && isJust nixInitFile) $ + nixCompiler resolverOverride compilerOverride = + let mresolver = resolverOverride <|> fmap projectResolver mproject + mcompiler = compilerOverride <|> join (fmap projectCompiler mproject) + in case (mresolver, mcompiler) of + (_, Just (GhcVersion v)) -> + T.filter (== '.') (versionText v) + (Just (ResolverCompiler (GhcVersion v)), _) -> + T.filter (== '.') (versionText v) + (Just (ResolverSnapshot (LTS x y)), _) -> + T.pack ("haskell.packages.lts-" ++ show x ++ "_" ++ show y ++ ".ghc") + _ -> T.pack "ghc" + when (not (null nixPackages) && isJust nixInitFile) $ throwM NixCannotUseShellFileAndPackagesException return NixOpts{..} where prefixAll p (x:xs) = p : x : prefixAll p xs diff --git a/src/Stack/Nix.hs b/src/Stack/Nix.hs index 2cfb185a38..6af1d6ea52 100644 --- a/src/Stack/Nix.hs +++ b/src/Stack/Nix.hs @@ -33,8 +33,9 @@ import Network.HTTP.Client.Conduit (HasHttpManager) import Path import Path.IO import qualified Paths_stack as Meta -import Prelude -- Fix redundant import warnings +import Prelude hiding (mapM) -- Fix redundant import warnings import Stack.Constants (stackProgName,platformVariantEnvVar) +import Stack.Config (makeConcreteResolver) import Stack.Docker (reExecArgName) import Stack.Exec (exec) import System.Process.Read (getEnvOverride) @@ -43,20 +44,21 @@ import Stack.Types.Internal import System.Environment (lookupEnv,getArgs,getExecutablePath) import System.Exit (exitSuccess, exitWith) - -- | If Nix is enabled, re-runs the currently running OS command in a Nix container. -- Otherwise, runs the inner action. reexecWithOptionalShell :: M env m => Maybe (Path Abs Dir) + -> Maybe AbstractResolver + -> Maybe CompilerVersion -> IO () -> m () -reexecWithOptionalShell mprojectRoot inner = +reexecWithOptionalShell mprojectRoot maresolver mcompiler inner = do config <- asks getConfig inShell <- getInShell isReExec <- asks getReExec if nixEnable (configNix config) && not inShell && not isReExec - then runShellAndExit mprojectRoot getCmdArgs + then runShellAndExit mprojectRoot maresolver mcompiler getCmdArgs else liftIO inner where getCmdArgs = do @@ -70,30 +72,34 @@ reexecWithOptionalShell mprojectRoot inner = runShellAndExit :: M env m => Maybe (Path Abs Dir) + -> Maybe AbstractResolver + -> Maybe CompilerVersion -> m (String, [String]) -> m () -runShellAndExit mprojectRoot getCmdArgs = do +runShellAndExit mprojectRoot maresolver mcompiler getCmdArgs = do config <- asks getConfig + mresolver <- mapM makeConcreteResolver maresolver envOverride <- getEnvOverride (configPlatform config) (cmnd,args) <- fmap (escape *** map escape) getCmdArgs mshellFile <- traverse (resolveFile (fromMaybeProjectRoot mprojectRoot)) $ nixInitFile (configNix config) let pkgsInConfig = nixPackages (configNix config) + pkgs = pkgsInConfig ++ [nixCompiler (configNix config) mresolver mcompiler] pureShell = nixPureShell (configNix config) nixopts = case mshellFile of Just fp -> [toFilePath fp] Nothing -> ["-E", T.unpack $ T.intercalate " " $ concat [["with (import {});" ,"runCommand \"myEnv\" {" - ,"buildInputs=lib.optional stdenv.isLinux glibcLocales ++ ["],pkgsInConfig,["];" + ,"buildInputs=lib.optional stdenv.isLinux glibcLocales ++ ["],pkgs,["];" ,T.pack platformVariantEnvVar <> "=''nix'';" ,T.pack inShellEnvVar <> "=1;" ,"STACK_IN_NIX_EXTRA_ARGS=''"] , (map (\p -> T.concat ["--extra-lib-dirs=${",p,"}/lib" ," --extra-include-dirs=${",p,"}/include "]) - pkgsInConfig), ["'' ;" + pkgs), ["'' ;" ,"} \"\""]]] -- glibcLocales is necessary on Linux to avoid warnings about GHC being incapable to set the locale. fullArgs = concat [if pureShell then ["--pure"] else [], @@ -105,7 +111,7 @@ runShellAndExit mprojectRoot getCmdArgs = do $logDebug $ "Using a nix-shell environment " <> (case mshellFile of Just path -> "from file: " <> (T.pack (toFilePath path)) - Nothing -> "with nix packages: " <> (T.intercalate ", " pkgsInConfig)) + Nothing -> "with nix packages: " <> (T.intercalate ", " pkgs)) e <- try (exec envOverride "nix-shell" fullArgs) case e of Left (ProcessExitedUnsuccessfully _ ec) -> liftIO (exitWith ec) diff --git a/src/Stack/Types/Config.hs-boot b/src/Stack/Types/Config.hs-boot new file mode 100644 index 0000000000..84c459fa22 --- /dev/null +++ b/src/Stack/Types/Config.hs-boot @@ -0,0 +1,5 @@ +module Stack.Types.Config where + +data AbstractResolver +data Resolver +data Config diff --git a/src/Stack/Types/Nix.hs b/src/Stack/Types/Nix.hs index d53a7d0b55..3ebf3c420c 100644 --- a/src/Stack/Types/Nix.hs +++ b/src/Stack/Types/Nix.hs @@ -10,10 +10,13 @@ import Control.Applicative import Data.Aeson.Extended import Data.Text (Text) import Data.Monoid - import Prelude +import Stack.Types.Compiler (CompilerVersion) +import {-# SOURCE #-} Stack.Types.Config (Resolver) +import Text.Show.Functions () --- | Nix configuration. +-- | Nix configuration. Parameterize by resolver type to avoid cyclic +-- dependency. data NixOpts = NixOpts {nixEnable :: !Bool ,nixPureShell :: !Bool @@ -23,6 +26,8 @@ data NixOpts = NixOpts -- ^ The path of a file containing preconfiguration of the environment (e.g shell.nix) ,nixShellOptions :: ![Text] -- ^ Options to be given to the nix-shell command line + ,nixCompiler :: !(Maybe Resolver -> Maybe CompilerVersion -> Text) + -- ^ Yield a compiler attribute name given a resolver override. } deriving (Show) diff --git a/src/main/Main.hs b/src/main/Main.hs index 4a440a33be..d00a57e1e6 100644 --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -698,7 +698,7 @@ setupCmd SetupCmdOpts{..} go@GlobalOpts{..} = do (lcProjectRoot lc) Nothing (runStackTGlobal manager (lcConfig lc) go $ - Nix.reexecWithOptionalShell (lcProjectRoot lc) $ + Nix.reexecWithOptionalShell (lcProjectRoot lc) globalResolver globalCompiler $ runStackLoggingTGlobal manager go $ do (wantedCompiler, compilerCheck, mstack) <- case scoCompilerVersion of @@ -864,7 +864,7 @@ withBuildConfigExt go@GlobalOpts{..} mbefore inner mafter = do (lcProjectRoot lc) mbefore (runStackTGlobal manager (lcConfig lc) go $ - Nix.reexecWithOptionalShell (lcProjectRoot lc) (inner'' lk0)) + Nix.reexecWithOptionalShell (lcProjectRoot lc) globalResolver globalCompiler (inner'' lk0)) mafter (Just $ liftIO $ do lk' <- readIORef curLk @@ -1007,6 +1007,8 @@ execCmd ExecOpts {..} go@GlobalOpts{..} = menv <- liftIO $ configEnvOverride config plainEnvSettings Nix.reexecWithOptionalShell (lcProjectRoot lc) + globalResolver + globalCompiler (runStackTGlobal manager (lcConfig lc) go $ exec menv cmd args)) Nothing From c768c598bf303e0397a54cc46a0d78551fd49789 Mon Sep 17 00:00:00 2001 From: Mathieu Boespflug Date: Tue, 12 Jan 2016 16:38:28 +0100 Subject: [PATCH 2/4] Ambiguous ident occurrence in GHC 7.8. --- src/Stack/Nix.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Stack/Nix.hs b/src/Stack/Nix.hs index 6af1d6ea52..61e303aad5 100644 --- a/src/Stack/Nix.hs +++ b/src/Stack/Nix.hs @@ -14,7 +14,7 @@ module Stack.Nix import Control.Applicative import Control.Arrow ((***)) import Control.Exception (Exception,throw) -import Control.Monad +import Control.Monad hiding (mapM) import Control.Monad.Catch (try,MonadCatch) import Control.Monad.IO.Class (MonadIO,liftIO) import Control.Monad.Logger (MonadLogger,logDebug) From 4d4e8f4ebce8c1e5517f0ccf307053587afc14fe Mon Sep 17 00:00:00 2001 From: Mathieu Boespflug Date: Tue, 12 Jan 2016 18:39:14 +0100 Subject: [PATCH 3/4] Nix: Adjust test case. --- src/test/Stack/NixSpec.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/test/Stack/NixSpec.hs b/src/test/Stack/NixSpec.hs index 354d6aaae2..5960609e2f 100644 --- a/src/test/Stack/NixSpec.hs +++ b/src/test/Stack/NixSpec.hs @@ -63,5 +63,5 @@ spec = beforeAll setup $ afterAll teardown $ do it "sees that the only package asked for is glpk and adds GHC from nixpkgs mirror of LTS resolver" $ \T{..} -> inTempDir $ do writeFile (toFilePath stackDotYaml) sampleConfig lc <- loadConfig' manager - (nixPackages $ configNix $ lcConfig lc) `shouldBe` ["glpk", "haskell.packages.lts-2_10.ghc"] - + (nixPackages $ configNix $ lcConfig lc) `shouldBe` ["glpk"] + (nixCompiler $ configNix $ lcConfig lc) Nothing Nothing `shouldBe` "haskell.packages.lts-2_10.ghc" From 58e6d548a0bff28adede5fe2036171095b689f1a Mon Sep 17 00:00:00 2001 From: Mathieu Boespflug Date: Tue, 12 Jan 2016 19:03:50 +0100 Subject: [PATCH 4/4] Nix: Fix --compiler nixpkgs attribute mapping. --- src/Stack/Config/Nix.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/Stack/Config/Nix.hs b/src/Stack/Config/Nix.hs index 92098c3450..e404419e19 100644 --- a/src/Stack/Config/Nix.hs +++ b/src/Stack/Config/Nix.hs @@ -38,10 +38,8 @@ nixOptsFromMonoid mproject NixOptsMonoid{..} os = do let mresolver = resolverOverride <|> fmap projectResolver mproject mcompiler = compilerOverride <|> join (fmap projectCompiler mproject) in case (mresolver, mcompiler) of - (_, Just (GhcVersion v)) -> - T.filter (== '.') (versionText v) - (Just (ResolverCompiler (GhcVersion v)), _) -> - T.filter (== '.') (versionText v) + (_, Just (GhcVersion v)) -> nixCompilerFromVersion v + (Just (ResolverCompiler (GhcVersion v)), _) -> nixCompilerFromVersion v (Just (ResolverSnapshot (LTS x y)), _) -> T.pack ("haskell.packages.lts-" ++ show x ++ "_" ++ show y ++ ".ghc") _ -> T.pack "ghc" @@ -50,6 +48,7 @@ nixOptsFromMonoid mproject NixOptsMonoid{..} os = do return NixOpts{..} where prefixAll p (x:xs) = p : x : prefixAll p xs prefixAll _ _ = [] + nixCompilerFromVersion v = T.filter (/= '.') $ T.append (T.pack "haskell.compiler.ghc") (versionText v) -- Exceptions thown specifically by Stack.Nix data StackNixException