From 48b7b222491b2799e265cda9a0b8be0d5d8eb3c0 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Mon, 31 Jul 2023 10:15:34 -0400 Subject: Prototype nix expression generation There are some limitations to this implementation: 1. Using `runCommand` means this will re-run any time anything changes in the repo. The solution is to use the existing import detection to make a list of source files, and put that into a `stdenv.mkDerivation`, which I'll do next. 2. The `NeatInterpolation` usage is ugly. The templated nix code should be extracted into its own file, such as `Biz/Bild/Builder.nix`. 3. I'm not actually calling it yet. The ideal thing would be to call `nix-instantiate`, get the output drv path, and then call `nix-store --realise` on that. To do that I need to refactor my `proc` function to return stdout to the calling function, and I should probably just make helper functions like `nixInstatiate :: Target -> IO DrvPath` and `nixStoreRealise :: DrvPath -> NixStorePath`, or something like that. --- Biz/Bild.hs | 143 ++++++++++++++++++++++++++++++++++------------------ Biz/Bild.nix | 12 ++--- Biz/Bild/Example.hs | 5 ++ Biz/Test.hs | 4 +- 4 files changed, 105 insertions(+), 59 deletions(-) create mode 100644 Biz/Bild/Example.hs (limited to 'Biz') diff --git a/Biz/Bild.hs b/Biz/Bild.hs index 34e30e9..b7215d1 100644 --- a/Biz/Bild.hs +++ b/Biz/Bild.hs @@ -109,6 +109,7 @@ import qualified Biz.Cli as Cli import qualified Biz.Log as Log import Biz.Namespace (Namespace (..)) import qualified Biz.Namespace as Namespace +import Biz.Test ((@?=)) import qualified Biz.Test as Test import qualified Conduit import qualified Control.Concurrent.Async as Async @@ -126,6 +127,7 @@ import qualified Data.Set as Set import qualified Data.String as String import qualified Data.Text as Text import qualified Data.Text.IO as Text.IO +import qualified NeatInterpolation import qualified System.Directory as Dir import qualified System.Environment as Env import qualified System.Exit as Exit @@ -153,7 +155,8 @@ main = Cli.main <| Cli.Plan help move test_ pure [Exit.ExitFailure _] -> Test.assertFailure "can't bild bild" _ -> - pure () + pure (), + test_toNixExpr ] move :: Cli.Arguments -> IO () @@ -261,6 +264,46 @@ data Target = Target } deriving (Show, Generic, Aeson.ToJSON) +toNixExpr :: String -> Target -> Text +toNixExpr root (Target {..}) = + [NeatInterpolation.trimming| +with import $troot/Biz/Bild.nix {}; +runCommand "foo" { + buildInputs = [ (private.ghcWith (p: with p; [$nixLangdeps])) ]; +} "$compilerCommand $compilerArgs" +|] + where + troot, compilerCommand, compilerArgs, nixLangdeps :: Text + troot = Text.pack root + compilerCommand = compilerExe compiler + compilerArgs = str <| unwords compilerFlags + nixLangdeps = str <| String.unwords <| Set.toList langdeps + +test_toNixExpr :: Test.Tree +test_toNixExpr = + Test.group + "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"|] + ] + data Builder = -- | Local Local Text @@ -616,53 +659,53 @@ test loud Target {..} = case compiler of >> pure (Exit.ExitFailure 1) build :: Bool -> Bool -> Analysis -> IO [Exit.ExitCode] -build andTest loud analysis = do - root <- Env.getEnv "BIZ_ROOT" - forM (Map.elems analysis) <| \target@Target {..} -> do - case compiler of - Gcc -> - Log.info ["bild", label, "gcc", nschunk namespace] - >> proc loud namespace compiler compilerFlags - where - label = case out of - Meta.Bin _ -> "bin" - _ -> "lib" - Ghc -> case out of - Meta.None -> pure Exit.ExitSuccess - Meta.Bin _ -> do - Log.info ["bild", "dev", "ghc-exe", nschunk namespace] - exitcode <- proc loud namespace compiler compilerFlags - if andTest && isSuccess exitcode - then test loud target - else pure exitcode - Meta.Lib _ -> do - Log.info ["bild", "dev", "ghc-lib", nschunk namespace] - proc loud namespace compiler compilerFlags - Guile -> do - Log.info ["bild", "dev", "guile", nschunk namespace] - _ <- proc loud namespace compiler compilerFlags - case wrapper of - Nothing -> pure Exit.ExitSuccess - Just content -> do - writeFile (root outToPath out) content - p <- Dir.getPermissions <| root outToPath out - Dir.setPermissions (root outToPath out) (Dir.setOwnerExecutable True p) - pure Exit.ExitSuccess - NixBuild -> do - Log.info ["bild", "nix", toLog builder, nschunk namespace] - proc loud namespace compiler compilerFlags - where - toLog (Local u) = u - toLog (Remote u h) = u <> "@" <> h - Copy -> do - Log.warn ["bild", "copy", "not implemented yet", nschunk namespace] - pure Exit.ExitSuccess - Rustc -> do - Log.info ["bild", "dev", "rust", nschunk namespace] - proc loud namespace compiler compilerFlags - Sbcl -> do - Log.info ["bild", "dev", "lisp", nschunk namespace] - proc loud namespace compiler compilerFlags +build andTest loud analysis = + Env.getEnv "BIZ_ROOT" +> \root -> + forM (Map.elems analysis) <| \target@Target {..} -> do + case compiler of + Gcc -> + Log.info ["bild", label, "gcc", nschunk namespace] + >> proc loud namespace (toNixFlag compiler) compilerFlags + where + label = case out of + Meta.Bin _ -> "bin" + _ -> "lib" + Ghc -> case out of + Meta.None -> pure Exit.ExitSuccess + Meta.Bin _ -> do + Log.info ["bild", "dev", "ghc-exe", nschunk namespace] + exitcode <- proc loud namespace (toNixFlag compiler) compilerFlags + if andTest && isSuccess exitcode + then test loud target + else pure exitcode + Meta.Lib _ -> do + Log.info ["bild", "dev", "ghc-lib", nschunk namespace] + proc loud namespace (toNixFlag compiler) compilerFlags + Guile -> do + Log.info ["bild", "dev", "guile", nschunk namespace] + _ <- proc loud namespace (toNixFlag compiler) compilerFlags + case wrapper of + Nothing -> pure Exit.ExitSuccess + Just content -> do + writeFile (root outToPath out) content + p <- Dir.getPermissions <| root outToPath out + Dir.setPermissions (root outToPath out) (Dir.setOwnerExecutable True p) + pure Exit.ExitSuccess + NixBuild -> do + Log.info ["bild", "nix", toLog builder, nschunk namespace] + proc loud namespace (toNixFlag compiler) compilerFlags + where + toLog (Local u) = u + toLog (Remote u h) = u <> "@" <> h + Copy -> do + Log.warn ["bild", "copy", "not implemented yet", nschunk namespace] + pure Exit.ExitSuccess + Rustc -> do + Log.info ["bild", "dev", "rust", nschunk namespace] + proc loud namespace (toNixFlag compiler) compilerFlags + Sbcl -> do + Log.info ["bild", "dev", "lisp", nschunk namespace] + proc loud namespace (toNixFlag compiler) compilerFlags data Proc = Proc { loud :: Bool, @@ -689,13 +732,13 @@ run Proc {..} = Exit.ExitSuccess -> onSuccess >> pure Exit.ExitSuccess -- | Helper for running a standard bild subprocess. -proc :: ToNixFlag a => Bool -> Namespace -> a -> [Text] -> IO Exit.ExitCode +proc :: Bool -> Namespace -> String -> [Text] -> IO Exit.ExitCode proc loud namespace cmd args = run <| Proc { loud = loud, ns = namespace, - cmd = toNixFlag cmd, + cmd = cmd, args = map Text.unpack args, onFailure = Log.fail ["bild", nschunk namespace] >> Log.br, onSuccess = Log.good ["bild", nschunk namespace] >> Log.br diff --git a/Biz/Bild.nix b/Biz/Bild.nix index a51a3d0..2a049b0 100644 --- a/Biz/Bild.nix +++ b/Biz/Bild.nix @@ -36,7 +36,7 @@ rec { }; # generally-useful things from nixpkgs - inherit (nixpkgs) lib stdenv sources; + inherit (nixpkgs) lib stdenv sources runCommand; # expose some packages for inclusion in os/image builds pkgs = with nixpkgs.pkgs; [ git ]; @@ -45,14 +45,12 @@ rec { bildRuntimeDeps = with nixpkgs; [ pkg-config gnutls - guile - SDL private.ghcPackageSetBild rustc - gcc - gdb - valgrind - argp-standalone + # c deps + gcc gdb valgrind argp-standalone SDL + # lisp deps + guile (private.sbclWith (p: with p; [asdf alexandria])) # just enough to build Example.lisp ]; diff --git a/Biz/Bild/Example.hs b/Biz/Bild/Example.hs new file mode 100644 index 0000000..f812707 --- /dev/null +++ b/Biz/Bild/Example.hs @@ -0,0 +1,5 @@ +-- : out example +module Biz.Bild.Example where + +main :: IO () +main = print "hi" diff --git a/Biz/Test.hs b/Biz/Test.hs index b6c2816..0a2cf2f 100644 --- a/Biz/Test.hs +++ b/Biz/Test.hs @@ -87,13 +87,13 @@ expected @?!= actual = assertNotEqual "" expected actual infixl 2 @?!= --- | +-- | expectedVal @=? actualVal (@=?) :: (Eq a, Show a) => a -> a -> HUnit.Assertion a @=? b = a HUnit.@=? b infixl 2 @=? --- | +-- | actualVal @?= expectedVal (@?=) :: (Eq a, Show a) => a -> a -> HUnit.Assertion a @?= b = a HUnit.@?= b -- cgit v1.2.3