diff --git a/src/Stack2nix.hs b/src/Stack2nix.hs index 606768e..ac74f24 100644 --- a/src/Stack2nix.hs +++ b/src/Stack2nix.hs @@ -29,10 +29,8 @@ stack2nix args@Args{..} = do ensureExecutableExists "cabal" "cabal-install" ensureExecutableExists "git" "git" ensureExecutableExists "nix-prefetch-git" "nix-prefetch-scripts" - ensureExecutableExists "ghc" "haskell.compiler.ghc802" assertMinVer "git" "2" assertMinVer "cabal" "2" - assertMinVer "ghc" "8.0" updateCabalPackageIndex -- cwd <- getCurrentDirectory -- let projRoot = if isAbsolute argUri then argUri else cwd argUri diff --git a/src/Stack2nix/External/Stack.hs b/src/Stack2nix/External/Stack.hs index 18d9621..5111b6c 100644 --- a/src/Stack2nix/External/Stack.hs +++ b/src/Stack2nix/External/Stack.hs @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE DataKinds #-} module Stack2nix.External.Stack ( PackageRef(..), runPlan @@ -15,11 +16,15 @@ import Stack.Build.Source (loadSourceMapFull) import Stack.Build.Target (NeedTargets (..)) import Stack.Options.BuildParser import Stack.Options.GlobalParser +import Stack.Config +import Path (parseAbsFile) +import Stack.Types.Compiler (CVType(..), CompilerVersion, getGhcVersion) import Stack.Options.Utils (GlobalOptsContext (..)) -import Stack.Prelude hiding (mapConcurrently, logDebug) +import Stack.Prelude hiding (logDebug) import Stack.Types.BuildPlan (Repo (..), PackageLocation (..)) -import Stack.Runners (withBuildConfig) +import Stack.Runners (withBuildConfig, loadCompilerVersion) import Stack.Types.Config +import Stack.Types.Runner import Stack.Types.Config.Build (BuildCommand (..)) import Stack.Types.Nix import Stack.Types.Package (PackageSource (..), lpPackage, @@ -30,16 +35,14 @@ import Stack.Types.PackageIdentifier (PackageIdentifier (..), packageIdentifierString, PackageIdentifierRevision (..)) import Stack2nix.External.Cabal2nix (cabal2nix) -import Stack2nix.External.Util (failHard, runCmd) import Stack2nix.Render (render) import Stack2nix.Types (Args (..)) -import Stack2nix.Util (mapPool, logDebug) +import Stack2nix.Util (mapPool, logDebug, ensureExecutable) import System.Directory (canonicalizePath, createDirectoryIfMissing, getCurrentDirectory, makeRelativeToCurrentDirectory) import System.FilePath (makeRelative, ()) -import System.IO (hPutStrLn, stderr) import qualified Distribution.Nixpkgs.Haskell.Hackage as DB import Distribution.Nixpkgs.Haskell.Derivation (Derivation) import Text.PrettyPrint.HughesPJClass (Doc) @@ -55,7 +58,7 @@ genNixFile args baseDir uri argRev hackageDB pkgRef = do cwd <- getCurrentDirectory case pkgRef of NonHackagePackage _ident PLArchive {} -> error "genNixFile: No support for archive package locations" - HackagePackage (PackageIdentifierRevision pkg _) -> do + HackagePackage (PackageIdentifierRevision pkg _) -> cabal2nix args ("cabal://" <> packageIdentifierString pkg) Nothing Nothing hackageDB NonHackagePackage _ident (PLRepo repo) -> cabal2nix args (unpack $ repoUrl repo) (Just $ repoCommit repo) (Just (repoSubdirs repo)) hackageDB @@ -82,8 +85,9 @@ planAndGenerate :: HasEnvConfig env -> FilePath -> Maybe String -> Args + -> String -> RIO env () -planAndGenerate boptsCli baseDir remoteUri args@Args{..} = do +planAndGenerate boptsCli baseDir remoteUri args@Args{..} ghcnixversion = do (_targets, _mbp, _locals, _extraToBuild, sourceMap) <- loadSourceMapFull NeedTargets boptsCli let pkgs = sourceMapToPackages sourceMap liftIO $ logDebug args $ "plan:\n" ++ show pkgs @@ -91,7 +95,7 @@ planAndGenerate boptsCli baseDir remoteUri args@Args{..} = do hackageDB <- liftIO $ loadHackageDB Nothing argHackageSnapshot drvs <- liftIO $ mapPool argThreads (genNixFile args baseDir remoteUri argRev hackageDB) pkgs let locals = map (\l -> show (packageName (lpPackage l))) _locals - liftIO $ render drvs args locals + liftIO $ render drvs args locals ghcnixversion runPlan :: FilePath -> Maybe String @@ -101,7 +105,22 @@ runPlan baseDir remoteUri args@Args{..} = do let stackRoot = "/tmp/s2n" createDirectoryIfMissing True stackRoot let globals = globalOpts baseDir stackRoot args - withBuildConfig globals $ planAndGenerate buildOpts baseDir remoteUri args + let stackFile = baseDir "stack.yaml" + + ghcVersion <- getGhcVersionIO globals stackFile + let ghcnixversion = filter (/= '.') $ show (getGhcVersion ghcVersion) + ensureExecutable ("haskell.compiler.ghc" ++ ghcnixversion) + withBuildConfig globals $ planAndGenerate buildOpts baseDir remoteUri args ghcnixversion + + +getGhcVersionIO :: GlobalOpts -> FilePath -> IO (CompilerVersion 'CVWanted) +getGhcVersionIO go stackFile = do + cp <- canonicalizePath stackFile + fp <- parseAbsFile cp + lc <- withRunner LevelError True False ColorAuto Nothing False $ \runner -> + -- https://www.fpcomplete.com/blog/2017/07/the-rio-monad + runRIO runner $ loadConfig mempty Nothing (SYLOverride fp) + loadCompilerVersion go lc {- TODO: diff --git a/src/Stack2nix/Render.hs b/src/Stack2nix/Render.hs index 8df860a..c2f3197 100644 --- a/src/Stack2nix/Render.hs +++ b/src/Stack2nix/Render.hs @@ -57,8 +57,8 @@ basePackages = S.fromList , "xhtml" ] -render :: [Either Doc Derivation] -> Args -> [String]-> IO () -render results args locals = do +render :: [Either Doc Derivation] -> Args -> [String] -> String -> IO () +render results args locals ghcnixversion = do let docs = lefts results when (length docs > 0) $ do hPutStrLn stderr $ show docs @@ -69,7 +69,7 @@ render results args locals = do let missing = sort $ S.toList $ S.difference basePackages $ S.fromList (map drvToName drvs) let renderedMissing = map (\b -> nest 6 (text (b <> " = null;"))) missing - let out = defaultNix $ renderedMissing ++ map (renderOne args locals) drvs + let out = defaultNix ghcnixversion $ renderedMissing ++ map (renderOne args locals) drvs case argOutFile args of Just fname -> writeFile fname out @@ -99,14 +99,14 @@ renderOne args locals drv' = drvToName :: Derivation -> String drvToName drv = unPackageName $ pkgName $ view pkgid drv -defaultNix :: [Doc] -> String -defaultNix drvs = unlines $ +defaultNix :: String -> [Doc] -> String +defaultNix ghcnixversion drvs = unlines $ [ "# Generated using stack2nix " <> display version <> "." , "#" , "# Only works with sufficiently recent nixpkgs, e.g. \"NIX_PATH=nixpkgs=https://github.com/NixOS/nixpkgs/archive/21a8239452adae3a4717772f4e490575586b2755.tar.gz\"." , "" , "{ pkgs ? (import {})" - , ", compiler ? pkgs.haskell.packages.ghc802" + , ", compiler ? pkgs.haskell.packages.ghc" ++ ghcnixversion , "}:" , "" , "with pkgs.haskell.lib;" diff --git a/src/Stack2nix/Util.hs b/src/Stack2nix/Util.hs index 66b2d0d..a74613f 100644 --- a/src/Stack2nix/Util.hs +++ b/src/Stack2nix/Util.hs @@ -4,6 +4,7 @@ module Stack2nix.Util , mapPool , logDebug , ensureExecutableExists + , ensureExecutable ) where import Control.Concurrent.Async @@ -58,16 +59,21 @@ logDebug args msg | otherwise = return () +-- check if executable is present, if not provision it with nix ensureExecutableExists :: String -> String -> IO () ensureExecutableExists executable nixAttr = do exec <- findExecutable executable case exec of Just _ -> return () - Nothing -> do - (exitcode2, stdout, err2) <- readProcessWithExitCode "nix-build" ["-A", nixAttr, ""] mempty - case exitcode2 of - ExitSuccess -> do - hPutStrLn stderr $ err2 - path <- getEnv "PATH" - setEnv "PATH" (path ++ ":" ++ unpack (strip (pack stdout)) ++ "/bin") - ExitFailure _ -> error $ nixAttr ++ " failed to build via nix" + Nothing -> ensureExecutable nixAttr + +-- given nixAttr, build it and add $out/bin to $PATH +ensureExecutable :: String -> IO () +ensureExecutable nixAttr = do + (exitcode2, stdout, err2) <- readProcessWithExitCode "nix-build" ["-A", nixAttr, "", "--no-build-output", "--no-out-link"] mempty + case exitcode2 of + ExitSuccess -> do + hPutStrLn stderr $ err2 + path <- getEnv "PATH" + setEnv "PATH" (unpack (strip (pack stdout)) ++ "/bin" ++ ":" ++ path) + ExitFailure _ -> error $ nixAttr ++ " failed to build via nix" diff --git a/stack2nix.cabal b/stack2nix.cabal index 452af13..27367bf 100644 --- a/stack2nix.cabal +++ b/stack2nix.cabal @@ -28,6 +28,7 @@ library , microlens , optparse-applicative >= 0.13.2 && < 0.14 , pretty + , path , language-nix , process >= 1.4.3 && < 1.5 , regex-pcre >= 0.94.4 && < 0.95 diff --git a/stack2nix.nix b/stack2nix.nix index 12ff2f2..5006a57 100644 --- a/stack2nix.nix +++ b/stack2nix.nix @@ -34614,8 +34614,8 @@ inherit (pkgs) which;}; "stack2nix" = callPackage ({ mkDerivation, async, base, Cabal, cabal2nix, containers , directory, distribution-nixpkgs, filepath, language-nix - , microlens, optparse-applicative, pretty, process, regex-pcre - , SafeSemaphore, stack, stdenv, temporary, text, time + , microlens, optparse-applicative, path, pretty, process + , regex-pcre, SafeSemaphore, stack, stdenv, temporary, text, time }: mkDerivation { pname = "stack2nix"; @@ -34626,8 +34626,8 @@ inherit (pkgs) which;}; libraryHaskellDepends = [ async base Cabal cabal2nix containers directory distribution-nixpkgs filepath language-nix microlens - optparse-applicative pretty process regex-pcre SafeSemaphore stack - temporary text time + optparse-applicative path pretty process regex-pcre SafeSemaphore + stack temporary text time ]; executableHaskellDepends = [ base Cabal optparse-applicative time