Add compilerFlags to Target

This moves logic into the analysis step, and allows better auditing because you
can see exactly what flags and command bild will use to compile the target.

1 files changed, 160 insertions, 157 deletions

diff --git a/Biz/Bild.hs b/Biz/Bild.hs
index b23a8ff..f23d04a 100644
--- a/Biz/Bild.hs
+++ b/Biz/Bild.hs
@@ -197,8 +197,8 @@ exitSummary exits =
 
 type Dep = String
 
-data Out = Lib String | Bin String
-  deriving (Show)
+data Out = Lib String | Bin String | None
+  deriving (Show, Eq)
 
 instance Aeson.ToJSON Out where
   toJSON out = outdir out |> Text.pack |> Aeson.String
@@ -212,11 +212,23 @@ data Compiler
   | NixBuild
   | Rustc
   | Sbcl
-  deriving (Eq, Show, Generic, Aeson.ToJSON)
+  deriving (Eq, Show, Generic)
+
+instance Aeson.ToJSON Compiler where
+  toJSON =
+    Aeson.String <. \case
+      Copy -> "cp"
+      Gcc -> "gcc"
+      GhcLib -> "ghc"
+      GhcExe -> "ghc"
+      Guile -> "guile"
+      NixBuild -> "nix-build"
+      Rustc -> "rustc"
+      Sbcl -> "sbcl"
 
 data Target = Target
   { -- | Output name
-    out :: Maybe Out,
+    out :: Out,
     -- | Fully qualified namespace partitioned by '.'
     namespace :: Namespace,
     -- | Absolute path to file
@@ -228,7 +240,9 @@ data Target = Target
     -- | Which compiler should we use?
     compiler :: Compiler,
     -- | Where is this machine being built? Schema: user@location
-    builder :: Text
+    builder :: Text,
+    -- | Flags and arguments passed to 'Compiler' when building
+    compilerFlags :: [Text]
   }
   deriving (Show, Generic, Aeson.ToJSON)
 
@@ -264,6 +278,7 @@ outdir :: Out -> String
 outdir = \case
   Bin o -> "_/bin" </> o
   Lib o -> "_/lib" </> o
+  None -> mempty
 
 intdir, nixdir, vardir :: String
 intdir = "_/int"
@@ -316,25 +331,41 @@ analyze path = do
       Namespace.None -> pure Nothing
       Namespace.Py -> pure Nothing
       Namespace.Sh -> pure Nothing
-      Namespace.C ->
+      Namespace.C -> do
+        let out =
+              contentLines
+                /> Text.unpack
+                /> Regex.match (metaOut "//" <|> metaLib "//")
+                |> catMaybes
+                |> head
+                |> fromMaybe None
+        let sysdeps =
+              contentLines
+                /> Text.unpack
+                /> Regex.match (metaSys "//")
+                |> catMaybes
+                |> Set.fromList
+        guileFlags <-
+          if "guile_3_0" `elem` sysdeps
+            then
+              Process.readProcess "guile-config" ["compile"] ""
+                /> String.words
+                /> (++ ["-shared", "-fPIC"])
+                /> map Text.pack
+            else pure mempty
         Just
           </ pure
             Target
               { langdeps = Set.empty, -- c has no lang deps...?
-                sysdeps =
-                  contentLines
-                    /> Text.unpack
-                    /> Regex.match (metaSys "//")
-                    |> catMaybes
-                    |> Set.fromList,
                 compiler = Gcc,
-                out =
-                  contentLines
-                    /> Text.unpack
-                    /> Regex.match (metaOut "//" <|> metaLib "//")
-                    |> catMaybes
-                    |> head,
                 builder = user <> "@localhost",
+                compilerFlags =
+                  concat
+                    [ [o, dir, Text.pack absPath] ++ guileFlags
+                      | let outable = out /= None,
+                        o <- outable ?: (["-o"], []),
+                        dir <- outable ?: ([Text.pack <| root </> outdir out], [])
+                    ],
                 ..
               }
       Namespace.Hs -> do
@@ -345,11 +376,34 @@ analyze path = do
                 /> Regex.match (metaOut "--")
                 |> catMaybes
                 |> head
+                |> fromMaybe None
         Just
           </ pure
             Target
               { builder = user <> "@localhost",
                 compiler = detectGhcCompiler out,
+                compilerFlags =
+                  map
+                    Text.pack
+                    [ "-Werror",
+                      "-i" <> root,
+                      "-odir",
+                      root </> intdir,
+                      "-hidir",
+                      root </> intdir,
+                      "--make",
+                      path
+                    ]
+                    ++ (out /= None)
+                    ?: ( map
+                           Text.pack
+                           [ "-main-is",
+                             Namespace.toHaskellModule namespace,
+                             "-o",
+                             root </> outdir out
+                           ],
+                         []
+                       ),
                 sysdeps =
                   contentLines
                     /> Text.unpack
@@ -359,71 +413,103 @@ analyze path = do
                 ..
               }
       Namespace.Lisp -> do
