From 9da4feb106126940264dd27925ea3c19b04aac20 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Wed, 30 Dec 2020 12:24:47 -0500 Subject: bild: build everyting Now bild knows how to determine between modules that require ghcjs and ghc. It also knows what *not* to build, meaning it won't try to build non-buildable nix targets, for example (unfortunately this is just hardcoded for now), but it also won't build scm or py targets that I haven't implemented yet. It just silently fails, which is fine, because it means I can do `bild **/*` and everything just works. Of course, if I want to build scm code then I will have to implement that, but that's not a priority right now. --- Biz/Bild.hs | 141 +++++++++++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 115 insertions(+), 26 deletions(-) (limited to 'Biz/Bild.hs') diff --git a/Biz/Bild.hs b/Biz/Bild.hs index 23086a7..96f63ad 100644 --- a/Biz/Bild.hs +++ b/Biz/Bild.hs @@ -6,12 +6,9 @@ -- | A general purpose build tool. -- --- Not all of the below design is implemented. Currently: --- --- - with a nix build, results are linked in _/bild/nix/ --- - with a dev build, results are stored in _/bild/dev/ --- --- ----------------------------------------------------------------------------- +-- : out bild +-- : dep docopt +-- : dep regex-applicative -- -- == Design constraints -- @@ -119,7 +116,7 @@ module Biz.Bild where import Alpha hiding (sym, (<.>)) -import Biz.Namespace (Namespace) +import Biz.Namespace (Namespace (..)) import qualified Biz.Namespace as Namespace import qualified Data.Char as Char import qualified Data.List as List @@ -137,8 +134,11 @@ main :: IO () main = Env.getArgs >>= Docopt.parseArgsOrExit help >>= run where run args = - Docopt.getAllArgs args (Docopt.argument "target") - |> mapM_ (\target -> analyze target >>= build) + mapM getNamespace (Docopt.getAllArgs args (Docopt.argument "target")) + /> catMaybes + /> filter isBuildableNs + >>= mapM analyze + >>= mapM_ build help :: Docopt.Docopt help = @@ -156,7 +156,14 @@ type Dep = String type Out = String -data Compiler = Ghc | Ghcjs | Guile | NixBuild +data Compiler + = GhcLib + | GhcExe + | GhcjsLib + | GhcjsExe + | Guile + | NixBuild + | Copy deriving (Show) data Target = Target @@ -175,20 +182,42 @@ data Target = Target } deriving (Show) -analyze :: String -> IO Target -analyze s = do - user <- Env.getEnv "USER" +isBuildableNs :: Namespace -> Bool +isBuildableNs (Namespace _ Namespace.Hs) = True +isBuildableNs ns + | ns `elem` nixTargets = True + | otherwise = False + +nixTargets :: [Namespace] +nixTargets = + [ Namespace ["Biz", "Pie"] Namespace.Nix, + Namespace ["Biz", "Que", "Prod"] Namespace.Nix, + Namespace ["Biz", "Cloud"] Namespace.Nix, + Namespace ["Biz", "Dev"] Namespace.Nix, + Namespace ["Hero", "Prod"] Namespace.Nix + ] + +getNamespace :: String -> IO (Maybe Namespace) +getNamespace s = do root <- Env.getEnv "BIZ_ROOT" - host <- chomp s - let namespace@(Namespace.Namespace _ ext) = - require "namespace" <| Namespace.fromPath root path + return <| Namespace.fromPath root <| cwd s + +analyze :: Namespace -> IO Target +analyze namespace@(Namespace.Namespace _ ext) = do + user <- Env.getEnv "USER" + host <- chomp do content <- String.lines Regex.match metaOut |> catMaybes |> head |> require "out" - let compiler = if ".js" `List.isSuffixOf` out then Ghcjs else Ghc + let out = + content + /> Regex.match metaOut + |> catMaybes + |> head + |> fromMaybe mempty + let compiler = detectGhcCompiler out <| String.unlines content return Target { deps = content /> Regex.match metaDep |> catMaybes, @@ -223,13 +252,41 @@ analyze s = do builder = user <> "@localhost", .. } + _ -> + return + Target + { deps = [], + compiler = Copy, + out = "", + builder = user <> "@localhost", + .. + } + +-- | Some rules for detecting the how to compile a ghc module. If there is an +-- out, then we know it's some Exe; if the out ends in .js then it's GhcjsExe, +-- otherwise GhcExe. That part is solved. +-- +-- Detecting a Lib is harder, and much code can be compiled by both ghc and +-- ghcjs. For now I'm just guarding against known ghcjs-only modules in the +-- import list. +detectGhcCompiler :: String -> String -> Compiler +detectGhcCompiler out _ | jsSuffix out = GhcjsExe +detectGhcCompiler out _ | not <| jsSuffix out || null out = GhcExe +detectGhcCompiler _ content + | match "import GHCJS" = GhcjsLib + | otherwise = GhcLib + where + match s = s `List.isInfixOf` content + +jsSuffix :: String -> Bool +jsSuffix = List.isSuffixOf ".js" build :: Target -> IO () build target@Target {..} = do root <- Env.getEnv "BIZ_ROOT" case compiler of - Ghc -> do - putText <| "bild: dev: ghc: " <> Namespace.toPath namespace + GhcExe -> do + putStrLn <| "bild: dev: ghc-exe: " <> Namespace.toPath namespace let outDir = root "_/bild/dev/bin" Dir.createDirectoryIfMissing True outDir putText <| "bild: dev: bilder: " <> Text.pack builder @@ -248,8 +305,22 @@ build target@Target {..} = do "-o", outDir out ] - Ghcjs -> do - putText <| "bild: dev: ghcjs: " <> Namespace.toPath namespace + GhcLib -> do + putStrLn <| "bild: dev: ghc-lib: " <> Namespace.toPath namespace + putText <| "bild: dev: bilder: " <> Text.pack builder + Process.callProcess + "ghc" + [ "-Werror", + "-i" <> root, + "-odir", + root "_/bild/int", + "-hidir", + root "_/bild/int", + "--make", + path + ] + GhcjsExe -> do + putStrLn <| "bild: dev: ghcjs-exe: " <> Namespace.toPath namespace let outDir = root "_/bild/dev/static" Dir.createDirectoryIfMissing True outDir putText <| "bild: dev: local: " <> Text.pack builder @@ -268,13 +339,27 @@ build target@Target {..} = do "-o", outDir out ] + GhcjsLib -> do + putStrLn <| "bild: dev: ghcjs-lib: " <> Namespace.toPath namespace + putText <| "bild: dev: local: " <> Text.pack builder + Process.callProcess + "ghcjs" + [ "-Werror", + "-i" <> root, + "-odir", + root "_/bild/int", + "-hidir", + root "_/bild/int", + "--make", + path + ] Guile -> do - putText <| "bild: dev: guile: " <> Namespace.toPath namespace + putStrLn <| "bild: dev: guile: " <> Namespace.toPath namespace putText <| "bild: dev: local: " <> Text.pack builder putText "bild: guile TODO" putText <| show target NixBuild -> do - putText <| "bild: nix: " <> Namespace.toPath namespace + putStrLn <| "bild: nix: " <> Namespace.toPath namespace let outDir = root "_/bild/nix" Dir.createDirectoryIfMissing True outDir if null builder @@ -284,7 +369,7 @@ build target@Target {..} = do "nix-build" [ path, "-o", - outDir (Text.unpack <| Namespace.toPath namespace), + outDir Namespace.toPath namespace, -- Set default arguments to nix functions "--arg", "bild", @@ -300,6 +385,10 @@ build target@Target {..} = do "--builders", builder ] + Copy -> do + putStrLn <| "bild: copy: " <> Namespace.toPath namespace + putText "bild: copy TODO" + putText <| show target metaDep :: Regex.RE Char Dep metaDep = Regex.string "-- : dep " *> Regex.many (Regex.psym Char.isAlpha) -- cgit v1.2.3