diff options
Diffstat (limited to 'Biz/Bild.hs')
| -rw-r--r-- | Biz/Bild.hs | 119 |
1 files changed, 62 insertions, 57 deletions
diff --git a/Biz/Bild.hs b/Biz/Bild.hs index 2db5ccc..9c4f035 100644 --- a/Biz/Bild.hs +++ b/Biz/Bild.hs @@ -133,6 +133,7 @@ import qualified Data.Char as Char import Data.Conduit ((.|)) import qualified Data.Conduit.Combinators as Conduit import qualified Data.Conduit.Process as Conduit +import qualified Data.List as List import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.String as String @@ -271,6 +272,10 @@ instance Aeson.ToJSON Compiler where instance ToNixFlag Compiler where toNixFlag = compilerExe +-- | Type alias for making sure that the path is qualified, meaning it starts at +-- the root of the repo, and is not an absolute path nor a subpath +type QualifiedPath = FilePath + data Target = Target { -- | Output name out :: Meta.Out, @@ -278,8 +283,10 @@ data Target = Target outPath :: FilePath, -- | Fully qualified namespace partitioned by '.' namespace :: Namespace, - -- | Absolute path to file - path :: FilePath, + -- | Path to file, qualified based on the root of the git directory + quapath :: QualifiedPath, + -- | Main module name, formatted as the language expects + mainModule :: String, -- | Name of the packageset in Bild.nix to pull langdeps from packageSet :: Text, -- | Language-specific dependencies, required during compilation @@ -291,8 +298,12 @@ data Target = Target sysdeps :: Set Meta.Dep, -- | Which compiler should we use? compiler :: Compiler, - -- | Where is this machine being built? - builder :: Builder, + -- | Which nix build expression? + builder :: Text, + -- | Who is building this? + user :: Text, + -- | Where are they buildint it? + host :: Text, -- | Flags and arguments passed to 'Compiler' when building compilerFlags :: [Text], -- | Wrapper script (if necessary) @@ -419,12 +430,13 @@ analyze hmap ns = case Map.lookup ns hmap of analyzeOne namespace@(Namespace _ ext) = do let path = Namespace.toPath namespace root <- Env.getEnv "BIZ_ROOT" - let absPath = root </> path + let abspath = root </> path + let quapath = path user <- Env.getEnv "USER" /> Text.pack host <- HostName.getHostName /> Text.pack Log.info ["bild", "analyze", str path] contentLines <- - withFile absPath ReadMode <| \h -> + withFile abspath ReadMode <| \h -> IO.hSetEncoding h IO.utf8_bom >> Text.IO.hGetContents h /> Text.lines @@ -438,7 +450,7 @@ analyze hmap ns = case Map.lookup ns hmap of Namespace.Py -> Meta.detectAll "#" contentLines |> \Meta.Parsed {..} -> Target - { builder = Local user host, + { builder = "python", wrapper = Nothing, compiler = CPython, compilerFlags = @@ -447,17 +459,19 @@ analyze hmap ns = case Map.lookup ns hmap of [ "-c", "\"import py_compile;import os;" <> "py_compile.compile(file='" - <> str path + <> str quapath <> "', cfile=os.getenv('BIZ_ROOT')+'/_/int/" - <> str path + <> str quapath <> "', doraise=True)\"" ], sysdeps = psys, langdeps = pdep, outPath = outToPath pout, out = pout, - srcs = Set.singleton path, - packageSet = "pythonPackages", + -- implement detectPythonImports, then I can fill this out + srcs = Set.empty, + packageSet = "python.packages", + mainModule = Namespace.toModule namespace, .. } |> Just @@ -470,15 +484,17 @@ analyze hmap ns = case Map.lookup ns hmap of sysdeps = psys, wrapper = Nothing, compiler = Gcc, - builder = Local user host, + builder = "c", out = pout, - packageSet = "cPackages", + packageSet = "c.packages", + mainModule = Namespace.toModule namespace, compilerFlags = case pout of Meta.Bin o -> ["-o", o, path] <> Set.toList parg |> map Text.pack _ -> panic "can only bild C exes, not libs", outPath = outToPath pout, - srcs = Set.singleton absPath, + -- implement detectCImports, then I can fill this out + srcs = Set.empty, .. } |> Just @@ -489,10 +505,11 @@ analyze hmap ns = case Map.lookup ns hmap of |> \out -> detectHaskellImports hmap contentLines +> \(langdeps, srcs) -> Target - { builder = Local user host, + { builder = "haskell", wrapper = Nothing, compiler = Ghc, - packageSet = "ghcPackages", + packageSet = "haskell.packages", + mainModule = Namespace.toModule namespace, compilerFlags = [ "-Werror", "-threaded", @@ -502,7 +519,7 @@ analyze hmap ns = case Map.lookup ns hmap of "-hidir", ".", "--make", - "$BIZ_ROOT" </> path + "$BIZ_ROOT" </> quapath ] ++ case out of Meta.Bin o -> @@ -528,20 +545,22 @@ analyze hmap ns = case Map.lookup ns hmap of { sysdeps = Set.empty, wrapper = Nothing, compiler = Sbcl, - packageSet = "sbclWith", + packageSet = "lisp.sbclWith", + mainModule = Namespace.toModule namespace, compilerFlags = map Text.pack [ "--eval", "(require :asdf)", "--load", - absPath, + quapath, "--eval", "(sb-ext:save-lisp-and-die #p\"" <> (root </> outToPath out) <> "\" :toplevel #'main :executable t)" ], - builder = Local user host, + builder = "base", outPath = outToPath out, - srcs = Set.singleton absPath, + -- add local src imports to detectLispImports, then i can fill this out + srcs = Set.empty, .. } Namespace.Nix -> @@ -552,7 +571,7 @@ analyze hmap ns = case Map.lookup ns hmap of sysdeps = Set.empty, compiler = NixBuild, compilerFlags = - [ absPath, + [ quapath, "--out-link", root </> nixdir </> Namespace.toPath namespace, "--builders", @@ -561,8 +580,10 @@ analyze hmap ns = case Map.lookup ns hmap of |> map Text.pack, out = Meta.None, outPath = outToPath Meta.None, - srcs = Set.singleton absPath, + srcs = Set.empty, packageSet = "", + mainModule = Namespace.toModule namespace, + builder = "base", .. } |> Just @@ -573,19 +594,20 @@ analyze hmap ns = case Map.lookup ns hmap of { langdeps = pdep, sysdeps = psys, compiler = Guile, - packageSet = "guilePackages", + packageSet = "scheme.guilePackages", + mainModule = Namespace.toModule namespace, compilerFlags = [ "compile", "--r7rs", "--load-path=" ++ root, - "--output=" ++ root </> intdir </> replaceExtension path ".scm.go", - absPath + "--output=" ++ root </> intdir </> replaceExtension quapath ".scm.go", + quapath ] |> map Text.pack, - builder = Local user host, + builder = "base", outPath = outToPath pout, out = pout, - srcs = Set.singleton absPath, + srcs = Set.empty, -- implement detectSchemeImports -- TODO: wrapper should just be removed, instead rely on -- upstream nixpkgs builders to make wrappers wrapper = @@ -615,7 +637,8 @@ analyze hmap ns = case Map.lookup ns hmap of -- this packageSet doesn't actually exist because everyone in -- nix just generates nix expressions for rust dependencies with -- Cargo.lock, so I have to make it in order to use rust deps - packageSet = "rustPackages", + packageSet = "rust.packages", + mainModule = Namespace.toModule namespace, wrapper = Nothing, sysdeps = psys <> Set.singleton "rustc", out = pout, @@ -629,9 +652,10 @@ analyze hmap ns = case Map.lookup ns hmap of o ] _ -> panic "can't build rust libs", - builder = Local user host, + builder = "base", outPath = outToPath pout, - srcs = Set.singleton absPath, + -- implement detectRustImports + srcs = Set.empty, .. } |> Just @@ -651,9 +675,11 @@ detectHaskellImports hmap contentLines = +> \files -> findDeps root files +> \deps -> - (pkgs <> deps, Set.fromList files) + (pkgs <> deps, map (stripRoot root) files |> Set.fromList) |> pure where + stripRoot :: FilePath -> FilePath -> QualifiedPath + stripRoot root f = fromMaybe f (List.stripPrefix (root <> "/") f) filepaths :: [String] -> IO [FilePath] filepaths imports = imports @@ -742,7 +768,7 @@ build andTest loud analysis = Ghc -> case out of Meta.None -> pure (Exit.ExitSuccess, mempty) Meta.Bin _ -> do - Log.info ["bild", "nix", toLog builder, nschunk namespace] + Log.info ["bild", "nix", user <> "@" <> host, nschunk namespace] result <- nixBuild loud target if andTest && (isSuccess <| fst result) then test loud target @@ -761,7 +787,7 @@ build andTest loud analysis = Dir.setPermissions (root </> outToPath out) (Dir.setOwnerExecutable True p) pure (Exit.ExitSuccess, mempty) NixBuild -> do - Log.info ["bild", "nix", toLog builder, nschunk namespace] + Log.info ["bild", "nix", user <> "@" <> host, nschunk namespace] proc loud namespace (toNixFlag compiler) compilerFlags Copy -> do Log.warn ["bild", "copy", "not implemented yet", nschunk namespace] @@ -773,11 +799,6 @@ build andTest loud analysis = Log.info ["bild", "dev", "lisp", nschunk namespace] proc loud namespace (toNixFlag compiler) compilerFlags --- | Format for logging -toLog :: Builder -> Text -toLog (Local u h) = "local://" <> u <> "@" <> h -toLog (Remote u h) = "remote://" <> u <> "@" <> h - data Proc = Proc { loud :: Bool, cmd :: String, @@ -884,7 +905,7 @@ lispRequires = isQuote c = c `elem` ['\'', ':'] nixBuild :: Bool -> Target -> IO (Exit.ExitCode, ByteString) -nixBuild loud Target {..} = +nixBuild loud target@(Target {..}) = Env.getEnv "BIZ_ROOT" +> \root -> instantiate root |> run +> \case (_, "") -> panic "instantiate did not produce a drv" @@ -909,15 +930,7 @@ 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 <| Set.toList srcs <> [root </> path], - argstr "main" <| str <| Namespace.toModule namespace, - argstr "root" <| str root, - argstr "packageSet" packageSet, - (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 "compileLine" <| unwords <| (Text.pack <| toNixFlag compiler) : compilerFlags, - ["--attr", selectBuilder namespace], + [ argstr "analysisJSON" <| str <| Aeson.encode <| (Map.singleton namespace target :: Analysis), [str <| root </> "Biz/Bild/Builder.nix"] ] |> mconcat @@ -949,11 +962,3 @@ nixBuild loud Target {..} = onFailure = Log.fail ["bild", "symlink", nschunk namespace] >> Log.br, onSuccess = pure () } - -selectBuilder :: Namespace -> Text -selectBuilder = \case - Namespace _ Namespace.Hs -> "haskell" - Namespace _ Namespace.Py -> "python" - Namespace _ Namespace.Rs -> "base" - Namespace _ Namespace.C -> "c" - Namespace _ ext -> panic <| "no builder for " <> show ext |