mirror of
https://github.com/simplex-chat/haskell.nix.git
synced 2026-06-03 09:17:32 +00:00
Andrea Bedini
5b7f7f245c
git-subtree-dir: nix-tools git-subtree-mainline:1110a74a9dgit-subtree-split:555d57e1ea
242 lines
10 KiB
Haskell
242 lines
10 KiB
Haskell
{-# LANGUAGE LambdaCase, RecordWildCards, OverloadedStrings, TupleSections #-}
|
|
|
|
module Stack2nix
|
|
( doStack2nix
|
|
, stackexpr
|
|
, stack2nix
|
|
) where
|
|
|
|
import qualified Data.Text as T
|
|
import Data.String (fromString)
|
|
|
|
import Control.Monad.Trans.Maybe
|
|
import Control.Monad.IO.Class (liftIO)
|
|
import Control.Monad (unless, forM, forM_)
|
|
import Extra (unlessM)
|
|
|
|
import qualified Data.Map as M (fromListWith, toList)
|
|
import System.FilePath ((<.>), (</>), takeDirectory, dropFileName)
|
|
import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist)
|
|
import System.IO (IOMode(..), openFile, hClose)
|
|
import Data.Yaml (decodeFileEither)
|
|
|
|
import Nix.Expr
|
|
import Nix.Pretty (prettyNix)
|
|
import Data.Text.Prettyprint.Doc (Doc)
|
|
import Data.Text.Prettyprint.Doc.Render.Text (hPutDoc)
|
|
|
|
import Distribution.Types.PackageId (PackageIdentifier(..))
|
|
import Distribution.Nixpkgs.Fetch (DerivationSource(..), Source(..), Hash(..), fetch)
|
|
import Distribution.Simple.Utils (shortRelativePath)
|
|
import Distribution.Text (simpleParse)
|
|
import Distribution.Pretty (Pretty(..))
|
|
|
|
import Cabal2Nix hiding (Git)
|
|
import qualified Cabal2Nix as C2N
|
|
import Cabal2Nix.Util
|
|
|
|
import Stack2nix.Cache (appendCache, cacheHits)
|
|
import Stack2nix.CLI (Args(..))
|
|
import Stack2nix.Project
|
|
import Stack2nix.Stack (Stack(..), Dependency(..), Location(..), PackageFlags, GhcOptions)
|
|
import Stack2nix.External.Resolve
|
|
|
|
import qualified Data.HashMap.Strict as HM
|
|
|
|
|
|
doStack2nix :: Args -> IO ()
|
|
doStack2nix args = do
|
|
let pkgsNix = argOutputDir args </> "pkgs.nix"
|
|
defaultNix = argOutputDir args </> "default.nix"
|
|
pkgs <- stackexpr args
|
|
writeDoc pkgsNix (prettyNix pkgs)
|
|
unlessM (doesFileExist defaultNix) $ do
|
|
writeFile defaultNix defaultNixContents
|
|
|
|
stackexpr :: Args -> IO NExpr
|
|
stackexpr args =
|
|
do evalue <- decodeFileEither (argStackYaml args)
|
|
case evalue of
|
|
Left e -> error (show e)
|
|
Right value -> stack2nix args
|
|
=<< resolveSnapshot (argStackYaml args) value
|
|
|
|
stack2nix :: Args -> Stack -> IO NExpr
|
|
stack2nix args (Stack resolver compiler pkgs pkgFlags ghcOpts) =
|
|
do let extraDeps = extraDeps2nix pkgs
|
|
flags = flags2nix pkgFlags
|
|
ghcOptions = ghcOptions2nix ghcOpts
|
|
let _f_ = mkSym "f"
|
|
_import_ = mkSym "import"
|
|
_mkForce_ = mkSym "mkForce"
|
|
_isFunction_ = mkSym "isFunction"
|
|
_mapAttrs_ = mkSym "mapAttrs"
|
|
_config_ = mkSym "config"
|
|
packages <- packages2nix args pkgs
|
|
let allPackages = extraDeps <> packages
|
|
allPackageNames = M.fromListWith (+) ((,1 :: Int) . fst <$> allPackages)
|
|
duplicates = filter ((>1) . snd) (M.toList allPackageNames)
|
|
unless (null duplicates) $
|
|
error $ concat ((\(name, _) ->
|
|
"Duplicate definitions for package " <> show name <> "\n") <$> duplicates)
|
|
return . mkNonRecSet $
|
|
[ "extras" $= ("hackage" ==> mkNonRecSet
|
|
([ "packages" $= mkNonRecSet (snd <$> allPackages) ]
|
|
++ [ "compiler.version" $= fromString (quoted ver)
|
|
| (Just c) <- [compiler], let ver = filter (`elem` (".0123456789" :: [Char])) c]
|
|
++ [ "compiler.nix-name" $= fromString (quoted name)
|
|
| (Just c) <- [compiler], let name = filter (`elem` ((['a'..'z']++['0'..'9']) :: [Char])) c]))
|
|
, "resolver" $= fromString (quoted resolver)
|
|
, "modules" $= mkList [
|
|
mkParamset [("lib", Nothing)] True ==> mkNonRecSet [ "packages" $= mkNonRecSet flags ]
|
|
, mkNonRecSet [ "packages" $= mkNonRecSet ghcOptions ]
|
|
-- Mark all packages as planned (stack projects do not have planned/unplanned components).
|
|
, mkParamset [("lib", Nothing)] True ==> mkNonRecSet [ "planned" $= ("lib" @. "mkOverride" @@ mkInt 900 @@ mkBool True) ] ]
|
|
] ++ [
|
|
"compiler" $= fromString (quoted c) | (Just c) <- [compiler]
|
|
]
|
|
-- | Transform simple package index expressions
|
|
-- The idea is to turn
|
|
--
|
|
-- - name-version[@rev:N | @sha256:SHA]
|
|
--
|
|
-- into
|
|
--
|
|
-- { name.revision = hackage.name.version.revisions.default; }
|
|
--
|
|
extraDeps2nix :: [Dependency] -> [(T.Text, Binding NExpr)]
|
|
extraDeps2nix pkgs =
|
|
let extraDeps = [(pkgId, info) | PkgIndex pkgId info <- pkgs]
|
|
in [ (toText pkg, quoted (toText pkg) $= ((((mkSym "hackage" @. toText pkg) @. quoted (toText ver)) @. "revisions") @. "default"))
|
|
| (PackageIdentifier pkg ver, Nothing) <- extraDeps ]
|
|
++ [ (toText pkg, quoted (toText pkg) $= ((((mkSym "hackage" @. toText pkg) @. quoted (toText ver)) @. "revisions") @. quoted (T.pack sha)))
|
|
| (PackageIdentifier pkg ver, (Just (Left sha))) <- extraDeps ]
|
|
++ [ (toText pkg, quoted (toText pkg) $= ((((mkSym "hackage" @. toText pkg) @. quoted (toText ver)) @. "revisions") @. toText revNo))
|
|
| (PackageIdentifier pkg ver, (Just (Right revNo))) <- extraDeps ]
|
|
where parsePackageIdentifier :: String -> Maybe PackageIdentifier
|
|
parsePackageIdentifier = simpleParse
|
|
toText :: Pretty a => a -> T.Text
|
|
toText = fromString . show . pretty
|
|
|
|
-- | Converts 'PackageFlags' into @{ packageName = { flags = { flagA = BOOL; flagB = BOOL; }; }; }@
|
|
flags2nix :: PackageFlags -> [Binding NExpr]
|
|
flags2nix pkgFlags =
|
|
[ quoted pkgName $= mkNonRecSet
|
|
-- `mkOverride 900` is used here so that the default values will be replaced (they are 1000).
|
|
-- Values without a priority are treated as 100 and will replace these ones.
|
|
[ "flags" $= mkNonRecSet [ quoted flag $= ("lib" @. "mkOverride" @@ mkInt 900 @@ mkBool val)
|
|
| (flag, val) <- HM.toList flags
|
|
]
|
|
]
|
|
| (pkgName, flags) <- HM.toList pkgFlags
|
|
]
|
|
|
|
-- | Converts 'GhcOptions' into @{ packageName = { ghcOptions = "..."; }; }@
|
|
ghcOptions2nix :: GhcOptions -> [Binding NExpr]
|
|
ghcOptions2nix ghcOptions =
|
|
[ quoted pkgName $= mkNonRecSet
|
|
[ "ghcOptions" $= mkList [ mkStr opts ] ]
|
|
| (pkgName, opts) <- HM.toList ghcOptions
|
|
]
|
|
|
|
writeDoc :: FilePath -> Doc ann -> IO ()
|
|
writeDoc file doc =
|
|
do handle <- openFile file WriteMode
|
|
hPutDoc handle doc
|
|
hClose handle
|
|
|
|
|
|
-- makeRelativeToCurrentDirectory
|
|
packages2nix :: Args -> [Dependency] -> IO [(T.Text, Binding NExpr)]
|
|
packages2nix args pkgs =
|
|
fmap concat . forM pkgs $ \case
|
|
(LocalPath folder) ->
|
|
do cabalFiles <- findCabalFiles (argHpackUse args) (dropFileName (argStackYaml args) </> folder)
|
|
forM cabalFiles $ \cabalFile ->
|
|
let pkg = cabalFilePkgName cabalFile
|
|
nix = pkg <.> "nix"
|
|
nixFile = argOutputDir args </> nix
|
|
src = Just . C2N.Path $ relPath </> folder
|
|
in do createDirectoryIfMissing True (takeDirectory nixFile)
|
|
writeDoc nixFile =<<
|
|
prettyNix <$> cabal2nix True (argDetailLevel args) src cabalFile
|
|
return (fromString pkg, fromString pkg $= mkPath False nix)
|
|
(DVCS (Git url rev) _ subdirs) ->
|
|
do hits <- forM subdirs $ \subdir -> liftIO $ cacheHits (argCacheFile args) url rev subdir
|
|
let generateBindings =
|
|
fetch (cabalFromPath url rev subdirs)
|
|
(Source url rev UnknownHash) >>= \case
|
|
(Just (DerivationSource{..}, genBindings)) -> genBindings derivHash
|
|
_ -> return []
|
|
if any null hits
|
|
then
|
|
-- If any of the subdirs were missing we need to fetch the files and
|
|
-- generate the bindings.
|
|
generateBindings
|
|
else do
|
|
let allHits = concat hits
|
|
(and <$> forM allHits (\( _, nix ) -> doesFileExist (argOutputDir args </> nix))) >>= \case
|
|
False ->
|
|
-- One or more of the generated binding files are missing
|
|
generateBindings
|
|
True ->
|
|
-- If the subdirs are all in the cache then the bindings should already be
|
|
-- generated too.
|
|
forM allHits $ \( pkg, nix ) ->
|
|
return (fromString pkg, fromString pkg $= mkPath False nix)
|
|
_ -> return []
|
|
where relPath = shortRelativePath (argOutputDir args) (dropFileName (argStackYaml args))
|
|
cabalFromPath
|
|
:: String -- URL
|
|
-> String -- Revision
|
|
-> [FilePath] -- Subdirs
|
|
-> FilePath -- Local Directory
|
|
-> MaybeT IO (String -> IO [(T.Text, Binding NExpr)])
|
|
cabalFromPath url rev subdirs dir = do
|
|
-- Check that all the subdirs exist if not this
|
|
-- fail the MaybeT so that the next fetcher will be tried
|
|
forM_ subdirs $ \subdir -> do
|
|
let path = dir </> subdir
|
|
d <- liftIO $ doesDirectoryExist path
|
|
unless d $ fail ("not a directory: " ++ path)
|
|
-- If we got this far we are confident we have downloaded
|
|
-- with the right fetcher. Return an action that will
|
|
-- be used to generate the bindings.
|
|
return $ \sha256 -> fmap concat . forM subdirs $ \subdir -> do
|
|
let path = dir </> subdir
|
|
cabalFiles <- liftIO $ findCabalFiles (argHpackUse args) path
|
|
forM cabalFiles $ \cabalFile -> do
|
|
let pkg = cabalFilePkgName cabalFile
|
|
nix = pkg <.> "nix"
|
|
nixFile = argOutputDir args </> nix
|
|
subdir' = if subdir == "." then Nothing
|
|
else Just subdir
|
|
src = Just $ C2N.Git url rev (Just sha256) subdir'
|
|
createDirectoryIfMissing True (takeDirectory nixFile)
|
|
writeDoc nixFile =<<
|
|
prettyNix <$> cabal2nix True (argDetailLevel args) src cabalFile
|
|
-- Only update the cache if there is not already a record
|
|
cacheHits (argCacheFile args) url rev subdir >>= \case
|
|
[hit] | hit == (pkg, nix) -> return ()
|
|
_ -> appendCache (argCacheFile args) url rev subdir sha256 pkg nix
|
|
return (fromString pkg, fromString pkg $= mkPath False nix)
|
|
|
|
defaultNixContents :: String
|
|
defaultNixContents = unlines
|
|
[ "{ haskellNixSrc ? builtins.fetchTarball https://github.com/input-output-hk/haskell.nix/archive/master.tar.gz"
|
|
, "}:"
|
|
, ""
|
|
, "let"
|
|
, " haskellNix = import haskellNixSrc { };"
|
|
, " pkgs = import haskellNix.sources.nixpkgs-2003 haskellNix.nixpkgsArgs;"
|
|
, ""
|
|
, " pkgSet = pkgs.haskell-nix.mkStackPkgSet {"
|
|
, " stack-pkgs = import ./pkgs.nix;"
|
|
, " pkg-def-extras = [];"
|
|
, " modules = [];"
|
|
, " };"
|
|
, ""
|
|
, "in"
|
|
, " pkgSet.config.hsPkgs"
|
|
]
|