Merge pull request #1646 from commercialhaskell/nix-abstract-resolver

Nix: select the right GHC version in more cases.

Author: borsboom

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
 

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)

src/Stack/Config/Nix.hs

@@ -6,49 +6,49 @@ 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
 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)) -> 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"
+    when (not (null nixPackages) && isJust nixInitFile) $
        throwM NixCannotUseShellFileAndPackagesException
     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

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)
@@ -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 <nixpkgs> {});"
                                ,"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)

src/Stack/Types/Config.hs-boot

@@ -0,0 +1,5 @@
+module Stack.Types.Config where
+
+data AbstractResolver
+data Resolver
+data Config

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)
 

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

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"