diff options
Diffstat (limited to 'Biz/Bild.hs')
| -rw-r--r-- | Biz/Bild.hs | 143 |
1 files changed, 93 insertions, 50 deletions
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 <user> 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 |