Automatically detect Haskell dependencies

This parses the files contents for imports, then uses ghc-pkg to lookup the
package that provides the module. Now I can do that analysis in Haskell instead
of nix, which is much easier to code with.

15 files changed, 320 insertions, 302 deletions

diff --git a/Biz/Bild.hs b/Biz/Bild.hs
index ada7879..08fb208 100644
--- a/Biz/Bild.hs
+++ b/Biz/Bild.hs
@@ -1,19 +1,15 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
 -- | A general purpose build tool.
 --
 -- : out bild
--- : dep conduit
--- : dep conduit-extra
--- : dep docopt
--- : dep regex-applicative
--- : dep rainbow
--- : dep tasty
--- : dep tasty-hunit
 --
 -- == Design constraints
 --
@@ -75,6 +71,7 @@
 -- > bild -s <target>
 --
 -- Starts a repl/shell for target.
+--
 --  - if target.hs, load ghci
 --  - if target.scm, load scheme repl
 --  - if target.clj, load a clojure repl
@@ -92,10 +89,14 @@
 --
 -- == Build Metadata
 --
--- Metadata is set in the comments with a special syntax. For third-party deps,
+-- Metadata is set in the comments with a special syntax. For system-level deps,
 -- we list the deps in comments in the target file, like:
 --
--- > -- : dep aeson
+-- > -- : sys cmark
+--
+-- The name is used to lookup the package in `nixpkgs.pkgs.<name>`.
+-- Language-level deps can automatically determined by passing parsed import
+-- statements to a package database, eg `ghc-pkg find-module`.
 --
 -- The output executable is named with:
 --
@@ -125,22 +126,28 @@ import Biz.Namespace (Namespace (..))
 import qualified Biz.Namespace as Namespace
 import qualified Biz.Test as Test
 import qualified Control.Concurrent.Async as Async
+import qualified Data.Aeson as Aeson
+import qualified Data.ByteString.Char8 as Char8
+import qualified Data.ByteString.Lazy as ByteString
 import qualified Data.Char as Char
 import Data.Conduit ((.|))
 import qualified Data.Conduit as Conduit
 import qualified Data.Conduit.List as Conduit
 import qualified Data.Conduit.Process as Conduit
 import qualified Data.List as List
+import qualified Data.Map as Map
 import qualified Data.Maybe as Maybe
+import qualified Data.Set as Set
 import qualified Data.String as String
 import qualified Data.Text as Text
+import qualified Data.Text.IO as Text.IO
 import qualified System.Directory as Dir
 import qualified System.Environment as Env
 import qualified System.Exit as Exit
 import System.FilePath (replaceExtension, (</>))
 import qualified System.IO as IO
+import qualified System.Process as Process
 import qualified Text.Regex.Applicative as Regex
-import qualified Prelude
 
 main :: IO ()
 main = Cli.main <| Cli.Plan help move test pure
@@ -149,8 +156,7 @@ main = Cli.main <| Cli.Plan help move test pure
       Test.group
         "Biz.Bild"
         [ Test.unit "can bild bild" <| do
-            let ns = Namespace ["Biz", "Bild"] Namespace.Hs
-            analyze ns +> build False False +> \case
+            analyze "Biz/Bild.hs" /> Maybe.fromJust +> build False False +> \case
               Exit.ExitFailure _ -> Test.assertFailure "can't bild bild"
               _ -> pure ()
         ]
@@ -158,16 +164,28 @@ main = Cli.main <| Cli.Plan help move test pure
 move :: Cli.Arguments -> IO ()
 move args =
   IO.hSetBuffering stdout IO.NoBuffering
-    >> traverse getNamespace (Cli.getAllArgs args (Cli.argument "target"))
-    /> catMaybes
-    /> filter isBuildableNs
-    +> traverse analyze
-    +> traverse
-      ( build
-          (args `Cli.has` Cli.longOption "test")
-          (args `Cli.has` Cli.longOption "loud")
-      )
+    >> pure (Cli.getAllArgs args (Cli.argument "target"))
+    /> filter (not <. ("_" `List.isPrefixOf`))
+    +> filterM Dir.doesFileExist
+    +> traverse (\fn -> analyze fn /> (fn,))
+    /> filter (snd .> isJust)
+    /> Map.fromList
+    /> Map.map Maybe.fromJust
+    /> Map.filter (namespace .> isBuildableNs)
+    +> printOrBuild
     +> exitSummary