+        let out =
+              contentLines
+                /> Text.unpack
+                /> Regex.match (metaOut ";;")
+                |> catMaybes
+                |> head
+                |> fromMaybe None
         langdeps <- detectLispImports contentLines
         Just
           </ pure
             Target
               { sysdeps = Set.empty,
                 compiler = Sbcl,
-                out =
-                  contentLines
-                    /> Text.unpack
-                    /> Regex.match (metaOut ";;")
-                    |> catMaybes
-                    |> head,
+                compilerFlags =
+                  map
+                    Text.pack
+                    [ "--load",
+                      path,
+                      "--eval",
+                      "(require :asdf)",
+                      "--eval",
+                      "(sb-ext:save-lisp-and-die #p\"" <> (root </> outdir out) <> "\" :toplevel #'main :executable t)"
+                    ],
                 builder = user <> "@localhost",
                 ..
               }
-      Namespace.Nix ->
+      Namespace.Nix -> do
+        let builder =
+              (host == "lithium")
+                ?: ( "local",
+                     Text.concat
+                       [ "ssh://",
+                         user,
+                         "@dev.simatime.com?ssh-key=/home/",
+                         user,
+                         "/.ssh/id_rsa"
+                       ]
+                   )
         Just
           </ pure
             Target
               { langdeps = Set.empty,
                 sysdeps = Set.empty,
                 compiler = NixBuild,
-                out = Nothing,
-                builder =
-                  if host == "lithium"
-                    then mempty
-                    else
-                      Text.concat
-                        [ "ssh://",
-                          user,
-                          "@dev.simatime.com?ssh-key=/home/",
-                          user,
-                          "/.ssh/id_rsa"
-                        ],
+                compilerFlags =
+                  map
+                    Text.pack
+                    [ path,
+                      "--out-link",
+                      root </> nixdir </> Namespace.toPath namespace,
+                      "--builders",
+                      Text.unpack builder
+                    ],
+                out = None,
                 ..
               }
       Namespace.Scm -> do
+        let out =
+              contentLines
+                /> Text.unpack
+                /> Regex.match (metaOut ";;")
+                |> catMaybes
+                |> head
+                |> fromMaybe None
         Just
           </ pure
             Target
               { langdeps = Set.empty,
                 sysdeps = Set.empty,
                 compiler = Guile,
-                out =
-                  contentLines
-                    /> Text.unpack
-                    /> Regex.match (metaOut ";;")
-                    |> catMaybes
-                    |> head,
+                compilerFlags =
+                  map
+                    Text.pack
+                    [ "compile",
+                      "--r7rs",
+                      "--load-path=" ++ root,
+                      "--output=" ++ root </> intdir </> replaceExtension path ".scm.go",
+                      path
+                    ],
                 builder = user <> "@localhost",
                 ..
               }
       Namespace.Rs -> do
+        let out =
+              contentLines
+                /> Text.unpack
+                /> Regex.match (metaOut "//")
+                |> catMaybes
+                |> head
+                |> fromMaybe None
         Just
           </ pure
             Target
               { langdeps = Set.empty,
                 sysdeps = Set.empty,
                 compiler = Rustc,
-                out =
-                  contentLines
-                    /> Text.unpack
-                    /> Regex.match (metaOut "//")
-                    |> catMaybes
-                    |> head,
+                compilerFlags = map Text.pack [path, "-o", root </> outdir out],
                 builder = user <> "@localhost",
                 ..
               }
@@ -463,10 +549,11 @@ ghcPkgFindModule acc m = do
 
 -- | Some rules for detecting the how to compile a ghc module. If there is an
 -- out, then we know it's some Exe, otherwise it's a Lib.
-detectGhcCompiler :: Maybe Out -> Compiler
+detectGhcCompiler :: Out -> Compiler
 detectGhcCompiler = \case
-  Just _ -> GhcExe
-  Nothing -> GhcLib
+  Bin _ -> GhcExe
+  Lib _ -> GhcLib
+  None -> GhcLib
 
 isFailure :: Exit.ExitCode -> Bool
 isFailure (Exit.ExitFailure _) = True
@@ -480,11 +567,10 @@ test :: Bool -> Target -> IO Exit.ExitCode
 test loud Target {..} = case compiler of
   GhcExe -> do
     root <- Env.getEnv "BIZ_ROOT"
