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.

1 files changed, 115 insertions, 26 deletions

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/<target>
--- - with a dev build, results are stored in _/bild/dev/<target>
---
--- -----------------------------------------------------------------------------
+-- : 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 </ readFile "/etc/hostname"
   cwd <- Dir.getCurrentDirectory
-  let path = cwd </> 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 </ readFile "/etc/hostname"
+  let path = Namespace.toPath namespace
   case ext of
     Namespace.Hs -> do
       content <- String.lines </ Prelude.readFile path
-      let out = content /> 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)