bild: support incremental compilation

Closes https://github.com/bsima/biz/issues/9

10 files changed, 186 insertions, 48 deletions

diff --git a/.gitignore b/.gitignore
index 20aa8d7..8cf3e44 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,4 +1,8 @@
 *.o
+*.dyn_o
+*.dyn_hi
+*.js_o
+*.js_hi
 *.exe
 *.hi
 result*
diff --git a/Alpha.hs b/Alpha.hs
index 8e77a5e..934cc31 100644
--- a/Alpha.hs
+++ b/Alpha.hs
@@ -1,5 +1,5 @@
-{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
 
 -- | Commonly useful functions, a Prelude replacement.
 --
@@ -21,6 +21,7 @@ module Alpha
   ( -- * Re-export Protolude
     module X,
     String,
+    lines,
 
     -- * Applying
     (<|),
@@ -38,8 +39,7 @@ module Alpha
     chomp,
     lchomp,
     joinWith,
-
-    CanSnakeCase(snake),
+    CanSnakeCase (snake),
 
     -- * Debugging tools
     say,
diff --git a/Biz/Bild.hs b/Biz/Bild.hs
index 565792e..7e67b8d 100644
--- a/Biz/Bild.hs
+++ b/Biz/Bild.hs
@@ -1,4 +1,6 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
 -- | A general purpose build tool.
@@ -7,41 +9,144 @@
 -- - for a dev build, results are stored in _bild/dev/<target>
 module Biz.Bild where
 
-import Alpha
+import Alpha hiding ((<.>), sym)
+import qualified Data.Char as Char
+import qualified Data.List as List
+import qualified Data.Text as Text
 import qualified System.Directory as Dir
 import qualified System.Environment as Env
 import qualified System.Exit as Exit
-import System.FilePath ((</>))
+import System.FilePath ((<.>), (</>))
 import qualified System.Process as Process
+import Text.Regex.Applicative
+import qualified Prelude
 
 main :: IO ()
 main = Env.getArgs /> head >>= \case
-  Nothing -> do
-    basename <- Env.getProgName
-    Exit.die <| "usage: " <> basename <> " <target>"
-  Just target -> nixBuild target
+  Nothing -> Exit.die "usage: bild <target>"
+  Just target -> analyze target >>= build
 
-{-
-TODO:
-- parse target syntax
-- write dev builder for ghc/ghcjs
--}
+type Namespace = String
 
-type Target = String
+type Dep = String
 
-nixBuild :: Target -> IO ()
-nixBuild target = do
+type Exe = String
+
+data Compiler = Ghc | Ghcjs | Nix
+  deriving (Show)
+
+data Target
+  = Target
+      { -- | Output executable name
+        exe :: Exe,
+        -- | Fully qualified namespace partitioned by '.'
+        namespace :: Namespace,
+        -- | Absolute path to file
+        path :: FilePath,
+        -- | Parsed/detected dependencies
+        deps :: [Dep],
+        -- | Which compiler should we use?
+        compiler :: Compiler
+      }
+  deriving (Show)
+
+analyze :: String -> IO Target
+analyze s = do
   root <- Env.getEnv "BIZ_ROOT"
   cwd <- Dir.getCurrentDirectory
-  let qualifiedTarget = reps root "" cwd <> target
-  Process.callProcess
-    "nix-build"
-    [ "-o",
-      root </> "_bild/nix" </> qualifiedTarget,
-      root </> "default.nix",
-      "--attr",
-      qualifiedTarget
-    ]
+  -- this is a hack to support multiple file types. Ideally we would just detect
+  -- which file extensions exist
+  let path = cwd </> reps "." "/" s |> reps "/hs" ".hs" |> reps "/nix" ".nix"
+  content <- lines </ Prelude.readFile path
+  let exe = content /> match metaExe |> catMaybes |> head |> require "exe"
+  return
+    Target
+      { namespace =
+          require "namespace"
+            <| path
+            |> reps root ""
+            |> reps ".hs" ""
+            |> reps ".nix" ""
+            |> reps "/" "."
+            |> List.stripPrefix "."
+            >>= match metaNamespace,
+        deps = content /> match metaDep |> catMaybes,
+        compiler =
+          if ".hs" `List.isSuffixOf` path
+            then if ".js" `List.isSuffixOf` exe then Ghcjs else Ghc
+            else Nix,
+        ..
+      }
+
+build :: Target -> IO ()
+build Target {..} = do
+  root <- Env.getEnv "BIZ_ROOT"
+  case compiler of
+    Ghc -> do
+      putText <| "bild: ghc: " <> Text.pack namespace
+      let out = root </> "_bild/dev/bin"
+      Dir.createDirectoryIfMissing True out
+      Process.callProcess
+        "ghc"
+        [ "-Werror",
+          "-i" <> root,
+          "-odir",
+          root </> "_bild/int",
+          "-hidir",
+          root </> "_bild/int",
+          "--make",
+          path,
+          "-main-is",
+          namespace,
+          "-o",
+          out </> exe
+        ]
+    Ghcjs -> do
+      putText <| "bild: ghcjs: " <> Text.pack namespace
+      let out = root </> "_bild/dev/static"
+      Dir.createDirectoryIfMissing True out
+      Process.callProcess
+        "ghcjs"
+        [ "-Werror",
+          "-i" <> root,
+          "-odir",
+          root </> "_bild/int",
+          "-hidir",
+          root </> "_bild/int",
+          "--make",
+          path,
+          "-main-is",
+          namespace,
+          "-o",
+          out </> exe
+        ]
+    Nix -> do
+      putText <| "bild: nix: " <> Text.pack namespace
+      cwd <- Dir.getCurrentDirectory
+      let qualifiedTarget = reps root "" cwd <> namespace
+      Process.callProcess
+        "nix-build"
+        [ "-o",
+          root </> "_bild/nix" </> qualifiedTarget,
+          root </> "default.nix",
+          "--attr",
+          qualifiedTarget
+        ]
+
+metaNamespace :: RE Char Namespace
+metaNamespace = name <> many (sym '.') <> name
+  where
+    name = many (psym Char.isUpper) <> many (psym Char.isLower)
+
+metaDep :: RE Char Dep
+metaDep = string "-- : dep " *> many (psym Char.isAlpha)
+
+metaExe :: RE Char Exe
+metaExe = string "-- : exe " *> many (psym (/= ' '))
+
+require :: Text -> Maybe a -> a
+require s (Just x) = x
+require s Nothing = panic <| s <> " not found"
 
 -- | Replace 'a' in 's' with 'b'.
 reps :: String -> String -> String -> String
diff --git a/Hero/Host.hs b/Hero/Host.hs
index 285861d..7b6911f 100644
--- a/Hero/Host.hs
+++ b/Hero/Host.hs
@@ -42,6 +42,7 @@
 -- : dep wai-middleware-metrics
 -- : dep warp
 -- : dep x509
+-- : dep regex-applicative
 module Hero.Host
   ( main,
   )
@@ -330,7 +331,7 @@ instance L.ToHtml a => L.ToHtml (Templated a) where
         cssRef bulmaRef
         cssRef fontAwesomeRef
         cssRef "/css/main.css" -- TODO: make this a safeLink?
-        jsRef "/static/mmc.js"
+        jsRef "/static/all.js"
         jsRef "/static/usersnap.js"
       L.body_ (L.toHtml x)
     where
diff --git a/README.md b/README.md
index 35084a1..6c6edf2 100644
--- a/README.md
+++ b/README.md
@@ -62,14 +62,8 @@ handle the file. So for example:
 
 ## Development
 
-To build code, do:
+Jump into a development shell:
 
-    bild <ns>
+    nix-shell
 
-To get in the environment for a thing, `repl`:
-
-    repl <ns>
-
-And to deploy:
-
-    push <ns> <url>
+Then run  `help` to see the dev commands.
diff --git a/nix/build.nix b/nix/build.nix
index fa7dcc8..5258313 100644
--- a/nix/build.nix
+++ b/nix/build.nix
@@ -97,8 +97,19 @@ in {
     name = "bizdev";
     buildInputs = [
       (ghc_ allDeps)
-      # this says something about missing haskelline?
-      #(ghcjs_ allDeps)
+      # ghcjs doesn't need everything, and many things fail to build
+      (ghcjs_ [
+        "aeson"
+        "clay"
+        "containers"
+        "miso"
+        "protolude"
+        "servant"
+        "split"
+        "string-quote"
+        "text"
+        "ghcjs-base"
+      ])
 
       nixpkgs.figlet
       nixpkgs.hlint
diff --git a/nix/haskell-deps.nix b/nix/haskell-deps.nix
index 26981dc..1f09b4a 100644
--- a/nix/haskell-deps.nix
+++ b/nix/haskell-deps.nix
@@ -9,7 +9,6 @@
   "clay"
   "config-ini"
   "containers"
-  "dhall"
   "directory"
   "ekg"
   "envy"
@@ -29,6 +28,7 @@
   "protolude"
   "quickcheck-instances"
   "random"
+  "regex-applicative"
   "req"
   "safecopy"
   "scotty"
diff --git a/nix/haskell-overlay.nix b/nix/haskell-overlay.nix
index 3c7ec76..a6aad12 100644
--- a/nix/haskell-overlay.nix
+++ b/nix/haskell-overlay.nix
@@ -23,6 +23,7 @@ in
       ghcjs = pkgs.haskell.packages.ghcjs.override (old: {
         overrides = with pkgs.haskell.lib; self: super:
           pkgs.overridePinnedDeps (simpleCabalBuilder self) // {
+          Glob = dontCheck super.Glob;
           QuickCheck = dontCheck super.QuickCheck;
           base-compat-batteries = dontCheck super.http-types;
           clay = dontCheck super.clay;
@@ -32,6 +33,7 @@ in
           network-uri= dontCheck super.network-uri;
           scientific = dontCheck super.scientific; # takes forever
           servant = dontCheck super.servant;
+          servant-auth = buildCabal self "servant-auth" "servant-auth";
           tasty-quickcheck = dontCheck super.tasty-quickcheck;
           time-compat = dontCheck super.time-compat;
         };
diff --git a/nix/shellHook.sh b/nix/shellHook.sh
index 035c450..981f86e 100644
--- a/nix/shellHook.sh
+++ b/nix/shellHook.sh
@@ -20,20 +20,27 @@ function deps() {
   niv --sources-file $BIZ_ROOT/nix/sources.json $@
 }
 
-function ghci() {
-  ghci -i$BIZ_ROOT -ghci-script "$BIZ_ROOT/.ghci"
-}
+alias ghci="ghci -i$BIZ_ROOT -ghci-script $BIZ_ROOT/.ghci"
 
 function hero() {
-  out="_bild/nix"
   export HERO_PORT=3000
-  export HERO_NODE=$BIZ_ROOT/$out/Hero.Node/static
   export HERO_KEEP=$BIZ_ROOT/_keep
   export HERO_SKEY=$BIZ_ROOT/_skey
-  b="runghc Biz.Bild"
-  rg --files \
-    | entr -rcs \
-      "$b Hero.Host && $b Hero.Node && $out/Hero.Host/bin/mmc"
+  bild="runghc Biz.Bild"
+  if [[ -z "${IN_NIX_SHELL}" ]]
+  then
+    out="_bild/dev"
+    export HERO_NODE=$BIZ_ROOT/$out/static/mmc.js/all.js
+    rg --files \
+      | entr -rcs \
+        "$bild Hero.Host && $bild Hero.Node && $out/bin/mmc"
+  else
+    out="_bild/nix"
+    export HERO_NODE=$BIZ_ROOT/$out/Hero.Node/static
+    rg --files \
+      | entr -rcs \
+        "$bild Hero.Host && $bild Hero.Node && $out/Hero.Host/bin/mmc"
+  fi
 }
 
 function lint() {
diff --git a/nix/sources.json b/nix/sources.json
index fdbb4b6..d2565a7 100644
--- a/nix/sources.json
+++ b/nix/sources.json
@@ -62,6 +62,20 @@
         "url": "https://github.com/NixOS/nixpkgs/archive/b0c285807d6a9f1b7562ec417c24fa1a30ecc31a.tar.gz",
         "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
     },
+    "regex-applicative": {
+        "branch": "master",
+        "description": "Regex-based parsing with applicative interface",
+        "homepage": "",
+        "owner": "feuerbach",
+        "repo": "regex-applicative",
+        "rev": "449519c38e65753345e9a008362c011cb7a0a4d9",
+        "revision": "449519c38e65753345e9a008362c011cb7a0a4d9",
+        "sha256": "1vdrhsjzij5dm7rn10sic5dv9574yb0lyhzfv9psh7b08dsj8g1k",
+        "type": "tarball",
+        "url": "https://github.com/feuerbach/regex-applicative/archive/449519c38e65753345e9a008362c011cb7a0a4d9.tar.gz",
+        "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz",
+        "version": "0.3.4"
+    },
     "servant-auth": {
         "branch": "master",
         "description": null,