diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,50 @@ +# Changelog + +## v0.2 (2018-07-24) + +Major changes: + +- Use full stackage snapshot instead of relying on the build plan #83 +- Get rid of hnix and rely on Derivation type from cabal2nix +- Use nix to provision executables if missing #83 +- Use GHC version that belongs to the LTS #84 +- ghc-options in stack.yaml are now passed to generated Nix exprs #96 +- Support --bench #97 + +Other enhancements: + +- Support --platform to set targeting system generation #79 +- Use cabal2nix and stack as haskell libraries instead of relying on executable parsing #75 +- Add --verbose flag #78 +- Be able to pin down hackage snapshot #75 +- Optimize cabal2nix calls by reusing HackageDB #75 +- Rewrite tests in hspec to reduce dependencies #83 +- Make stack.yaml filename configurable #90 +- Add option to disable indentation #89 +- When cloning git, also checkout submodules #108 + +Bug fixes: + +- Be able to override GHC core packages #51 +- Cleanup concurrency #33 +- Add --haddock #38 +- Add --test #35 +- Support Stack subdirs #10 +- Correct version parsing #67 +- Silence git stdout output not to leak into Nix #91 + +## v0.1.3.0 (2017-07-27) + +Bug fixes: + +- Apply only Nix overrides without version fixes #26 + +## v0.1.2.0 (2017-06-22) + +Bug fixes: + +- Minor stack2nix.cabal improvements + +## v0.1.1.0 (2017-06-22) + +Initial public release. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,29 +1,32 @@ # stack2nix -[![Build Status](https://travis-ci.org/input-output-hk/stack2nix.svg)](https://travis-ci.org/input-output-hk/stack2nix) +[![Build Status](https://travis-ci.org/input-output-hk/stack2nix.svg?branch=master)](https://travis-ci.org/input-output-hk/stack2nix) ## About -`stack2nix` automates conversion from [Stack](https://docs.haskellstack.org/en/stable/README/) configuration file to [Nix](http://nixos.org/nix/) expressions. +`stack2nix` automates conversion from [Stack](https://docs.haskellstack.org/en/stable/README/) configuration file to [Nix](http://nixos.org/nix/) expressions. The purpose is to map stack.yaml one-to-one into Nix expressions. `stack2nix` high-level workflow: -- invoke `stack list-dependencies` to determine complete fixed version list of packages based on resolver +- Generate stackage snapshot to determine complete fixed version list of packages based on resolver - apply any additional configuration (local packages, extra dependencies, etc) from `stack.yaml` - generate complete list of dependencies to Nix expressions, replacing upstream `hackage-packages.nix` ## Installation -There are two options. The first is to install stack2nix and its dependencies on your machine directly, and the second is to use the supported virtual machine configuration. +There are three options. The first - using Nix is recommended. If there are difficulties please file an issue. -If there are difficulties please file an issue. Generally the virtual machine approach should be more reliable. +## Nix (recommended) -### Native Environment +1. Install [Nix](https://nixos.org/nix/). +2. Clone this repo. +3. Run `nix-build` to build. -1. Install [nix](https://nixos.org/nix/). +### Stack + +1. Install [Nix](https://nixos.org/nix/). 2. Clone this repo. -3. Run `stack install` to install. -4. Ensure `cabal2nix` v2.2.1 or higher and `stack2nix` are in your `$PATH`. +3. Run `stack install --nix` to install. ### Virtual Machine @@ -34,24 +37,24 @@ ## Usage -Nix expressions generated by stack2nix depend on a somewhat recent upstream change to nixpkgs. If `nix-env` or `nix-build` fails with an error mentioning `initialPackages`, try setting the `NIX_PATH` environment variable: `NIX_PATH=nixpkgs=https://github.com/NixOS/nixpkgs/archive/21a8239452adae3a4717772f4e490575586b2755.tar.gz`. +Nix expressions generated by stack2nix require NixOS 17.09 or later. -### Remote Packages +### Local Packages -Stack2nix can generate a nix expressions for Haskell packages hosted in git repositories. +Sometimes it's convenient to build local Haskell packages. Assuming the current directory is a locally maintained fork of Pandoc: ``` - $ stack2nix --revision 242e2a064f6a32b22e1599bbfe72e64d7b6203b8 https://github.com/jgm/pandoc.git > demo.nix - $ nix-build -A pandoc demo.nix + $ stack2nix . > default.nix + $ nix-build -A pandoc ``` -### Local Packages +### Remote Packages -Sometimes it's convenient to build local Haskell packages. Assuming the current directory is a locally maintained fork of Pandoc: +Stack2nix can generate a nix expressions for Haskell packages hosted in git repositories. ``` - $ stack2nix . > default.nix - $ nix-build -A pandoc + $ stack2nix --revision 242e2a064f6a32b22e1599bbfe72e64d7b6203b8 https://github.com/jgm/pandoc.git > demo.nix + $ nix-build -A pandoc demo.nix ``` ## Testing diff --git a/src/Stack2nix.hs b/src/Stack2nix.hs --- a/src/Stack2nix.hs +++ b/src/Stack2nix.hs @@ -1,363 +1,74 @@ +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module Stack2nix ( Args(..) - , Package(..) - , RemotePkgConf(..) - , StackConfig(..) - , parseStackYaml , stack2nix , version ) where -import Control.Concurrent.Async -import Control.Concurrent.MSem -import Control.Exception (SomeException, catch, - onException) -import Control.Monad (unless) -import qualified Data.ByteString as BS -import Data.Fix (Fix (..)) -import Data.List (foldl', sort, union, (\\)) -import qualified Data.Map.Strict as Map -import Data.Maybe (fromMaybe, listToMaybe) -import Data.Monoid ((<>)) -import Data.Text (Text, pack, unpack) -import qualified Data.Traversable as T -import Data.Version (Version (..), parseVersion, - showVersion) -import Data.Yaml (FromJSON (..), (.!=), (.:), - (.:?)) -import qualified Data.Yaml as Y -import Distribution.Text (display) -import Nix.Expr (Binding (..), NExpr, NExprF (..), - NKeyName (..), ParamSet (..), - Params (..)) -import Nix.Parser (Result (..), parseNixFile, - parseNixString) -import Nix.Pretty (prettyNix) -import Paths_stack2nix (version) -import Stack2nix.External (cabal2nix) -import Stack2nix.External.Util (runCmd, runCmdFrom) -import Stack2nix.External.VCS.Git (Command (..), ExternalCmd (..), - InternalCmd (..), git) -import System.Directory (doesFileExist) -import System.Environment (getEnv) -import System.FilePath (dropExtension, isAbsolute, - normalise, takeDirectory, - takeFileName, ()) -import System.FilePath.Glob (glob) -import System.IO (hPutStrLn, stderr, stdout) -import System.IO.Temp (withSystemTempDirectory) -import Text.ParserCombinators.ReadP (readP_to_S) - -data Args = Args - { argRev :: Maybe String - , argOutFile :: Maybe FilePath - , argUri :: String - } - deriving (Show) - -data StackConfig = StackConfig - { resolver :: Text - , packages :: [Package] - , extraDeps :: [Text] - } - deriving (Show, Eq) - -data Package = LocalPkg FilePath - | RemotePkg RemotePkgConf - deriving (Show, Eq) - -data RemotePkgConf = RemotePkgConf - { gitUrl :: Text - , commit :: Text - , extraDep :: Bool - } - deriving (Show, Eq) - -instance FromJSON StackConfig where - parseJSON (Y.Object v) = - StackConfig <$> - v .: "resolver" <*> - v .: "packages" <*> - v .: "extra-deps" - parseJSON _ = fail "Expected Object for StackConfig value" - -instance FromJSON Package where - parseJSON (Y.String v) = return $ LocalPkg $ unpack v - parseJSON obj@(Y.Object _) = RemotePkg <$> parseJSON obj - parseJSON _ = fail "Expected String or Object for Package value" - -instance FromJSON RemotePkgConf where - parseJSON (Y.Object v) = do - loc <- v .: "location" - gitUrl <- loc .: "git" - commit <- loc .: "commit" - extra <- v .:? "extra-dep" .!= False - return $ RemotePkgConf gitUrl commit extra - parseJSON _ = fail "Expected Object for RemotePkgConf value" - -parseStackYaml :: BS.ByteString -> Maybe StackConfig -parseStackYaml = Y.decode - -checkRuntimeDeps :: IO () -checkRuntimeDeps = do - checkVer "cabal2nix" "2.2.1" - checkVer "git" "2" - checkVer "cabal" "1" - where - checkVer prog minVer = do - hPutStrLn stderr $ unwords ["Ensuring", prog, "version is >=", minVer, "..."] - result <- runCmd prog ["--version"] `onException` (error $ "Failed to run " ++ prog ++ ". Not found in PATH.") - case result of - Right out -> - let - -- heuristic for parsing version from stdout - firstLine = head . lines - lastWord = head . reverse . words - ver = parseVer . lastWord . firstLine $ out - in - unless (ver >= parseVer minVer) $ error $ unwords ["ERROR:", prog, "version must be", minVer, "or higher. Current version:", maybe "[parse failure]" showVersion ver] - Left err -> error err - - parseVer :: String -> Maybe Version - parseVer = - fmap fst . listToMaybe . reverse . readP_to_S parseVersion +import Control.Monad (unless, void) +import Data.Maybe (isJust) +import Data.Monoid ((<>)) +import Paths_stack2nix (version) +import Stack2nix.External.Stack +import Stack2nix.External.Util (runCmdFrom, failHard) +import Stack2nix.External.VCS.Git (Command (..), ExternalCmd (..), + InternalCmd (..), git) +import Stack2nix.Types (Args (..)) +import Stack2nix.Util +import System.Directory (doesFileExist, + getCurrentDirectory, withCurrentDirectory) +import System.Environment (getEnv, setEnv) +import System.FilePath (()) +import System.IO.Temp (withSystemTempDirectory) stack2nix :: Args -> IO () stack2nix args@Args{..} = do - checkRuntimeDeps + ensureExecutableExists "cabal" "cabal-install" + ensureExecutableExists "git" "git" + ensureExecutableExists "nix-prefetch-git" "nix-prefetch-scripts" + assertMinVer "git" "2" + assertMinVer "cabal" "2" + setEnv "GIT_QUIET" "y" updateCabalPackageIndex - isLocalRepo <- doesFileExist $ argUri "stack.yaml" + -- cwd <- getCurrentDirectory + -- let projRoot = if isAbsolute argUri then argUri else cwd argUri + let projRoot = argUri + isLocalRepo <- doesFileExist $ projRoot argStackYaml + logDebug args $ "stack2nix (isLocalRepo): " ++ show isLocalRepo + logDebug args $ "stack2nix (projRoot): " ++ show projRoot + logDebug args $ "stack2nix (argUri): " ++ show argUri if isLocalRepo - then handleStackConfig Nothing argUri + then handleStackConfig Nothing projRoot else withSystemTempDirectory "s2n-" $ \tmpDir -> tryGit tmpDir >> handleStackConfig (Just argUri) tmpDir where updateCabalPackageIndex :: IO () - updateCabalPackageIndex = - getEnv "HOME" >>= \home -> runCmdFrom home "cabal" ["update"] >> return () + updateCabalPackageIndex = do + home <- getEnv "HOME" + out <- runCmdFrom home "cabal" ["update"] + void $ failHard out tryGit :: FilePath -> IO () tryGit tmpDir = do - git $ OutsideRepo $ Clone argUri tmpDir + void $ git $ OutsideRepo $ Clone argUri tmpDir case argRev of - Just r -> git $ InsideRepo tmpDir $ Checkout r + Just r -> void $ git $ InsideRepo tmpDir (Checkout r) Nothing -> return mempty handleStackConfig :: Maybe String -> FilePath -> IO () handleStackConfig remoteUri localDir = do - let fname = localDir "stack.yaml" - alreadyExists <- doesFileExist fname - unless alreadyExists $ runCmdFrom localDir "stack" ["init", "--system-ghc"] - >> return () - contents <- BS.readFile fname - case parseStackYaml contents of - Just config -> toNix args remoteUri localDir config - Nothing -> error $ "Failed to parse " <> (localDir "stack.yaml") - --- Credit: https://stackoverflow.com/a/18898822/204305 -mapPool :: T.Traversable t => Int -> (a -> IO b) -> t a -> IO (t b) -mapPool max' f xs = do - sem <- new max' - mapConcurrently (with sem . f) xs - -c2nPoolSize :: Int -c2nPoolSize = 4 - -toNix :: Args -> Maybe String -> FilePath -> StackConfig -> IO () -toNix Args{..} remoteUri baseDir StackConfig{..} = - withSystemTempDirectory "s2n" $ \outDir -> do - _ <- mapPool c2nPoolSize (genNixFile outDir) packages - overrides <- mapPool c2nPoolSize overrideFor =<< updateDeps outDir - _ <- mapPool c2nPoolSize (genNixFile outDir) packages - _ <- mapPool c2nPoolSize patchNixFile =<< glob (outDir "*.nix") - writeFile (outDir "initialPackages.nix") $ initialPackages $ sort overrides - pullInNixFiles $ outDir "initialPackages.nix" - nf <- parseNixFile $ outDir "initialPackages.nix" - case nf of - Success expr -> - case argOutFile of - Just fname -> writeFile fname $ defaultNix expr - Nothing -> hPutStrLn stdout $ defaultNix expr - _ -> error "failed to parse intermediary initialPackages.nix file" - where - updateDeps :: FilePath -> IO [FilePath] - updateDeps outDir = do - hPutStrLn stderr $ "Updating deps from " ++ baseDir - result <- runCmdFrom baseDir "stack" ["list-dependencies", "--system-ghc", "--separator", "-"] - case result of - Right pkgs -> do - let pkgs' = ["hscolour", "jailbreak-cabal", "cabal-doctest", "happy", "stringbuilder"] ++ lines pkgs - hPutStrLn stderr "Haskell dependencies:" - mapM_ (hPutStrLn stderr) pkgs' - _ <- mapPool c2nPoolSize (\d -> catch (handleExtraDep outDir d) ignoreError) $ pack <$> pkgs' - return () - Left err -> error $ unlines ["FAILED: stack list-dependencies", err] - glob (outDir "*.nix") - - -- TODO: Remove this. - ignoreError :: SomeException -> IO () - ignoreError _ = return () - - genNixFile :: FilePath -> Package -> IO () - genNixFile outDir (LocalPkg relPath) = - cabal2nix (fromMaybe baseDir remoteUri) (pack <$> argRev) (Just relPath) (Just outDir) - genNixFile outDir (RemotePkg RemotePkgConf{..}) = - cabal2nix (unpack gitUrl) (Just commit) Nothing (Just outDir) - - patchNixFile :: FilePath -> IO () - patchNixFile fname = do - contents <- readFile fname - case parseNixString contents of - Success expr -> - case takeFileName fname of - "hspec.nix" -> do - writeFile fname $ show $ prettyNix $ (addParam "stringbuilder" . stripNonEssentialDeps) expr - _ -> writeFile fname $ show $ prettyNix $ stripNonEssentialDeps expr - _ -> error "failed to parse intermediary nix package file" - - addParam :: String -> NExpr -> NExpr - addParam param expr = - let contents = show $ prettyNix expr - (l:ls) = lines contents - (openBrace, params) = splitAt 1 (words l) - l' = unwords $ openBrace ++ [param ++ ", "] ++ params - in - case parseNixString $ unlines (l':ls) of - Success expr' -> expr' - _ -> expr - - stripNonEssentialDeps :: NExpr -> NExpr - stripNonEssentialDeps expr = - let sectsToDrop = ["testHaskellDepends", "testToolDepends", "benchmarkHaskellDepends", "benchmarkToolDepends"] - sectsToKeep = ["executableHaskellDepends", "executableToolDepends", "libraryHaskellDepends", "librarySystemDepends", "libraryToolDepends", "setupHaskellDepends"] - collectDeps sects = foldr union [] $ fmap (dependenciesFromSection expr) sects - depsToStrip = collectDeps sectsToDrop \\ collectDeps sectsToKeep - expr' = foldl dropDependencySection expr sectsToDrop - in - dropParams expr' depsToStrip - - handleExtraDep :: FilePath -> Text -> IO () - handleExtraDep outDir dep = - cabal2nix ("cabal://" <> unpack dep) Nothing Nothing (Just outDir) - - overrideFor :: FilePath -> IO String - overrideFor nixFile = do - deps <- externalDeps - return $ " " <> (dropExtension . takeFileName) nixFile <> " = callPackage ./" <> takeFileName nixFile <> " { " <> deps <> " };" - where - externalDeps :: IO String - externalDeps = do - deps <- librarySystemDeps nixFile - return . unwords $ fmap (\d -> unpack d <> " = pkgs." <> unpack d <> ";") deps - - pullInNixFiles :: FilePath -> IO () - pullInNixFiles nixFile = do - nf <- parseNixFile nixFile - case nf of - Success expr -> - case expr of - Fix (NAbs paramSet (Fix (NAbs fnParam (Fix (NSet attrs))))) -> do - attrs' <- mapM patchAttr attrs - let expr' = Fix (NAbs paramSet (Fix (NAbs fnParam (Fix (NSet attrs'))))) - writeFile nixFile $ (++ "\n") $ show $ prettyNix expr' - _ -> - error $ "unhandled nix expression format\n" ++ show expr - _ -> error "failed to parse nix file!" - where - patchAttr :: Binding (Fix NExprF) -> IO (Binding (Fix NExprF)) - patchAttr attr = - case attr of - NamedVar k (Fix (NApp (Fix (NApp (Fix (NSym "callPackage")) pkg)) deps)) -> do - pkg' <- patchPkgRef pkg - return $ NamedVar k (Fix (NApp (Fix (NApp (Fix (NSym "callPackage")) pkg')) deps)) - _ -> error $ "unhandled NamedVar" - - patchPkgRef (Fix (NLiteralPath path)) = do - let p = if isAbsolute path then path else normalise $ takeDirectory nixFile path - nf <- parseNixFile p - case nf of - Success expr -> return expr - _ -> error $ "failed to parse referenced nix file '" ++ path ++ "'" - patchPkgRef x = return x - - dependenciesFromSection :: NExpr -> String -> [Text] - dependenciesFromSection expr name = do - case expr of - Fix (NAbs _ (Fix (NApp _ (Fix (NSet namedVars))))) -> - case lookupNamedVar namedVars name of - Just (Fix (NList deps)) -> - foldl' (\acc x -> - case x of - Fix (NSym n) -> n : acc - _ -> acc) [] deps - _ -> [] - _ -> [] - - librarySystemDeps :: FilePath -> IO [Text] - librarySystemDeps nixFile = do - nf <- parseNixFile nixFile - case nf of - Success expr -> return $ dependenciesFromSection expr "librarySystemDepends" - _ -> return [] - - dropDependencySection :: NExpr -> String -> NExpr - dropDependencySection expr name = - case expr of - Fix (NAbs a (Fix (NApp b (Fix (NSet namedVars))))) -> - Fix (NAbs a (Fix (NApp b (Fix (NSet $ dropNamedVar namedVars name))))) - _ -> expr - - lookupNamedVar :: [Binding a] -> String -> Maybe a - lookupNamedVar [] _ = Nothing - lookupNamedVar (x:xs) name = - case x of - NamedVar [StaticKey k] val -> - if unpack k == name - then Just val - else lookupNamedVar xs name - _ -> lookupNamedVar xs name - - dropNamedVar :: [Binding a] -> String -> [Binding a] - dropNamedVar xs name = filter differentName xs - where - differentName (NamedVar [StaticKey k] _) = unpack k /= name - differentName _ = True - - dropParams :: NExpr -> [Text] -> NExpr - dropParams (Fix (NAbs (ParamSet (FixedParamSet paramMap) x) - (Fix (NApp mkDeriv (Fix (NSet args)))))) names = - Fix (NAbs (ParamSet (FixedParamSet $ foldr Map.delete paramMap names) x) - (Fix (NApp mkDeriv (Fix (NSet args))))) - dropParams x _ = x - - initialPackages overrides = unlines $ - [ "{ pkgs, stdenv, callPackage }:" - , "" - , "self: {" - ] ++ overrides ++ - [ "}" - ] - - defaultNix pkgsNixExpr = 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" - , ", ghc ? pkgs.haskell.compiler.ghc802" - , "}:" - , "" - , "with (import { inherit pkgs; });" - , "" - , "let" - , " stackPackages = " ++ show (prettyNix pkgsNixExpr) ++ ";" - , "in" - , "compiler.override {" - , " initialPackages = stackPackages;" - , " configurationCommon = { ... }: self: super: {};" - , "}" - ] + cwd <- getCurrentDirectory + logDebug args $ "handleStackConfig (cwd): " ++ cwd + logDebug args $ "handleStackConfig (localDir): " ++ localDir + logDebug args $ "handleStackConfig (remoteUri): " ++ show remoteUri + let stackFile = localDir argStackYaml + alreadyExists <- doesFileExist stackFile + unless alreadyExists $ error $ stackFile <> " does not exist. Use 'stack init' to create it." + logDebug args $ "handleStackConfig (alreadyExists): " ++ show alreadyExists + let go = if isJust remoteUri + then withCurrentDirectory localDir + else id + go $ runPlan localDir remoteUri args diff --git a/src/Stack2nix/External.hs b/src/Stack2nix/External.hs deleted file mode 100644 --- a/src/Stack2nix/External.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Stack2nix.External - ( module Stack2nix.External.Cabal2nix - , module Stack2nix.External.VCS - ) where - -import Stack2nix.External.Cabal2nix -import Stack2nix.External.VCS diff --git a/src/Stack2nix/External/Cabal2nix.hs b/src/Stack2nix/External/Cabal2nix.hs --- a/src/Stack2nix/External/Cabal2nix.hs +++ b/src/Stack2nix/External/Cabal2nix.hs @@ -1,43 +1,49 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} + module Stack2nix.External.Cabal2nix ( cabal2nix ) where -import Data.List (stripPrefix, takeWhile) -import Data.Maybe (fromMaybe) -import Data.Monoid ((<>)) -import Data.Text (Text, unpack) -import Stack2nix.External.Util (runCmd) -import System.FilePath (()) +import Cabal2nix (cabal2nixWithDB, parseArgs, optNixpkgsIdentifier, Options) +import Control.Lens +import Data.Maybe (fromMaybe) +import Data.Text (Text, unpack) +import qualified Distribution.Nixpkgs.Haskell.Hackage as DB +import Distribution.Nixpkgs.Haskell.Derivation (Derivation) +import Distribution.System (Platform(..), Arch(..), OS(..)) +import Language.Nix +import System.IO (hPutStrLn, stderr) +import Stack2nix.Types (Args (..)) --- Requires cabal2nix >= 2.2 in PATH -cabal2nix :: FilePath -> Maybe Text -> Maybe FilePath -> Maybe FilePath -> IO () -cabal2nix uri commit subpath odir = do - result <- runCmd exe (args $ fromMaybe "." subpath) - case result of - Right stdout -> - let basename = pname stdout <> ".nix" - fname = maybe basename ( basename) odir - in - writeFile fname stdout - Left stderr -> error stderr - where - exe = "cabal2nix" +import Text.PrettyPrint.HughesPJClass (Doc) +cabal2nix :: Args -> FilePath -> Maybe Text -> Maybe FilePath -> DB.HackageDB -> IO (Either Doc Derivation) +cabal2nix Args{..} uri commit subpath hackageDB = do + let runCmdArgs = args $ fromMaybe "." subpath + hPutStrLn stderr $ unwords ("+ cabal2nix":runCmdArgs) + options <- parseArgs runCmdArgs + cabal2nixWithDB hackageDB $ cabalOptions options + + where args :: FilePath -> [String] args dir = concat [ maybe [] (\c -> ["--revision", unpack c]) commit - -- , maybe [] (\d -> ["--subpath", d]) subpath , ["--subpath", dir] - , ["--no-check", "--no-haddock"] -- TODO: only use on repos that need it. + , ["--system", fromCabalPlatform argPlatform] , [uri] ] - pname :: String -> String - pname = pname' . lines +-- Override default nixpkgs resolver to do pkgs.attr instead of attr +cabalOptions :: Options -> Options +cabalOptions options = + options { + optNixpkgsIdentifier = \i -> Just (binding # (i, path # ["pkgs", i])) + } - pname' :: [String] -> String - pname' [] = error "nix expression generated by cabal2nix is missing the 'pname' attr" - pname' (x:xs) = - case stripPrefix " pname = \"" x of - Just x' -> takeWhile (/= '"') x' - Nothing -> pname' xs +-- | Copied (and modified) from src/Distribution/Nixpkgs/Meta.hs +fromCabalPlatform :: Platform -> String +fromCabalPlatform (Platform I386 Linux) = "i686-linux" +fromCabalPlatform (Platform X86_64 Linux) = "x86_64-linux" +fromCabalPlatform (Platform X86_64 OSX) = "x86_64-darwin" +fromCabalPlatform p = error ("fromCabalPlatform: invalid Nix platform" ++ show p) diff --git a/src/Stack2nix/External/Stack.hs b/src/Stack2nix/External/Stack.hs new file mode 100644 --- /dev/null +++ b/src/Stack2nix/External/Stack.hs @@ -0,0 +1,190 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Stack2nix.External.Stack + ( PackageRef(..), runPlan + ) where + +import Control.Lens ((%~)) +import Data.List (concat) +import qualified Data.Map.Strict as M +import Data.Maybe (fromJust) +import qualified Data.Set as Set (fromList, + union) +import Data.Text (pack, unpack) +import Distribution.Nixpkgs.Haskell.Derivation (Derivation, + configureFlags) +import qualified Distribution.Nixpkgs.Haskell.Hackage as DB +import Options.Applicative +import Path (parseAbsFile) +import Stack.Build.Source (getGhcOptions, loadSourceMapFull) +import Stack.Build.Target (NeedTargets (..)) +import Stack.Config +import Stack.Options.BuildParser +import Stack.Options.GlobalParser +import Stack.Options.Utils (GlobalOptsContext (..)) +import Stack.Prelude hiding + (logDebug) +import Stack.Runners (loadCompilerVersion, + withBuildConfig) +import Stack.Types.BuildPlan (PackageLocation (..), + Repo (..)) +import Stack.Types.Compiler (CVType (..), + CompilerVersion, + getGhcVersion) +import Stack.Types.Config +import Stack.Types.Config.Build (BuildCommand (..)) +import Stack.Types.Nix +import Stack.Types.Package (PackageSource (..), + lpLocation, + lpPackage, + packageName, + packageVersion) +import Stack.Types.PackageIdentifier (PackageIdentifier (..), + PackageIdentifierRevision (..), + packageIdentifierString) +import Stack.Types.PackageName (PackageName) +import Stack.Types.Runner +import Stack2nix.External.Cabal2nix (cabal2nix) +import Stack2nix.Hackage (loadHackageDB) +import Stack2nix.Render (render) +import Stack2nix.Types (Args (..)) +import Stack2nix.Util (ensureExecutable, + logDebug, + mapPool) +import System.Directory (canonicalizePath, + createDirectoryIfMissing, + getCurrentDirectory, + makeRelativeToCurrentDirectory) +import System.FilePath (makeRelative, + ()) +import Text.PrettyPrint.HughesPJClass (Doc) + +data PackageRef + = HackagePackage PackageIdentifierRevision + | NonHackagePackage PackageIdentifier (PackageLocation FilePath) + deriving (Eq, Show) + +genNixFile :: Args -> FilePath -> Maybe String -> Maybe String -> DB.HackageDB -> PackageRef -> IO (Either Doc Derivation) +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 _) -> + cabal2nix args ("cabal://" <> packageIdentifierString pkg) Nothing Nothing hackageDB + NonHackagePackage _ident (PLRepo repo) -> + cabal2nix args (unpack $ repoUrl repo) (Just $ repoCommit repo) (Just (repoSubdirs repo)) hackageDB + NonHackagePackage _ident (PLFilePath path) -> do + relPath <- makeRelativeToCurrentDirectory path + projRoot <- canonicalizePath $ cwd baseDir + let defDir = baseDir makeRelative projRoot path + cabal2nix args (fromMaybe defDir uri) (pack <$> argRev) (const relPath <$> uri) hackageDB + +-- TODO: remove once we use flags, options +sourceMapToPackages :: Map PackageName PackageSource -> [PackageRef] +sourceMapToPackages = map sourceToPackage . M.elems + where + sourceToPackage :: PackageSource -> PackageRef + sourceToPackage (PSIndex _ _flags _options pir) = HackagePackage pir + sourceToPackage (PSFiles lp _) = + let pkg = lpPackage lp + ident = PackageIdentifier (packageName pkg) (packageVersion pkg) + in NonHackagePackage ident (lpLocation lp) + + +planAndGenerate + :: HasEnvConfig env + => BuildOptsCLI + -> FilePath + -> Maybe String + -> Args + -> String + -> RIO env () +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 + + hackageDB <- liftIO $ loadHackageDB Nothing argHackageSnapshot + buildConf <- envConfigBuildConfig <$> view envConfigL + drvs <- liftIO $ mapPool + argThreads + (\p -> + fmap (addGhcOptions buildConf p) + <$> genNixFile args baseDir remoteUri argRev hackageDB p + ) + pkgs + let locals = map (\l -> show (packageName (lpPackage l))) _locals + liftIO $ render drvs args locals ghcnixversion + +-- | Add ghc-options declared in stack.yaml to the nix derivation for a package +-- by adding to the configureFlags attribute of the derivation +addGhcOptions :: BuildConfig -> PackageRef -> Derivation -> Derivation +addGhcOptions buildConf pkgRef drv = + drv & configureFlags %~ (Set.union stackGhcOptions) + where + stackGhcOptions :: Set String + stackGhcOptions = + Set.fromList . map (unpack . ("--ghc-option=" <>)) $ getGhcOptions + buildConf + buildOpts + pkgName + False + False + pkgName :: PackageName + pkgName = case pkgRef of + HackagePackage (PackageIdentifierRevision (PackageIdentifier n _) _) -> n + NonHackagePackage (PackageIdentifier n _) _ -> n + +runPlan :: FilePath + -> Maybe String + -> Args + -> IO () +runPlan baseDir remoteUri args@Args{..} = do + let stackRoot = "/tmp/s2n" + createDirectoryIfMissing True stackRoot + let globals = globalOpts baseDir stackRoot args + let stackFile = baseDir argStackYaml + + 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 + +globalOpts :: FilePath -> FilePath -> Args -> GlobalOpts +globalOpts currentDir stackRoot Args{..} = + go { globalReExecVersion = Just "1.5.1" -- TODO: obtain from stack lib if exposed + , globalConfigMonoid = + (globalConfigMonoid go) + { configMonoidNixOpts = mempty + { nixMonoidEnable = First (Just True) + } + } + , globalStackYaml = SYLOverride (currentDir argStackYaml) + , globalLogLevel = if argVerbose then LevelDebug else LevelInfo + } + where + pinfo = info (globalOptsParser currentDir OuterGlobalOpts (Just LevelError)) briefDesc + args = concat [ ["--stack-root", stackRoot] + , ["--jobs", show argThreads] + , ["--test" | argTest] + , ["--bench" | argBench] + , ["--haddock" | argHaddock] + , ["--no-install-ghc"] + ] + go = globalOptsFromMonoid False . fromJust . getParseResult $ execParserPure defaultPrefs pinfo args + +buildOpts :: BuildOptsCLI +buildOpts = fromJust . getParseResult $ execParserPure defaultPrefs (info (buildOptsParser Build) briefDesc) ["--dry-run"] diff --git a/src/Stack2nix/External/Util.hs b/src/Stack2nix/External/Util.hs --- a/src/Stack2nix/External/Util.hs +++ b/src/Stack2nix/External/Util.hs @@ -1,27 +1,23 @@ module Stack2nix.External.Util where -import Data.List (intercalate) import Data.Monoid ((<>)) import System.Directory (getCurrentDirectory) import System.Exit (ExitCode (..)) -import System.Process (CreateProcess (..)) -import System.Process (proc, readCreateProcessWithExitCode) +import System.Process (CreateProcess (..), proc, + readCreateProcessWithExitCode) -runCmdFrom :: FilePath -> String -> [String] -> IO (Either String String) -runCmdFrom dir prog args = do - (exitCode, stdout, stderr) <- readCreateProcessWithExitCode (fromDir dir (proc prog args)) "" - case exitCode of - ExitSuccess -> return $ Right stdout - _ -> return $ Left $ "Command failed: " ++ cmd ++ "\n" ++ stderr +runCmdFrom :: FilePath -> String -> [String] -> IO (ExitCode, String, String) +runCmdFrom dir prog args = readCreateProcessWithExitCode (fromDir dir (proc prog args)) "" where fromDir :: FilePath -> CreateProcess -> CreateProcess fromDir d procDesc = procDesc { cwd = Just d } - cmd = "cd \"" <> dir <> "\" && " <> intercalate " " (prog:args) - -runCmd :: String -> [String] -> IO (Either String String) +runCmd :: String -> [String] -> IO (ExitCode, String, String) runCmd prog args = getCurrentDirectory >>= (\d -> runCmdFrom d prog args) -failHard :: Show a => Either a b -> IO () -failHard (Left stderr) = error $ show stderr -failHard (Right _) = mempty +failHard :: (ExitCode, String, String) -> IO (ExitCode, String, String) +failHard r@(ExitSuccess, _, _) = pure r +failHard (ExitFailure code, _, err) = + error $ unlines [ "Failed with exit code " <> show code <> "..." + , show err + ] diff --git a/src/Stack2nix/External/VCS.hs b/src/Stack2nix/External/VCS.hs deleted file mode 100644 --- a/src/Stack2nix/External/VCS.hs +++ /dev/null @@ -1,5 +0,0 @@ -module Stack2nix.External.VCS - ( module Stack2nix.External.VCS.Git - ) where - -import Stack2nix.External.VCS.Git diff --git a/src/Stack2nix/External/VCS/Git.hs b/src/Stack2nix/External/VCS/Git.hs --- a/src/Stack2nix/External/VCS/Git.hs +++ b/src/Stack2nix/External/VCS/Git.hs @@ -4,6 +4,7 @@ ) where import Stack2nix.External.Util (failHard, runCmd, runCmdFrom) +import System.Exit (ExitCode (..)) data Command = OutsideRepo ExternalCmd | InsideRepo FilePath InternalCmd @@ -16,14 +17,17 @@ exe = "git" -- Requires git binary in PATH -git :: Command -> IO () +git :: Command -> IO (ExitCode, String, String) git (OutsideRepo cmd) = runExternal cmd git (InsideRepo dir cmd) = runInternal dir cmd -runExternal :: ExternalCmd -> IO () -runExternal (Clone uri dir) = do - runCmd exe ["clone", uri, dir] >>= failHard +runExternal :: ExternalCmd -> IO (ExitCode, String, String) +runExternal (Clone uri dir) = + runCmd exe ["clone", "--recurse-submodules", uri, dir] >>= failHard -runInternal :: FilePath -> InternalCmd -> IO () +runInternal :: FilePath -> InternalCmd -> IO (ExitCode, String, String) runInternal repoDir (Checkout ref) = do - runCmdFrom repoDir exe ["checkout", ref] >>= failHard + checkoutCmd <- runCmdFrom repoDir exe ["checkout", ref] + _ <- failHard checkoutCmd + submoduleCmd <- runCmdFrom repoDir exe ["submodule", "update", "--init", "--recursive"] + failHard submoduleCmd diff --git a/src/Stack2nix/Hackage.hs b/src/Stack2nix/Hackage.hs new file mode 100644 --- /dev/null +++ b/src/Stack2nix/Hackage.hs @@ -0,0 +1,42 @@ +-- | This module is needed to replace P.parseDB which would otherwise filter out +-- deprecated packages, which may end up being in an LTS. +module Stack2nix.Hackage + ( loadHackageDB + ) where + +import Control.Exception (SomeException, mapException) +import qualified Data.Map as Map +import Data.Time.Clock (UTCTime) +import Distribution.Hackage.DB.Path (hackageTarball) +import qualified Distribution.Hackage.DB.Unparsed as U +import qualified Distribution.Hackage.DB.Parsed as P +import Distribution.Package (PackageName) +import Distribution.Hackage.DB.Errors (HackageDBPackageName(..)) +import qualified Distribution.Nixpkgs.Haskell.Hackage as H + + + +loadHackageDB :: Maybe FilePath + -- ^ The path to the Hackage database. + -> Maybe UTCTime + -- ^ If we have hackage-snapshot time. + -> IO H.HackageDB +loadHackageDB optHackageDB optHackageSnapshot = do + dbPath <- maybe hackageTarball return optHackageDB + readTarball optHackageSnapshot dbPath + + +readTarball :: Maybe UTCTime -> FilePath -> IO H.HackageDB +readTarball ts p = do + dbu <- U.readTarball ts p + let dbp = parseDB dbu + return (Map.mapWithKey (H.parsePackageData dbu) dbp) + + +parseDB :: U.HackageDB -> P.HackageDB +parseDB = Map.mapWithKey parsePackageData + +parsePackageData :: PackageName -> U.PackageData -> P.PackageData +parsePackageData pn (U.PackageData _ vs') = + mapException (\e -> HackageDBPackageName pn (e :: SomeException)) $ + Map.mapWithKey (P.parseVersionData pn) $ vs' diff --git a/src/Stack2nix/PP.hs b/src/Stack2nix/PP.hs new file mode 100644 --- /dev/null +++ b/src/Stack2nix/PP.hs @@ -0,0 +1,40 @@ +module Stack2nix.PP + (ppIndented, ppSingletons) where + +import Text.PrettyPrint (Doc, Mode(..), TextDetails(..), fullRender, render) + +-- | Formats the derivation doc with indentation and lines wrapped at 100 chars. +ppIndented :: Doc -> String +ppIndented = render + +-- | Formats the derivation doc without indentation and with each list +-- element and function argument on its own line. +-- We go to this effort to "ugly-print" so that the resulting file is +-- less susceptible to merge conflicts when checked into git. +ppSingletons :: Doc -> String +ppSingletons doc = fixSpace . snd $ fullRender LeftMode 80 1.5 printer (0, "") doc + where + printer :: TextDetails -> (Int, String) -> (Int, String) + printer (Chr c) (n, s) = ppChar n s c + printer (Str s1) s2 = fmap (s1 ++) s2 + printer (PStr s1) s2 = fmap (s1 ++) s2 + + ppChar :: Int -> String -> Char -> (Int, String) + ppChar n s c = (n', s') + where + s' = case c of + ',' -> "\n," ++ s + ' ' -> (if n /= 0 then '\n' else ' '):s + '{' -> "{\n " ++ s + '}' -> "\n}" ++ s + _ -> c:s + n' = case c of + '[' -> n - 1 -- PrettyPrint works backwards + ']' -> n + 1 + _ -> n + + -- remove single trailing spaces + fixSpace :: String -> String + fixSpace (' ':'\n':s) = '\n':fixSpace s + fixSpace (c:s) = c:fixSpace s + fixSpace [] = [] diff --git a/src/Stack2nix/Render.hs b/src/Stack2nix/Render.hs new file mode 100644 --- /dev/null +++ b/src/Stack2nix/Render.hs @@ -0,0 +1,159 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Stack2nix.Render + (render) where + +import Control.Lens +import Control.Monad (when) +import Data.Either (lefts, rights) +import Data.List (filter, isPrefixOf, + sort) +import Data.Monoid ((<>)) +import Data.Set (Set) +import qualified Data.Set as Set +import Distribution.Nixpkgs.Haskell.BuildInfo (haskell, pkgconfig, + system, tool) +import Distribution.Nixpkgs.Haskell.Derivation (Derivation, + benchmarkDepends, + dependencies, doCheck, + pkgid, runHaddock, + testDepends) +import Distribution.Text (display) +import Distribution.Types.PackageId (PackageIdentifier (..), + pkgName) +import Distribution.Types.PackageName (unPackageName) +import Language.Nix (path) +import Language.Nix.Binding (Binding, reference) +import Language.Nix.PrettyPrinting (disp) +import Paths_stack2nix (version) +import Stack2nix.Types (Args (..)) +import Stack2nix.PP (ppIndented, ppSingletons) +import System.IO (hPutStrLn, stderr) +import qualified Text.PrettyPrint as PP +import Text.PrettyPrint.HughesPJClass (Doc, fcat, nest, + pPrint, punctuate, + semi, space, text) + +-- TODO: this only covers GHC 8.0.2 +basePackages :: Set String +basePackages = Set.fromList + [ "array" + , "base" + , "binary" + , "bytestring" + , "Cabal" + , "containers" + , "deepseq" + , "directory" + , "filepath" + , "ghc-boot" + , "ghc-boot-th" + , "ghc-prim" + , "ghci" + , "haskeline" + , "hoopl" + , "hpc" + , "integer-gmp" + , "pretty" + , "process" + , "rts" + , "template-haskell" + , "terminfo" + , "time" + , "transformers" + , "unix" + , "xhtml" + ] + +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 + error "Error(s) happened during cabal2nix generation ^^" + let drvs = rights results + + -- See what base packages are missing in the derivations list and null them + let missing = sort $ Set.toList $ Set.difference basePackages $ Set.fromList (map drvToName drvs) + let renderedMissing = map (\b -> nest 6 (text (b <> " = null;"))) missing + let pp = if argIndent args then ppIndented else ppSingletons + + let out = defaultNix pp ghcnixversion $ renderedMissing ++ map (renderOne args locals) drvs + + case argOutFile args of + Just fname -> writeFile fname out + Nothing -> putStrLn out + +renderOne :: Args -> [String] -> Derivation -> Doc +renderOne args locals drv' = nest 6 $ PP.hang + (PP.doubleQuotes (text pid) <> " = callPackage") + 2 + ("(" <> pPrint drv <> ") {" <> text (show pkgs) <> "};") + where + pid = drvToName drv + deps = view dependencies drv + nixPkgs :: [Binding] + nixPkgs = Set.toList $ Set.union (view pkgconfig deps) (view system deps) + -- filter out libX stuff to prevent breakage in generated set + nonXpkgs = filter + (\e -> not + ( "libX" + `Data.List.isPrefixOf` (display (((view (reference . path) e) !! 1))) + ) + ) + nixPkgs + pkgs = fcat $ punctuate space [ disp b <> semi | b <- nonXpkgs ] + drv = + filterDepends args isLocal drv' + & doCheck + .~ (argTest args && isLocal) + & runHaddock + .~ (argHaddock args && isLocal) + isLocal = elem pid locals + +filterDepends :: Args -> Bool -> Derivation -> Derivation +filterDepends args isLocal drv = drv & foldr + (.) + id + (do + (depend, predicate) <- + [(Lens testDepends, argTest args), (Lens benchmarkDepends, argBench args)] + binding <- [Lens haskell, Lens pkgconfig, Lens system, Lens tool] + pure + $ runLens depend + . runLens binding + .~ (if predicate && isLocal + then view (runLens depend . runLens binding) drv + else Set.empty + ) + ) + +drvToName :: Derivation -> String +drvToName drv = unPackageName $ pkgName $ view pkgid drv + +defaultNix :: (Doc -> String) -> String -> [Doc] -> String +defaultNix pp 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.ghc" ++ ghcnixversion + , "}:" + , "" + , "with pkgs.haskell.lib;" + , "" + , "let" + , " stackPackages = { pkgs, stdenv, callPackage }:" + , " self: {" + ] ++ (map pp drvs) ++ + [ " };" + , "in compiler.override {" + , " initialPackages = stackPackages;" + , " configurationCommon = { ... }: self: super: {};" + , " compilerConfig = self: super: {};" + , "}" + ] diff --git a/src/Stack2nix/Types.hs b/src/Stack2nix/Types.hs new file mode 100644 --- /dev/null +++ b/src/Stack2nix/Types.hs @@ -0,0 +1,20 @@ +module Stack2nix.Types where + +import Data.Time (UTCTime) +import Distribution.System (Platform) + +data Args = Args + { argRev :: Maybe String + , argOutFile :: Maybe FilePath + , argStackYaml :: FilePath + , argThreads :: Int + , argTest :: Bool + , argBench :: Bool + , argHaddock :: Bool + , argHackageSnapshot :: Maybe UTCTime + , argPlatform :: Platform + , argUri :: String + , argIndent :: Bool + , argVerbose :: Bool + } + deriving (Show) diff --git a/src/Stack2nix/Util.hs b/src/Stack2nix/Util.hs new file mode 100644 --- /dev/null +++ b/src/Stack2nix/Util.hs @@ -0,0 +1,79 @@ +module Stack2nix.Util + ( assertMinVer + , extractVersion + , mapPool + , logDebug + , ensureExecutableExists + , ensureExecutable + ) where + +import Control.Concurrent.Async +import Control.Concurrent.MSem +import Control.Exception (onException) +import Control.Monad (unless) +import Data.Maybe (listToMaybe) +import qualified Data.Traversable as T +import Data.Version (Version (..), parseVersion, + showVersion) +import Data.Text (pack, strip, unpack) +import GHC.Exts (sortWith) +import Stack2nix.External.Util (runCmd) +import Stack2nix.Types (Args, argVerbose) +import System.Directory (findExecutable) +import System.Environment (getEnv, setEnv) +import System.Exit (ExitCode (..)) +import System.IO (hPutStrLn, stderr) +import System.Process (readProcessWithExitCode) +import Text.ParserCombinators.ReadP (readP_to_S) +import Text.Regex.PCRE (AllTextMatches (..), + getAllTextMatches, (=~)) + +-- Credit: https://stackoverflow.com/a/18898822/204305 +mapPool :: T.Traversable t => Int -> (a -> IO b) -> t a -> IO (t b) +mapPool max' f xs = do + sem <- new max' + mapConcurrently (with sem . f) xs + +-- heuristic for parsing version from stdout +extractVersion :: String -> Maybe Version +extractVersion str = ver + where + firstLine = head . lines $ str + candidateVers = getAllTextMatches (firstLine =~ "[\\d\\.]+" :: AllTextMatches [] String) + bestMatch = head . reverse . sortWith length $ candidateVers + ver = fmap fst . listToMaybe . reverse . readP_to_S parseVersion $ bestMatch + +assertMinVer :: String -> String -> IO () +assertMinVer prog minVer = do + hPutStrLn stderr $ unwords ["Ensuring", prog, "version is >=", minVer, "..."] + result <- runCmd prog ["--version"] `onException` error ("Failed to run " ++ prog ++ ". Not found in PATH.") + case result of + (ExitSuccess, out, _) -> + let ver = extractVersion out in + unless (ver >= extractVersion minVer) $ error $ unwords ["ERROR:", prog, "version must be", minVer, "or higher. Current version:", maybe "[parse failure]" showVersion ver] + (ExitFailure _, _, err) -> error err + +logDebug :: Args -> String -> IO () +logDebug args msg + | argVerbose args = hPutStrLn stderr 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 -> 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 --- a/stack2nix.cabal +++ b/stack2nix.cabal @@ -1,5 +1,5 @@ name: stack2nix -version: 0.1.3.0 +version: 0.2 synopsis: Convert stack.yaml files into Nix build instructions. description: Convert stack.yaml files into Nix build instructions. license: MIT @@ -8,7 +8,9 @@ maintainer: jacob.mitchell@iohk.io category: Distribution, Nix build-type: Simple -extra-source-files: README.md +extra-source-files: + README.md + ChangeLog.md cabal-version: >= 1.10 source-repository head @@ -17,38 +19,62 @@ library hs-source-dirs: src - build-depends: base >=4.9 && <4.10 - , Cabal >= 1.24.2 && < 1.25 - , async >= 2.1.1.1 && < 2.2 - , bytestring >= 0.10.8.1 && < 0.11 + build-depends: base >=4.9 && <4.12 + , Cabal >= 2.0.0.2 && < 2.3 + , async >= 2.1.1.1 && < 2.3 + , cabal2nix >= 2.10 && < 2.11 , containers >= 0.5.7.1 && < 0.6 - , data-fix == 0.0.4 , directory >= 1.3 && < 1.4 + , distribution-nixpkgs >= 1.1 && < 1.2 , filepath >= 1.4.1.1 && < 1.5 - , Glob >= 0.7.14 && < 0.8 - , hnix >= 0.3.4 && < 0.4 - , monad-parallel >= 0.7.2.2 && < 0.8 - , process >= 1.4.3 && < 1.5 + , hackage-db + , optparse-applicative >= 0.13.2 && < 0.15 + , pretty + , path + , language-nix + , lens + , process >= 1.4.3 && < 1.7 + , regex-pcre >= 0.94.4 && < 0.95 , SafeSemaphore >= 0.10.1 && < 0.11 - , temporary >= 1.2.0.4 && < 1.3 + , stack >= 1.5.1 + , temporary >= 1.2.0.4 && < 1.4 , text >= 1.2.2.1 && < 1.3 - , yaml >= 0.8.22.1 && < 0.9 + , time exposed-modules: Stack2nix - other-modules: Stack2nix.External - , Stack2nix.External.Cabal2nix - , Stack2nix.External.VCS + , Stack2nix.PP + , Stack2nix.Render + , Stack2nix.Types + , Stack2nix.Util + other-modules: Stack2nix.External.Cabal2nix + , Stack2nix.External.Stack , Stack2nix.External.VCS.Git , Stack2nix.External.Util + , Stack2nix.Hackage , Paths_stack2nix ghc-options: -Wall default-language: Haskell2010 executable stack2nix main-is: Main.hs - build-depends: base >=4.9 && <4.10 - , Cabal >= 1.24.2 && < 1.25 + build-depends: base + , Cabal , stack2nix - , optparse-applicative >= 0.13.2 && < 0.14 + , optparse-applicative + , time hs-source-dirs: stack2nix - ghc-options: -Wall + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 + +test-suite test + default-language: + Haskell2010 + type: + exitcode-stdio-1.0 + hs-source-dirs: + tests + main-is: + test.hs + build-depends: + base >= 4 && < 5 + , hspec + , stack2nix diff --git a/stack2nix/Main.hs b/stack2nix/Main.hs --- a/stack2nix/Main.hs +++ b/stack2nix/Main.hs @@ -1,18 +1,61 @@ module Main ( main ) where -import Data.Semigroup ((<>)) -import Distribution.Text (display) +import Data.Semigroup ((<>)) +import Data.Time (UTCTime, defaultTimeLocale, + parseTimeM) +import qualified Distribution.Compat.ReadP as P +import Distribution.System (Arch (..), OS (..), Platform (..), + buildPlatform) +import Distribution.Text (display) import Options.Applicative import Stack2nix +import System.IO (BufferMode (..), hSetBuffering, + stderr, stdout) args :: Parser Args args = Args <$> optional (strOption $ long "revision" <> help "revision to use when fetching from VCS") - <*> optional (strOption $ short 'o' <> help "output file for generated nix expression") + <*> optional (strOption $ short 'o' <> help "output file for generated nix expression" <> metavar "PATH") + <*> strOption (long "stack-yaml" <> help "Override project stack.yaml file" <> showDefault <> value "stack.yaml") + <*> option auto (short 'j' <> help "number of threads for subprocesses" <> showDefault <> value 4 <> metavar "INT") + <*> switch (long "test" <> help "enable tests") + <*> switch (long "bench" <> help "enable benchmarks") + <*> switch (long "haddock" <> help "enable documentation generation") + <*> optional (option utcTimeReader (long "hackage-snapshot" <> help "hackage snapshot time, ISO format")) + <*> option (readP platformReader) (long "platform" <> help "target platform to use when invoking stack or cabal2nix" <> value buildPlatform <> showDefaultWith display) <*> strArgument (metavar "URI") + <*> flag True False (long "no-indent" <> help "disable indentation and place one item per line") + <*> switch (long "verbose" <> help "verbose output") + where + -- | A parser for the date. Hackage updates happen maybe once or twice a month. + -- Example: parseTime defaultTimeLocale "%FT%T%QZ" "2017-11-20T12:18:35Z" :: Maybe UTCTime + utcTimeReader :: ReadM UTCTime + utcTimeReader = eitherReader $ \arg -> + case parseTimeM True defaultTimeLocale "%FT%T%QZ" arg of + Nothing -> Left $ "Cannot parse date, ISO format used ('2017-11-20T12:18:35Z'): " ++ arg + Just utcTime -> Right utcTime + -- | A String parser for Distribution.System.Platform + -- | Copied from cabal2nix/src/Cabal2nix.hs + platformReader :: P.ReadP r Platform + platformReader = do + arch <- P.choice [P.string "i686" >> return I386, P.string "x86_64" >> return X86_64] + _ <- P.char '-' + os <- P.choice [P.string "linux" >> return Linux, P.string "darwin" >> return OSX] + return (Platform arch os) + + readP :: P.ReadP a a -> ReadM a + readP p = eitherReader $ \s -> + case [ r' | (r',"") <- P.readP_to_S p s ] of + (r:_) -> Right r + _ -> Left ("invalid value " ++ show s) + + main :: IO () -main = stack2nix =<< execParser opts +main = do + hSetBuffering stdout LineBuffering + hSetBuffering stderr LineBuffering + stack2nix =<< execParser opts where opts = info (helper diff --git a/tests/test.hs b/tests/test.hs new file mode 100644 --- /dev/null +++ b/tests/test.hs @@ -0,0 +1,17 @@ + +import Data.Version (makeVersion) +import Stack2nix.Util +import Test.Hspec + + +main :: IO () +main = hspec $ do + describe "Stack2nix.Util" $ do + it "cabal-install version extraction" $ do + extractVersion "cabal-install version 2.0.0.0" `shouldBe` Just (makeVersion [2, 0, 0, 0]) + it "git version extraction" $ do -- issue #67 + extractVersion "git version 2.11.0 (Apple Git-81)" `shouldBe` Just (makeVersion [2, 11, 0]) + it "cabal2nix version extraction" $ do + extractVersion "cabal2nix 2.7" `shouldBe` Just (makeVersion [2, 7]) + it "ghc version extraction" $ do + extractVersion "The Glorious Glasgow Haskell Compilation System, version 8.0.2" `shouldBe` Just (makeVersion [8, 0, 2])