+  where
+    printOrBuild :: Map FilePath Target -> IO [ExitCode]
+    printOrBuild analyses =
+      if args `Cli.has` Cli.longOption "analyze"
+        then Map.elems analyses |> putJSON >> pure [Exit.ExitSuccess]
+        else Map.toList analyses |> map snd |> traverse (build isTest isLoud)
+    isTest = args `Cli.has` Cli.longOption "test"
+    isLoud = args `Cli.has` Cli.longOption "loud"
+    putJSON = Aeson.encode .> ByteString.toStrict .> Char8.putStrLn
+
+nixStore :: String
+nixStore = "/nix/store/00000000000000000000000000000000-"
 
 help :: Cli.Docopt
 help =
@@ -179,9 +197,10 @@ Usage:
   bild [options] <target>...
 
 Options:
-  --test  Run tests on a target after building.
-  --loud  Show all output from compiler.
-  --help  Print this info
+  --test      Run tests on a target after building
+  --loud      Show all output from compiler
+  --analyze   Only analyze and print as JSON, don't build
+  -h, --help  Print this info
 |]
 
 exitSummary :: [Exit.ExitCode] -> IO ()
@@ -204,7 +223,7 @@ data Compiler
   | Guile
   | NixBuild
   | Copy
-  deriving (Show)
+  deriving (Show, Generic, Aeson.ToJSON)
 
 data Target = Target
   { -- | Output name
@@ -213,14 +232,16 @@ data Target = Target
     namespace :: Namespace,
     -- | Absolute path to file
     path :: FilePath,
-    -- | Parsed/detected dependencies
-    deps :: [Dep],
+    -- | Language-specific dependencies
+    langdeps :: Set Dep,
+    -- | System-level dependencies
+    sysdeps :: Set Dep,
     -- | Which compiler should we use?
     compiler :: Compiler,
     -- | Where is this machine being built? Schema: user@location
     builder :: Text
   }
-  deriving (Show)
+  deriving (Show, Generic, Aeson.ToJSON)
 
 -- | We can't build everything yet...
 isBuildableNs :: Namespace -> Bool
@@ -246,7 +267,7 @@ vardir = "_/var"
 
 createHier :: String -> IO ()
 createHier root =
-  mapM_
+  traverse_
     (Dir.createDirectoryIfMissing True)
     [ root </> bindir,
       root </> intdir,
@@ -254,74 +275,135 @@ createHier root =
       root </> vardir
     ]
 
-getNamespace :: String -> IO (Maybe Namespace)
-getNamespace s = do
+-- >>> removeVersion "array-0.5.4.0-DFLKGIjfsadi"
+-- "array"
+removeVersion :: String -> String
+removeVersion = takeWhile (/= '.') .> butlast2
+  where
+    butlast2 s = take (length s - 2) s
+
+detectImports :: Namespace -> [Text] -> IO (Set Dep)
+detectImports (Namespace _ Namespace.Hs) contentLines = do
+  let imports =
+        contentLines
+          /> Text.unpack
+          /> Regex.match haskellImports
+          |> catMaybes
+  pkgs <- foldM ghcPkgFindModule Set.empty imports
+  transitivePkgs <-
+    imports
+      |> map (Namespace.fromHaskellModule .> Namespace.toPath)
+      |> traverse Dir.makeAbsolute
+      +> filterM Dir.doesFileExist
+      +> traverse analyze -- surely this is a bottleneck ripe for caching
+      /> catMaybes
+      /> map langdeps
+      /> mconcat
+  pure <| pkgs <> transitivePkgs
+detectImports _ _ = Exit.die "can only detectImports for Haskell"
+
+analyze :: FilePath -> IO (Maybe Target)
+analyze path = do
+  content <-
+    withFile path ReadMode <| \h ->
+      IO.hSetEncoding h IO.utf8_bom
+        >> Text.IO.hGetContents h
+  let contentLines = Text.lines content
   root <- Env.getEnv "BIZ_ROOT"
