From 4cb9f2fbfbb124b38f19c72059620f25b71f92b7 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Mon, 31 Jul 2023 21:51:15 -0400 Subject: Implement nix builds for Haskell This is prototype quality. For some reason I think it breaks when doing `build **/*.hs`, which isn't good. But also it's working, and the code feels good. Next I'd like to get Python builds working, as hopefully that will force me to improve the existing code to support a second language. --- Biz/Bild.hs | 150 +++++++++++++++++++++++++++++++++++++++++-------------- Biz/Bild.nix | 7 +-- Biz/Bild/Meta.hs | 8 +++ 3 files changed, 124 insertions(+), 41 deletions(-) diff --git a/Biz/Bild.hs b/Biz/Bild.hs index 0747cf5..96203a4 100644 --- a/Biz/Bild.hs +++ b/Biz/Bild.hs @@ -155,8 +155,8 @@ main = Cli.main <| Cli.Plan help move test_ pure [Exit.ExitFailure _] -> Test.assertFailure "can't bild bild" _ -> - pure (), - test_toNixExpr + pure () + -- test_toNixExpr ] move :: Cli.Arguments -> IO () @@ -270,16 +270,50 @@ toNixExpr :: String -> Target -> Text toNixExpr root (Target {..}) = [NeatInterpolation.trimming| with import $troot/Biz/Bild.nix {}; -runCommand "foo" { +with builtins; +let + skip = ["_" ".direnv"]; + filter = name: type: + if elem (baseNameOf name) skip then false + # TODO: this means any new directory will cause a rebuild. this bad. + # i should recurse into the directory and match against the srcFiles + else if type == "directory" then true + else if type == "regular" then builtins.elem name [$srcFiles] + else false; +in stdenv.mkDerivation { + name = "$outname_"; + src = lib.sources.cleanSourceWith {inherit filter; src = lib.sources.cleanSource ./.;}; buildInputs = [ (private.ghcWith (p: with p; [$nixLangdeps])) ]; -} "$compilerCommand $compilerArgs" -|] + buildPhase = "$compilerCommand $compilerArgs"; + installPhase = "mkdir -p $$out/bin && cp $outname_ $$out/bin"; +}|] where - troot, compilerCommand, compilerArgs, nixLangdeps :: Text + troot, compilerCommand, compilerArgs, nixLangdeps, outname_, srcFiles :: Text troot = Text.pack root compilerCommand = compilerExe compiler compilerArgs = str <| unwords compilerFlags nixLangdeps = str <| String.unwords <| Set.toList langdeps + outname_ = str <| outname out + srcFiles = + ((root path) : Set.toList srcs) + |> map (\p -> "\"" <> p <> "\"\n") + |> String.unwords + |> str + +-- | Use this to just get a target to play with at the repl. +dev_getTarget :: IO Target +dev_getTarget = do + root <- Env.getEnv "BIZ_ROOT" + path <- Dir.makeAbsolute "Biz/Bild.hs" + Namespace.fromPath root path + |> \case + Nothing -> panic "Could not get namespace from path" + Just ns -> + analyze mempty ns + /> Map.lookup ns + /> \case + Nothing -> panic "Could not retrieve target from analysis" + Just t -> t test_toNixExpr :: Test.Tree test_toNixExpr = @@ -287,23 +321,8 @@ test_toNixExpr = "toNixExpr" [ Test.unit "produces corect result" <| do root <- Env.getEnv "BIZ_ROOT" - path <- Dir.makeAbsolute "Biz/Bild/Example.hs" - Namespace.fromPath root path - |> \case - Nothing -> panic "Could not get namespace from path" - Just ns -> - analyze mempty ns - /> Map.lookup ns - +> \case - Nothing -> panic "Could not retrieve target from analysis" - Just t -> toNixExpr root t @?= actual - where - troot = Text.pack root - actual = - [NeatInterpolation.trimming|with import $troot/Biz/Bild.nix {}; - runCommand "foo" { - buildInputs = [ (private.ghcWith (p: with p; [])) ]; - } "ghc -Werror -i$troot -odir $troot/_/int -hidir $troot/_/int --make $troot/Biz/Bild/Example.hs -main-is Biz.Bild.Example -o /home/ben/biz/_/bin/example"|] + t <- dev_getTarget + toNixExpr root t @?= [NeatInterpolation.trimming|TODO|] ] data Builder @@ -366,7 +385,14 @@ outToPath = \case Meta.Lib o -> cab "lib" o Meta.None -> mempty -intdir, nixdir, vardir :: FilePath +outname :: Meta.Out -> FilePath +outname = \case + Meta.Bin o -> o + Meta.Lib o -> o + Meta.None -> mempty + +bindir, intdir, nixdir, vardir :: FilePath +bindir = cab "bin" intdir = cab "int" nixdir = cab "nix" vardir = cab "var" @@ -471,22 +497,22 @@ analyze hmap ns = case Map.lookup ns hmap of compiler = Ghc, compilerFlags = [ "-Werror", - "-i" <> root, + "-i$src", "-odir", - root intdir, + ".", "-hidir", - root intdir, + ".", "--make", - absPath + "$src" path ] - ++ (out /= Meta.None) - ?: ( [ "-main-is", - Namespace.toHaskellModule namespace, - "-o", - root outToPath out - ], - [] - ) + ++ case out of + Meta.Bin o -> + [ "-main-is", + Namespace.toHaskellModule namespace, + "-o", + o + ] + _ -> [] |> map Text.pack, sysdeps = Meta.detect (Meta.sys "--") contentLines, outPath = outToPath out, @@ -690,8 +716,8 @@ build andTest loud analysis = Ghc -> case out of Meta.None -> pure (Exit.ExitSuccess, mempty) Meta.Bin _ -> do - Log.info ["bild", "dev", "ghc-exe", nschunk namespace] - result <- proc loud namespace (toNixFlag compiler) compilerFlags + Log.info ["bild", "nixBuild", "ghc", nschunk namespace] + result <- nixBuild loud target if andTest && (isSuccess <| fst result) then test loud target else pure result @@ -820,3 +846,51 @@ lispRequires = where isQuote :: Char -> Bool isQuote c = c `elem` ['\'', ':'] + +nixBuild :: Bool -> Target -> IO (Exit.ExitCode, ByteString) +nixBuild loud target@(Target {..}) = + Env.getEnv "BIZ_ROOT" +> \root -> + instantiate root |> run +> \case + (Exit.ExitSuccess, drv) -> + drv + |> str + |> chomp + |> str + |> realise + |> run + >> run symlink + x -> pure x + where + instantiate root = + Proc + { loud = loud, + ns = namespace, + cmd = "nix-instantiate", + args = map Text.unpack ["--expr", toNixExpr root target], + onFailure = Log.fail ["bild", "instantiate", nschunk namespace] >> Log.br, + onSuccess = pure () + } + realise drv = + Proc + { loud = loud, + ns = namespace, + cmd = "nix-store", + args = ["--realise", drv, "--add-root", nixdir outname out], + onFailure = Log.fail ["bild", "realise", nschunk namespace] >> Log.br, + onSuccess = Log.good ["bild", nschunk namespace] >> Log.br + } + symlink = + Proc + { loud = loud, + ns = namespace, + cmd = "ln", + args = + [ "--relative", + "--force", + "--symbolic", + nixdir outname out "bin" outname out, + bindir outname out + ], + onFailure = Log.fail ["bild", "symlink", nschunk namespace] >> Log.br, + onSuccess = pure () + } diff --git a/Biz/Bild.nix b/Biz/Bild.nix index 2a049b0..34d8174 100644 --- a/Biz/Bild.nix +++ b/Biz/Bild.nix @@ -30,13 +30,14 @@ rec { ghcPackageSetBild = private.ghcWith (hpkgs: with hpkgs; [ aeson async base bytestring conduit conduit-extra containers directory docopt filepath process protolude rainbow regex-applicative split tasty - tasty-hunit tasty-quickcheck text + tasty-hunit tasty-quickcheck text neat-interpolation wai # can remove when removed from Biz.Log ]); + ghcPackageSetMin = private.ghcWith (hpkgs: with hpkgs; []); }; # generally-useful things from nixpkgs - inherit (nixpkgs) lib stdenv sources runCommand; + inherit (nixpkgs) lib stdenv sources; # expose some packages for inclusion in os/image builds pkgs = with nixpkgs.pkgs; [ git ]; @@ -44,8 +45,8 @@ rec { # remove this when I switch to all-nix builds bildRuntimeDeps = with nixpkgs; [ pkg-config + private.ghcPackageSetMin gnutls - private.ghcPackageSetBild rustc # c deps gcc gdb valgrind argp-standalone SDL diff --git a/Biz/Bild/Meta.hs b/Biz/Bild/Meta.hs index 75242a5..5549cb3 100644 --- a/Biz/Bild/Meta.hs +++ b/Biz/Bild/Meta.hs @@ -12,10 +12,18 @@ import qualified Data.Set as Set import qualified Data.Text as Text import qualified Text.Regex.Applicative as Regex +-- | A third-party dependency. This gets mapped to some name in nixpkgs, +-- prefixed by package set like @haskellPackages@ or +-- @python3Packages@. Currently this prefix is implicit, but it should be added +-- here as part of a tuple or something. type Dep = String +-- | This is a system-level requirement, the string gets mapped to a name in +-- nixpkgs at the top level, like @pkgs.thing@. If I add the package set prefix to 'Dep', then this can just become literally @(Sys, "thing")@. type Sys = String +-- | An arbitrary compiler argument that may get added to the compilation +-- command. Should be used sparingly, and not all builds will support this. type Arg = String data Out = Lib String | Bin String | None -- cgit v1.2.3