summaryrefslogtreecommitdiff
path: root/Biz
diff options
context:
space:
mode:
Diffstat (limited to 'Biz')
-rw-r--r--Biz/Bild.hs143
-rw-r--r--Biz/Bild.nix12
-rw-r--r--Biz/Bild/Example.hs5
-rw-r--r--Biz/Test.hs4
4 files changed, 105 insertions, 59 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
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-01 08:24:34 +0000