-  cwd <- Dir.getCurrentDirectory
-  return <| Namespace.fromPath root <| cwd </> s
-
-analyze :: Namespace -> IO Target
-analyze namespace@(Namespace.Namespace _ ext) = do
-  user <- Env.getEnv "USER" /> Text.pack
-  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
-      return
-        Target
-          { deps = content /> Regex.match metaDep |> catMaybes,
-            builder = user <> "@localhost",
-            compiler = detectGhcCompiler out <| String.unlines content,
-            ..
-          }
-    Namespace.Nix ->
-      return
-        Target
-          { deps = [],
-            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"
-                    ],
-            ..
-          }
-    Namespace.Scm -> do
-      content <- String.lines </ Prelude.readFile path
-      return
-        Target
-          { deps = [],
-            compiler = Guile,
-            out =
-              content
-                /> Regex.match (metaOut ";;")
-                |> catMaybes
-                |> head,
-            builder = user <> "@localhost",
-            ..
-          }
-    _ ->
-      return
-        Target
-          { deps = [],
-            compiler = Copy,
-            out = Nothing,
-            builder = user <> "@localhost",
-            ..
-          }
+  absPath <- Dir.makeAbsolute path
+  Log.info ["bild", "analyze", str path]
+  let ns =
+        if "hs" `List.isSuffixOf` path
+          then Namespace.fromContent <| Text.unpack content
+          else Namespace.fromPath root absPath
+  case ns of
+    Nothing ->
+      Log.warn ["bild", "analyze", str path, "could not find namespace"]
+        >> Log.br
+        >> pure Nothing
+    Just namespace@(Namespace _ ext) ->
+      Just </ do
+        user <- Env.getEnv "USER" /> Text.pack
+        host <- Text.pack </ fromMaybe "interactive" </ Env.lookupEnv "HOSTNAME"
+        case ext of
+          Namespace.Hs -> do
+            langdeps <- detectImports namespace contentLines
+            let out =
+                  contentLines
+                    /> Text.unpack
+                    /> Regex.match (metaOut "--")
+                    |> catMaybes
+                    |> head
+            pure
+              Target
+                { builder = user <> "@localhost",
+                  compiler = detectGhcCompiler out <| Text.unpack content,
+                  sysdeps =
+                    contentLines
+                      /> Text.unpack
+                      /> Regex.match (metaSys "--")
+                      |> catMaybes
+                      |> Set.fromList,
+                  ..
+                }
+          Namespace.Nix ->
+            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"
+                          ],
+                  ..
+                }
+          Namespace.Scm -> do
+            pure
+              Target
+                { langdeps = Set.empty,
+                  sysdeps = Set.empty,
+                  compiler = Guile,
+                  out =
+                    contentLines
+                      /> Text.unpack
+                      /> Regex.match (metaOut ";;")
+                      |> catMaybes
+                      |> head,
+                  builder = user <> "@localhost",
+                  ..
+                }
+          _ ->
+            pure
+              Target
+                { langdeps = Set.empty,
+                  sysdeps = Set.empty,
+                  compiler = Copy,
+                  out = Nothing,
+                  builder = user <> "@localhost",
+                  ..
+                }
+
+ghcPkgFindModule :: Set String -> String -> IO (Set String)
+ghcPkgFindModule acc m =
+  Process.readProcess
+    "ghc-pkg"
+    -- instead of relying on global deps declared in ./Bild/Deps/Haskell.nix, I
+    -- could fetch a global package-db from hackage API and pass it here with
+    -- --package-db=FILE
+    ["--names-only", "--simple-output", "find-module", m]
+    ""
+    /> String.lines
+    /> Set.fromList
+    /> Set.union acc
 
 -- | 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,
@@ -332,7 +414,7 @@ analyze namespace@(Namespace.Namespace _ ext) = do
 -- import list.
 detectGhcCompiler :: Maybe Out -> String -> Compiler
 detectGhcCompiler (Just out) _ | jsSuffix out = GhcjsExe
-detectGhcCompiler (Just out) _ | not <| jsSuffix out = GhcExe
+detectGhcCompiler (Just _) _ = GhcExe
 detectGhcCompiler Nothing content
   | match "import GHCJS" = GhcjsLib
   | otherwise = GhcLib
