diff options
Diffstat (limited to 'Biz/Bild.hs')
| -rw-r--r-- | Biz/Bild.hs | 103 |
1 files changed, 82 insertions, 21 deletions
diff --git a/Biz/Bild.hs b/Biz/Bild.hs index 7bfa788..19c8827 100644 --- a/Biz/Bild.hs +++ b/Biz/Bild.hs @@ -120,6 +120,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 @@ -152,21 +153,41 @@ main = Cli.main <| Cli.Plan help move test_ pure test_ = Test.group "Biz.Bild" - [ Test.unit "can bild bild" <| do - root <- Env.getEnv "BIZ_ROOT" - path <- Dir.makeAbsolute "Biz/Bild.hs" - case Namespace.fromPath root path of - Nothing -> Test.assertFailure "can't find ns for bild" - Just ns -> - analyze mempty ns - +> build False False - +> \case - [Exit.ExitFailure _] -> - Test.assertFailure "can't bild bild" - _ -> - pure () + [ test_bildBild, + test_bildExamples ] +test_bildBild :: Test.Tree +test_bildBild = + Test.unit "can bild bild" <| do + root <- Env.getEnv "BIZ_ROOT" + path <- Dir.makeAbsolute "Biz/Bild.hs" + case Namespace.fromPath root path of + Nothing -> Test.assertFailure "can't find ns for bild" + Just ns -> + analyze mempty ns + +> build False False + +> \case + [Exit.ExitFailure _] -> + Test.assertFailure "can't bild bild" + _ -> + pure () + +test_bildExamples :: Test.Tree +test_bildExamples = + Test.unit "can bild examples" <| do + Env.getEnv "BIZ_ROOT" +> \root -> + ["c", "hs", "lisp", "rs"] + |> map ("Biz/Bild/Example." <>) + |> traverse Dir.makeAbsolute + /> map (Namespace.fromPath root) + /> catMaybes + +> foldM analyze mempty + +> build False False + +> \case + [] -> Test.assertFailure "asdf" + xs -> all (== Exit.ExitSuccess) xs @=? True + move :: Cli.Arguments -> IO () move args = do root <- Env.getEnv "BIZ_ROOT" @@ -223,6 +244,7 @@ exitSummary exits = data Compiler = Copy + | CPython | Gcc | Ghc | Guile @@ -234,6 +256,7 @@ data Compiler compilerExe :: IsString a => Compiler -> a compilerExe = \case Copy -> "cp" + CPython -> "python" Gcc -> "gcc" Ghc -> "ghc" Guile -> "guild" @@ -321,7 +344,7 @@ isBuildableNs = \case (Namespace _ Namespace.Lisp) -> True (Namespace _ Namespace.Md) -> False (Namespace _ Namespace.None) -> False - (Namespace _ Namespace.Py) -> False + (Namespace _ Namespace.Py) -> True (Namespace _ Namespace.Sh) -> False (Namespace _ Namespace.Scm) -> True (Namespace _ Namespace.Rs) -> True @@ -412,7 +435,33 @@ analyze hmap ns = case Map.lookup ns hmap of Namespace.Keys -> pure Nothing Namespace.Md -> pure Nothing Namespace.None -> pure Nothing - Namespace.Py -> pure Nothing + Namespace.Py -> + Meta.detectAll "#" contentLines |> \Meta.Parsed {..} -> + Target + { builder = Local user host, + wrapper = Nothing, + compiler = CPython, + compilerFlags = + -- This doesn't really make sense for python, but I'll leave + -- it here for eventual --dev builds + [ "-c", + "\"import py_compile;import os;" + <> "py_compile.compile(file='" + <> str path + <> "', cfile=os.getenv('BIZ_ROOT')+'/_/int/" + <> str path + <> "', doraise=True)\"" + ], + sysdeps = psys, + langdeps = pdep, + outPath = outToPath pout, + out = pout, + srcs = Set.singleton path, + packageSet = "pythonWith", + .. + } + |> Just + |> pure Namespace.Sh -> pure Nothing Namespace.C -> Meta.detectAll "//" contentLines |> \Meta.Parsed {..} -> do @@ -557,6 +606,8 @@ analyze hmap ns = case Map.lookup ns hmap of outPath = outToPath pout, out = pout, srcs = Set.singleton absPath, + -- TODO: wrapper should just be removed, instead rely on + -- upstream nixpkgs builders to make wrappers wrapper = (pout == Meta.None) ?: ( Nothing, @@ -685,6 +736,9 @@ build andTest loud analysis = Env.getEnv "BIZ_ROOT" +> \root -> forM (Map.elems analysis) <| \target@Target {..} -> fst </ case compiler of + CPython -> + Log.info ["bild", "nix", "python", nschunk namespace] + >> nixBuild loud target Gcc -> Log.info ["bild", label, "gcc", nschunk namespace] >> proc loud namespace (toNixFlag compiler) compilerFlags @@ -812,7 +866,7 @@ isModuleChar :: Char -> Bool isModuleChar c = elem c <| concat [['A' .. 'Z'], ['a' .. 'z'], ['.', '_'], ['0' .. '9']] --- Matches on `(require :package)` forms and returns `package`. The `require` +-- | Matches on `(require :package)` forms and returns `package`. The `require` -- function is technically deprecated in Common Lisp, but no new spec has been -- published with a replacement, and I don't wanna use asdf, so this is what we -- use for Lisp imports. @@ -852,14 +906,15 @@ nixBuild loud Target {..} = -- is tightly coupled with the code in the nix builder and there's no -- way around that, methinks. args = - [ argstr "srcs" <| unwords <| map str <| (root </> path) : Set.toList srcs, + [ argstr "srcs" <| unwords <| map str <| Set.toList srcs <> [root </> path], + argstr "main" <| str <| Namespace.toModule namespace, argstr "root" <| str root, argstr "packageSet" packageSet, - (argstr "langDeps" <| unwords <| map str <| Set.toList langdeps) <|> mempty, + (langdeps == mempty) ?: (mempty, argstr "langdeps" <| unwords <| map str <| Set.toList langdeps), + (sysdeps == mempty) ?: (mempty, argstr "sysdeps" <| unwords <| map str <| Set.toList sysdeps), argstr "name" <| str <| outname out, - argstr "buildPhase" <| unwords - <| (Text.pack <| toNixFlag compiler) : - compilerFlags, + argstr "compileLine" <| unwords <| (Text.pack <| toNixFlag compiler) : compilerFlags, + ["--attr", selectBuilder namespace], [str <| root </> "Biz/Bild/Builder.nix"] ] |> mconcat @@ -891,3 +946,9 @@ nixBuild loud Target {..} = onFailure = Log.fail ["bild", "symlink", nschunk namespace] >> Log.br, onSuccess = pure () } + +selectBuilder :: Namespace -> Text +selectBuilder = \case + Namespace _ Namespace.Hs -> "base" + Namespace _ Namespace.Py -> "python" + _ -> panic "no builder for this namespace" |