-    let o = Maybe.fromJust out
     run
       <| Proc
         { loud = loud,
-          cmd = root </> outdir o,
+          cmd = root </> outdir out,
           args = ["test"],
           ns = namespace,
           onFailure = Log.fail ["test", nschunk namespace] >> Log.br,
@@ -499,45 +585,16 @@ build :: Bool -> Bool -> Target -> IO Exit.ExitCode
 build andTest loud target@Target {..} = do
   root <- Env.getEnv "BIZ_ROOT"
   case compiler of
-    Gcc -> case out of
-      Just ou -> case ou of
-        Bin _ -> do
-          Log.info ["bild", "bin", "gcc", nschunk namespace]
-          let baseFlags = ["-o", root </> outdir ou, path]
-          proc loud namespace "gcc" baseFlags
-        Lib _ -> do
-          Log.info ["bild", "lib", "gcc", nschunk namespace]
-          let baseFlags = ["-o", root </> outdir ou, path]
-          if "guile_3_0" `elem` sysdeps
-            then do
-              compileFlags <-
-                Process.readProcess "guile-config" ["compile"] ""
-                  /> String.words
-              compileFlags <> baseFlags <> ["-shared", "-fPIC"]
-                |> proc loud namespace "gcc"
-            else proc loud namespace "gcc" baseFlags
-      Nothing -> Exit.die "no bin or lib found"
+    Gcc ->
+      Log.info ["bild", label, "gcc", nschunk namespace]
+        >> proc loud namespace "gcc" compilerFlags
+      where
+        label = case out of
+          Bin _ -> "bin"
+          _ -> "lib"
     GhcExe -> do
       Log.info ["bild", "dev", "ghc-exe", nschunk namespace]
-      let o = Maybe.fromJust out
-      exitcode <-
-        proc
-          loud
-          namespace
-          "ghc"
-          [ "-Werror",
-            "-i" <> root,
-            "-odir",
-            root </> intdir,
-            "-hidir",
-            root </> intdir,
-            "--make",
-            path,
-            "-main-is",
-            Namespace.toHaskellModule namespace,
-            "-o",
-            root </> outdir o
-          ]
+      exitcode <- proc loud namespace "ghc" compilerFlags
       if andTest && isSuccess exitcode
         then test loud target
         else pure exitcode
@@ -547,32 +604,13 @@ build andTest loud target@Target {..} = do
         loud
         namespace
         "ghc"
-        [ "-Werror",
-          "-i" <> root,
-          "-odir",
-          root </> intdir,
-          "-hidir",
-          root </> intdir,
-          "--make",
-          path
-        ]
+        compilerFlags
     Guile -> do
       Log.info ["bild", "dev", "guile", nschunk namespace]
-      _ <-
-        proc
-          loud
-          namespace
-          "guild"
-          [ "compile",
-            "--r7rs",
-            "--load-path=" ++ root,
-            "--output=" ++ root </> intdir </> replaceExtension path ".scm.go",
-            path
-          ]
-      when (isJust out) <| do
-        let o = Maybe.fromJust out
+      _ <- proc loud namespace "guild" compilerFlags
+      when (out /= None) <| do
         writeFile
-          (root </> outdir o)
+          (root </> outdir out)
           <| Text.pack
           <| joinWith
             "\n"
@@ -584,56 +622,21 @@ build andTest loud target@Target {..} = do
                 <> Namespace.toPath namespace
                 <> " \"$@\""
             ]
-        p <- Dir.getPermissions <| root </> outdir o
-        Dir.setPermissions (root </> outdir o) (Dir.setOwnerExecutable True p)
+        p <- Dir.getPermissions <| root </> outdir out
+        Dir.setPermissions (root </> outdir out) (Dir.setOwnerExecutable True p)
       pure Exit.ExitSuccess
     NixBuild -> do
-      Log.info
-        [ "bild",
-          "nix",
-          if Text.null builder
-            then "local"
-            else builder,
-          nschunk namespace
-        ]
-      proc
-        loud
-        namespace
-        "nix-build"
-        [ path,
-          "--out-link",
-          root </> nixdir </> Namespace.toPath namespace,
-          "--builders",
-          Text.unpack builder
-        ]
+      Log.info ["bild", "nix", builder, nschunk namespace]
+      proc loud namespace "nix-build" compilerFlags
     Copy -> do
       Log.warn ["bild", "copy", "TODO", nschunk namespace]
       pure Exit.ExitSuccess
     Rustc -> do
       Log.info ["bild", "dev", "rust", nschunk namespace]
-      let out' = Maybe.fromJust out
-      proc
-        loud
-        namespace
-        "rustc"
-        [ path,
-          "-o",
-          root </> outdir out'
-        ]
+      proc loud namespace "rustc" compilerFlags
     Sbcl -> do
       Log.info ["bild", "dev", "lisp", nschunk namespace]
-      let out' = Maybe.fromJust out
-      proc
-        loud
-        namespace
-        "sbcl"
-        [ "--load",
-          path,
-          "--eval",
-          "(require :asdf)",
-          "--eval",
-          "(sb-ext:save-lisp-and-die #p\"" <> (root </> outdir out') <> "\" :toplevel #'main :executable t)"
-        ]
+      proc loud namespace "sbcl" compilerFlags
 
 data Proc = Proc
   { loud :: Bool,
@@ -663,14 +666,14 @@ run Proc {..} = do
     else onSuccess >> pure exitcode
 
 -- | Helper for running a standard bild subprocess.
-proc :: Bool -> Namespace -> String -> [String] -> IO Exit.ExitCode
+proc :: Bool -> Namespace -> String -> [Text] -> IO Exit.ExitCode
 proc loud namespace cmd args =
   run
     <| Proc
       { loud = loud,
         ns = namespace,
         cmd = cmd,
-        args = args,
+        args = map Text.unpack args,
         onFailure = Log.fail ["bild", nschunk namespace] >> Log.br,
         onSuccess = Log.good ["bild", nschunk namespace] >> Log.br
       }