@@ -386,7 +468,7 @@ build andTest loud Target {..} = do
                 onFailure = Log.fail ["test", nschunk namespace] >> Log.br,
                 onSuccess = Log.pass ["test", nschunk namespace] >> Log.br
               }
-        else return exitcode
+        else pure exitcode
     GhcLib -> do
       Log.info ["bild", "dev", "ghc-lib", nschunk namespace]
       proc
@@ -440,16 +522,17 @@ build andTest loud Target {..} = do
     --  ]
     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
-        ]
+      _ <-
+        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
         writeFile
@@ -467,7 +550,7 @@ build andTest loud Target {..} = do
             ]
         p <- Dir.getPermissions <| root </> bindir </> o
         Dir.setPermissions (root </> bindir </> o) (Dir.setOwnerExecutable True p)
-      return Exit.ExitSuccess
+      pure Exit.ExitSuccess
     NixBuild -> do
       Log.info
         [ "bild",
@@ -489,7 +572,7 @@ build andTest loud Target {..} = do
         ]
     Copy -> do
       Log.warn ["bild", "copy", "TODO", nschunk namespace]
-      return Exit.ExitSuccess
+      pure Exit.ExitSuccess
 
 data Proc = Proc
   { loud :: Bool,
@@ -515,8 +598,8 @@ run Proc {..} = do
           <| Async.Concurrently
           <| Conduit.waitForStreamingProcess cph
   if isFailure exitcode
-    then puts stderr_ >> onFailure >> return exitcode
-    else onSuccess >> return exitcode
+    then puts stderr_ >> onFailure >> pure exitcode
+    else onSuccess >> pure exitcode
 
 -- | Helper for running a standard bild subprocess.
 proc :: Bool -> Namespace -> String -> [String] -> IO Exit.ExitCode
@@ -541,5 +624,20 @@ nschunk = Namespace.toPath .> Text.pack
 metaDep :: Regex.RE Char Dep
 metaDep = Regex.string "-- : dep " *> Regex.many (Regex.psym Char.isAlpha)
 
+metaSys :: [Char] -> Regex.RE Char Dep
+metaSys comment = Regex.string (comment ++ " : sys ") *> Regex.many (Regex.psym Char.isAlpha)
+
 metaOut :: [Char] -> Regex.RE Char Out
 metaOut comment = Regex.string (comment ++ " : out ") *> Regex.many (Regex.psym (/= ' '))
+
+haskellImports :: Regex.RE Char String
+haskellImports =
+  Regex.string "import"
+    *> Regex.some (Regex.psym Char.isSpace)
+    *> Regex.many (Regex.psym Char.isLower)
+    *> Regex.many (Regex.psym Char.isSpace)
+    *> Regex.some (Regex.psym isModuleChar)
+    <* Regex.many Regex.anySym
+  where
+    isModuleChar c =
+      elem c <| concat [['A' .. 'Z'], ['a' .. 'z'], ['.', '_'], ['0' .. '9']]
diff --git a/Biz/Bild.nix b/Biz/Bild.nix
index a3584ae..3cd5026 100644
--- a/Biz/Bild.nix
+++ b/Biz/Bild.nix
@@ -2,85 +2,97 @@
 
 
 let
-  inherit (nixpkgs) lib stdenv;
   ghcCompiler = "ghc884";
   ghcjsCompiler = "ghcjs86";
 
   # provided by .envrc
   root = builtins.getEnv "BIZ_ROOT";
 
-  # general functions to put in a lib
-  lines = s: lib.pipe s [
-    (builtins.split "\n")
-    (builtins.filter (x: builtins.typeOf x == "string"))
-  ];
-  removeNull = ls: builtins.filter (x: x != null) ls;
-
   selectAttrs = deps: packageSet:
-    lib.attrsets.attrVals deps packageSet;
+    nixpkgs.lib.attrsets.attrVals deps packageSet;
 
   # returns true if a is a subset of b, where a and b are attrsets
   subset = a: b: builtins.all
     (x: builtins.elem x b) a;
 
+  # 44 = lib.strings.stringLength "/nix/store/gia2r9mxhc900y1m97dlmr1g3rm3ich3-"
+  dropNixStore = s: nixpkgs.lib.strings.substring 44 (nixpkgs.lib.strings.stringLength s) s;
+
   haskellDeps = hpkgs: import ./Bild/Deps/Haskell.nix hpkgs;
 
   mkGhcPackageSet = nixpkgs.haskell.packages.${ghcCompiler}.ghcWithHoogle;
   #mkGhcjsPackageSet = nixpkgs.haskell.packages.${ghcjsCompiler}.ghcWithPackages;
 
 in rec {
-  # gather data needed for compiling by analyzing the main module
-  analyze = main: rec {
-    # path to the module relative to the git root
-    relpath = builtins.replaceStrings ["${root}/"] [""]
-        (builtins.toString main);
-    # Haskell-appropriate name of the module
-    module = builtins.replaceStrings ["/" ".hs"] ["." ""] relpath;
-    # file contents
-    content = builtins.readFile main;
-    # search for the ': out' declaration
-    out = lib.pipe content [
-      lines
-      (map (builtins.match "^-- : out ([[:alnum:]._-]*)$"))
-      removeNull
-      lib.lists.flatten
-      builtins.head
-    ];
-    # collect all of the ': dep' declarations
-    deps = lib.pipe content [
-      lines
-      (map (builtins.match "^-- : dep ([[:alnum:]._-]*)$"))
-      removeNull
-      lib.lists.flatten
-    ];
-    # collect ': sys' declarations
-    sysdeps = lib.pipe content [
-      lines
-      (map (builtins.match "^-- : sys ([[:alnum:]._-]*)$"))
-      removeNull
-      lib.lists.flatten
-    ];
+  inherit (nixpkgs) lib stdenv pkgs sources;
+
+  # a standard nix build for `bild` - this should be the only hand-written
+  # builder we need
+  bild = stdenv.mkDerivation {
+    name = "bild";
+    src = ../.;
+    nativeBuildInputs = [ ghcPackageSetFull ];
+    buildInputs = [ ghcPackageSetFull nixpkgs.makeWrapper ];
+    propagatedBuildInputs = [ ghcPackageSetFull ];
+    strictDeps = true;
+    buildPhase = ''
+      mkdir -p $out/bin
+      ghc \
+        -Werror \
+        -i. \
+        --make Biz/Bild.hs \
+        -main-is Biz.Bild \
+        -o $out/bin/bild
+    '';
+    installPhase = ''
+      wrapProgram $out/bin/bild --prefix PATH : ${lib.makeBinPath [ ghcPackageSetFull ]}
+    '';
   };
 
+  # wrapper around bild
+  runBildAnalyze = main: stdenv.mkDerivation {
+    name = "bild-analysis";
+    src = ../.;
+    USER = "nixbld";
+    HOSTNAME = "nix-sandbox";
+    BIZ_ROOT = "$src";
+    buildPhase = ''
+      set -eux
+      mkdir $out
+      : analyzing with bild
+      ${bild}/bin/bild --analyze ${main} 1> $out/analysis.json 2> $out/stderr
+      set +eux
+    '';
+    installPhase = "exit 0";
+  };
+
+  # gather data needed for compiling by analyzing the main module
+  analyze = main:
+    builtins.head
+      (lib.trivial.importJSON
+        (runBildAnalyze main + "/analysis.json"));
+
   ghcPackageSetFull = mkGhcPackageSet haskellDeps;
 
   ghc = main:
     let
       data = analyze main;
-      ghc = mkGhcPackageSet (hp: selectAttrs data.deps hp);
+      ghc = mkGhcPackageSet (hp: selectAttrs data.langdeps hp);
+      module = lib.strings.concatStringsSep "." data.namespace.path;
     in stdenv.mkDerivation {
-      name = data.module;
+      name = module;
       src = ../.;
       nativeBuildInputs = [ ghc ] ++ selectAttrs data.sysdeps nixpkgs.pkgs;
       strictDeps = true;
       buildPhase = ''
+        set -eux
         mkdir -p $out/bin
-        # compile with ghc
+        : compiling with ghc
         ${ghc}/bin/ghc \
           -Werror \
           -i. \
           --make ${main} \
-          -main-is ${data.module} \
+          -main-is ${module} \
           -o $out/bin/${data.out}
       '';
       # the install process was handled above
@@ -162,8 +174,4 @@ in rec {
   };
 
   os = cfg: (nixpkgs.nixos (args: cfg)).toplevel;
-
-  sources = nixpkgs.sources;
-
-  pkgs = nixpkgs.pkgs;
 }
diff --git a/Biz/Cli.hs b/Biz/Cli.hs
index 0054e26..435ded2 100644
--- a/Biz/Cli.hs
+++ b/Biz/Cli.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
--- : dep docopt
 module Biz.Cli
   ( Plan (..),
     main,
diff --git a/Biz/Devalloc.hs b/Biz/Devalloc.hs
index 9eea33d..b30bac4 100644
--- a/Biz/Devalloc.hs
+++ b/Biz/Devalloc.hs
@@ -23,34 +23,7 @@
 -- Developer allocation
 --
 -- : out devalloc
--- : dep acid-state
--- : dep clay
--- : dep cmark
 -- : sys cmark
--- : dep cmark-lucid
--- : dep docopt
--- : dep envy
--- : dep github
--- : dep http-api-data
--- : dep ixset
--- : dep lucid
--- : dep neat-interpolation
--- : dep protolude
--- : dep rainbow
--- : dep req
--- : dep safecopy
--- : dep servant
--- : dep servant-auth
--- : dep servant-auth-server
--- : dep servant-lucid
--- : dep servant-server
--- : dep tasty
--- : dep tasty-hunit
--- : dep tasty-quickcheck
--- : dep uuid
--- : dep vector
--- : dep vector-algorithms
--- : dep warp
 module Biz.Devalloc
   ( main,
     test,
diff --git a/Biz/Lint.hs b/Biz/Lint.hs
index 3039b72..38c7403 100644
--- a/Biz/Lint.hs
+++ b/Biz/Lint.hs
@@ -5,8 +5,6 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 
 -- : out lint
--- : dep rainbow
--- : dep regex-applicative
 module Biz.Lint (main) where
 
 import Alpha
diff --git a/Biz/Log.hs b/Biz/Log.hs
index 9a790aa..747efed 100644
--- a/Biz/Log.hs
+++ b/Biz/Log.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
--- : dep rainbow
 module Biz.Log
   ( Lvl (..),
     good,
@@ -44,7 +43,7 @@ msg lvl labels =
     -- systemd doesn't render msgs produced by putChunk, so when live we don't
     -- use rainbow at all
     "Live" -> putStr txt
-    _ -> Rainbow.putChunk <| fore color <| clear <> chunk txt <> "\r"
+    _ -> Rainbow.hPutChunks IO.stderr [fore color <| clear <> chunk txt <> "\r"]
   where
     txt = Text.intercalate gap (label : labels)
     (color, label) = case lvl of
@@ -60,7 +59,7 @@ gap :: Text
 gap = ":  "
 
 br :: IO ()
-br = Rainbow.putChunk "\n" >> IO.hFlush stdout
+br = Rainbow.hPutChunks stderr ["\n"] >> IO.hFlush stderr
 
 good, pass, info, warn, fail :: [Text] -> IO ()
 good = msg Good
@@ -74,12 +73,13 @@ mark :: Show a => Text -> a -> a
 mark label val =
   unsafePerformIO <| do
     msg Mark [label, tshow val]
+    br
     pure val
 
 -- | Pipelined version of 'mark'.
 --
 -- @
--- mark label val = val ~| label
+-- mark label val = val ~& label
 -- @
 (~&) :: Show a => a -> Text -> a
 (~&) val label = mark label val
diff --git a/Biz/Namespace.hs b/Biz/Namespace.hs
index 316896a..c3252fd 100644
--- a/Biz/Namespace.hs
+++ b/Biz/Namespace.hs
@@ -1,58 +1,58 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
--- : dep regex-applicative
 module Biz.Namespace
   ( Namespace (..),
     Ext (..),
     fromPath,
+    fromContent,
+    fromHaskellModule,
     toPath,
     toHaskellModule,
     toSchemeModule,
-    match,
   )
 where
 
 import Alpha
+import qualified Data.Aeson as Aeson
 import qualified Data.Char as Char
 import qualified Data.List as List
+import qualified Data.List.Split as List
 import qualified Text.Regex.Applicative as Regex
 
 data Ext = Hs | Scm | Nix | Md | Css | Py | Sh | Keys | Json | None
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic, Aeson.ToJSON)
 
-data Namespace = Namespace [String] Ext
-  deriving (Eq, Show)
-
-match :: String -> Maybe Namespace
-match = Regex.match <| Namespace </ path <* Regex.sym '.' <*> ext
-  where
-    name =
-      Regex.many (Regex.psym Char.isUpper)
-        <> Regex.many (Regex.psym Char.isAlphaNum)
-    path = Regex.many (name <* Regex.string "/" <|> name)
-    ext =
-      Nix <$ Regex.string "nix"
-        <|> Hs <$ Regex.string "hs"
-        <|> Scm <$ Regex.string "scm"
-        <|> Md <$ Regex.string "md"
-        <|> Css <$ Regex.string "css"
-        <|> Py <$ Regex.string "py"
-        <|> Sh <$ Regex.string "sh"
-        <|> Keys <$ Regex.string "pub"
-        <|> Json <$ Regex.string "json"
+data Namespace = Namespace {path :: [String], ext :: Ext}
+  deriving (Eq, Show, Generic, Aeson.ToJSON)
 
 fromPath :: String -> String -> Maybe Namespace
 fromPath bizRoot absPath =
   List.stripPrefix bizRoot absPath
     +> List.stripPrefix "/"
-    +> match
+    +> Regex.match (Namespace </ rePath <* dot <*> reExt)
+
+fromContent :: String -> Maybe Namespace
+fromContent c = case Regex.findFirstInfix haskellModule c of
+  Nothing -> Nothing
+  Just (_, Namespace {..}, _) -> Just <| Namespace (filter (/= ".") path) ext
+  where
+    haskellModule =
+      Namespace
+        </ (Regex.string "\nmodule " *> Regex.many (name <|> dot))
+        <*> pure Hs
 
 toHaskellModule :: Namespace -> String
 toHaskellModule (Namespace parts Hs) = joinWith "." parts
-toHaskellModule (Namespace _ ext) =
+toHaskellModule (Namespace {..}) =
   panic <| "can't convert " <> show ext <> " to a Haskell module"
 
+fromHaskellModule :: String -> Namespace
+fromHaskellModule s = Namespace (List.splitOn "." s) Hs
+
 toPath :: Namespace -> FilePath
 toPath (Namespace parts ext) =
   joinWith "/" parts
@@ -61,5 +61,28 @@ toPath (Namespace parts ext) =
 
 toSchemeModule :: Namespace -> String
 toSchemeModule (Namespace parts Scm) = "(" ++ joinWith " " parts ++ ")"
-toSchemeModule (Namespace _ ext) =
+toSchemeModule (Namespace {..}) =
   panic <| "can't convert " <> show ext <> " to a Scheme module"
+
+dot :: Regex.RE Char String
+dot = Regex.some <| Regex.sym '.'
+
+name :: Regex.RE Char String
+name =
+  Regex.many (Regex.psym Char.isUpper)
+    <> Regex.many (Regex.psym Char.isAlphaNum)
+
+rePath :: Regex.RE Char [String]
+rePath = Regex.many (name <* Regex.string "/" <|> name)
+
+reExt :: Regex.RE Char Ext
+reExt =
+  Nix <$ Regex.string "nix"
+    <|> Hs <$ Regex.string "hs"
+    <|> Scm <$ Regex.string "scm"
+    <|> Md <$ Regex.string "md"
+    <|> Css <$ Regex.string "css"
+    <|> Py <$ Regex.string "py"
+    <|> Sh <$ Regex.string "sh"
+    <|> Keys <$ Regex.string "pub"
+    <|> Json <$ Regex.string "json"
diff --git a/Biz/Pie.hs b/Biz/Pie.hs
index 15e5949..ff02716 100644
--- a/Biz/Pie.hs
+++ b/Biz/Pie.hs
@@ -34,15 +34,6 @@
 -- Bild Metadata:
 --
 -- : out pie
--- : dep aeson
--- : dep docopt
--- : dep haskeline
--- : dep protolude
--- : dep parsec
--- : dep rainbow
--- : dep tasty
--- : dep tasty-hunit
--- : dep tasty-quickcheck
 module Biz.Pie
   ( main,
   )
diff --git a/Biz/Pie.nix b/Biz/Pie.nix
deleted file mode 100644
index b519995..0000000
--- a/Biz/Pie.nix
+++ /dev/null
@@ -1,2 +0,0 @@
-{ bild ? import ./Bild.nix {} }:
-bild.ghc ./Pie.hs
diff --git a/Biz/Que/Host.hs b/Biz/Que/Host.hs
index fda9835..40ee1a5 100644
--- a/Biz/Que/Host.hs
+++ b/Biz/Que/Host.hs
@@ -13,19 +13,6 @@
 -- - sorta: <https://ngrok.com/> and <https://localtunnel.github.io/www/>
 --
 -- : out que-server
---
--- : dep async
--- : dep docopt
--- : dep envy
--- : dep protolude
--- : dep rainbow
--- : dep scotty
--- : dep stm
--- : dep tasty
--- : dep tasty-hunit
--- : dep tasty-quickcheck
--- : dep unagi-chan
--- : dep unordered-containers
 module Biz.Que.Host
   ( main,
   )
diff --git a/Biz/Que/Site.hs b/Biz/Que/Site.hs
index 43441df..06b86c8 100644
--- a/Biz/Que/Site.hs
+++ b/Biz/Que/Site.hs
@@ -7,17 +7,6 @@
 -- | spawns a few processes that serve the que.run website
 --
 -- : out que-website
---
--- : dep async
--- : dep docopt
--- : dep config-ini
--- : dep process
--- : dep protolude
--- : dep rainbow
--- : dep req
--- : dep tasty
--- : dep tasty-hunit
--- : dep tasty-quickcheck
 module Biz.Que.Site
   ( main,
   )
diff --git a/Biz/Test.hs b/Biz/Test.hs
index fefa85d..bd1384e 100644
--- a/Biz/Test.hs
+++ b/Biz/Test.hs
@@ -1,8 +1,5 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 
--- : dep tasty
--- : dep tasty-hunit
--- : dep tasty-quickcheck
 module Biz.Test
   ( Tree,
     run,
diff --git a/Control/Concurrent/Sema.hs b/Control/Concurrent/Sema.hs
index 202aa65..21d4709 100644
--- a/Control/Concurrent/Sema.hs
+++ b/Control/Concurrent/Sema.hs
@@ -1,4 +1,4 @@
--- : dep SafeSemaphore
+-- | A stupid Semaphore utility thing
 module Control.Concurrent.Sema
   ( mapPool,
   )
diff --git a/Hero/Host.hs b/Hero/Host.hs
index 6313ae5..7cc5986 100644
--- a/Hero/Host.hs
+++ b/Hero/Host.hs
@@ -15,39 +15,6 @@
 -- | Hero web app
 --
 -- : out mmc
---
--- : dep acid-state
--- : dep aeson
--- : dep clay
--- : dep containers
--- : dep docopt
--- : dep envy
--- : dep http-types
--- : dep ixset
--- : dep lucid
--- : dep miso
--- : dep mtl
--- : dep network-uri
--- : dep protolude
--- : dep rainbow
--- : dep safecopy
--- : dep servant
--- : dep servant-auth
--- : dep servant-auth-server
--- : dep servant-lucid
--- : dep servant-server
--- : dep split
--- : dep tasty
--- : dep tasty-hunit
--- : dep tasty-quickcheck
--- : dep text
--- : dep wai
--- : dep wai-app-static
--- : dep wai-extra
--- : dep wai-middleware-metrics
--- : dep warp
--- : dep x509
--- : dep regex-applicative
 module Hero.Host
   ( main,
   )
diff --git a/Hero/Node.hs b/Hero/Node.hs
index f08732f..11190e7 100644
--- a/Hero/Node.hs
+++ b/Hero/Node.hs
@@ -6,16 +6,6 @@
 -- | Hero app frontend
 --
 -- : out mmc.js
---
--- : dep aeson
--- : dep clay
--- : dep containers
--- : dep miso
--- : dep protolude
--- : dep servant
--- : dep split
--- : dep text
--- : dep ghcjs-base
 module Hero.Node where
 
 import Alpha