Log and return output to caller

The main change here is 'puts' now returns a value, this enables me to
collect the value from the conduit source while also doing stuff with
it, like printing or logging it as I want.

Previously I was running conduit over the source, *and then* kicking off
the concurrent processes to wait for the process and collect the output.
This would (I think) drain the source before it got to the 'puts'
conduit run, and so I wouldn't be able to get the output streamed in
real time.

It took a lot of refactoring and exploratory programming to get to this
relatively-small diff, but now puts works correctly. At least I think it
does... it seems to work more reliably from ghci than from the shell.
Maybe the shell or TERM is causing nix-store to do some buffering? Maybe
I need to use the threaded runtime in GHC? Not sure, but I will look out
for this issue and try to identify and fix.

Update: yep it was the threaded runtime. I enabled that and now it works
in the shell. I squashed that commit into this one.

5 files changed, 66 insertions, 50 deletions

diff --git a/Biz/Bild.hs b/Biz/Bild.hs
index 2dc1e64..a9988d5 100644
--- a/Biz/Bild.hs
+++ b/Biz/Bild.hs
@@ -125,19 +125,20 @@ import qualified Biz.Test as Test
 import qualified Conduit
 import qualified Control.Concurrent.Async as Async
 import qualified Data.Aeson as Aeson
-import qualified Data.ByteString as BS
+import qualified Data.ByteString as ByteString
 import qualified Data.ByteString.Char8 as Char8
 import qualified Data.ByteString.Internal as BSI
-import qualified Data.ByteString.Lazy as ByteString
+import qualified Data.ByteString.Lazy as ByteString.Lazy
 import qualified Data.Char as Char
 import Data.Conduit ((.|))
-import qualified Data.Conduit.List as Conduit
+import qualified Data.Conduit.Combinators as Conduit
 import qualified Data.Conduit.Process as Conduit
 import qualified Data.Map as Map
 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 Network.HostName as HostName
 import qualified System.Directory as Dir
 import qualified System.Environment as Env
 import qualified System.Exit as Exit
@@ -148,7 +149,7 @@ import qualified System.Process as Process
 import qualified Text.Regex.Applicative as Regex
 
 main :: IO ()
-main = Cli.main <| Cli.Plan help move test_ pure
+main = Cli.Plan help move test_ pure |> Cli.main
   where
     test_ =
       Test.group
@@ -189,19 +190,19 @@ test_bildExamples =
           xs -> all (== Exit.ExitSuccess) xs @=? True
 
 move :: Cli.Arguments -> IO ()
-move args = do
-  root <- Env.getEnv "BIZ_ROOT"
+move args =
   IO.hSetBuffering stdout IO.NoBuffering
-    >> pure (Cli.getAllArgs args (Cli.argument "target"))
-      /> filter (not <. Namespace.isCab)
-      +> filterM Dir.doesFileExist
-      +> traverse Dir.makeAbsolute
-      /> map (Namespace.fromPath root)
-      /> catMaybes
-      +> foldM analyze mempty
-      /> Map.filter (namespace .> isBuildableNs)
-      +> printOrBuild
-      +> exitSummary
+    >> Env.getEnv "BIZ_ROOT" +> \root ->
+      Cli.getAllArgs args (Cli.argument "target")
+        |> filter (not <. Namespace.isCab)
+        |> filterM Dir.doesFileExist
+        +> traverse Dir.makeAbsolute
+        /> map (Namespace.fromPath root)
+        /> catMaybes
+        +> foldM analyze mempty
+        /> Map.filter (namespace .> isBuildableNs)
+        +> printOrBuild
+        +> exitSummary
   where
     printOrBuild :: Analysis -> IO [ExitCode]
     printOrBuild targets
@@ -213,7 +214,7 @@ move args = do
           build isTest isLoud targets
     isTest = args `Cli.has` Cli.longOption "test"
     isLoud = args `Cli.has` Cli.longOption "loud"
-    putJSON = Aeson.encode .> ByteString.toStrict .> Char8.putStrLn
+    putJSON = Aeson.encode .> ByteString.Lazy.toStrict .> Char8.putStrLn
 
 nixStore :: String
 nixStore = "/nix/store/00000000000000000000000000000000-"
@@ -420,7 +421,7 @@ analyze hmap ns = case Map.lookup ns hmap of
       root <- Env.getEnv "BIZ_ROOT"
       let absPath = root </> path
       user <- Env.getEnv "USER" /> Text.pack
-      host <- Env.lookupEnv "HOSTNAME" /> fromMaybe "interactive" /> Text.pack
+      host <- HostName.getHostName /> Text.pack
       Log.info ["bild", "analyze", str path]
       let runw cmd args = Process.readProcess cmd args "" /> Text.pack /> Text.words
       contentLines <-
@@ -516,6 +517,7 @@ analyze hmap ns = case Map.lookup ns hmap of
                     packageSet = "ghcWith",
                     compilerFlags =
                       [ "-Werror",
+                        "-threaded",
                         "-i$BIZ_ROOT",
                         "-odir",
                         ".",
@@ -798,27 +800,30 @@ data Proc = Proc
 -- | Run a subprocess, streaming output if --loud is set.
 run :: Proc -> IO (Exit.ExitCode, ByteString)
 run Proc {..} = do
-  loud ?| Log.info ["proc", unwords <| map str <| cmd : args] >> Log.br
+  IO.hSetBuffering stdout IO.NoBuffering
+  loud ?| Log.info ["proc", unwords <| map str <| cmd : args]
   Conduit.proc cmd args
     |> Conduit.streamingProcess
     +> \(Conduit.UseProvidedHandle, stdout_, stderr_, hdl) ->
-      Conduit.runConduitRes (stdout_ .| Conduit.foldC)
-        +> \output ->
-          Async.Concurrently (loud ?: (puts stdout_, logs ns stdout_))
-            *> Async.Concurrently (loud ?: (puts stderr_, logs ns stderr_))
-            *> Async.Concurrently (Conduit.waitForStreamingProcess hdl)
-              |> Async.runConcurrently
-              +> \case
-                Exit.ExitFailure n ->
-                  puts stderr_
-                    >> onFailure
-                    >> pure (Exit.ExitFailure n, output)
-                Exit.ExitSuccess ->
-                  onSuccess
-                    >> pure (Exit.ExitSuccess, output)
+      (,,) </ Async.Concurrently (Conduit.waitForStreamingProcess hdl)
+        <*> Async.Concurrently (loud ?: (puts stdout_, logs ns stdout_))
+        <*> Async.Concurrently (loud ?: (puts stderr_, logs ns stderr_))
+          |> Async.runConcurrently
+          +> \case
+            (Exit.ExitFailure n, output, outerr) ->
+              putStr outerr
+                >> onFailure
+                >> pure (Exit.ExitFailure n, output)
+            (Exit.ExitSuccess, output, _) ->
+              onSuccess >> pure (Exit.ExitSuccess, output)
 
 -- | Helper for running a standard bild subprocess.
-proc :: Bool -> Namespace -> String -> [Text] -> IO (Exit.ExitCode, ByteString)
+proc ::
+  Bool ->
+  Namespace ->
+  String ->
+  [Text] ->
+  IO (Exit.ExitCode, ByteString)
 proc loud namespace cmd args =
   Proc
     { loud = loud,
@@ -831,25 +836,31 @@ proc loud namespace cmd args =
     |> run
 
 -- | Helper for printing during a subprocess
-puts :: Conduit.ConduitT () ByteString (Conduit.ResourceT IO) () -> IO ()
-puts src = Conduit.runConduitRes <| src .| Conduit.mapM_ putStr
-
--- | Like 'puts' but the output goes to a file. Maybe this should use /tmp by default though?
-putsToTmp :: Conduit.ConduitT () ByteString (Conduit.ResourceT IO) () -> FilePath -> IO ()
-putsToTmp src filepath = Conduit.runConduitRes <| src .| Conduit.sinkFile filepath
+puts ::
+  Conduit.ConduitT () ByteString (Conduit.ResourceT IO) () ->
+  IO ByteString
+puts src =
+  Conduit.runConduitRes
+    <| src
+    .| Conduit.iterM (liftIO <. putStr)
+    .| Conduit.foldC
 
 -- | Like 'puts' but logs the output via 'Biz.Log'.
-logs :: Namespace -> Conduit.ConduitT () ByteString (Conduit.ResourceT IO) () -> IO ()
+logs ::
+  Namespace ->
+  Conduit.ConduitT () ByteString (Conduit.ResourceT IO) () ->
+  IO ByteString
 logs ns src =
   Conduit.runConduitRes
     <| src
-    .| Conduit.mapM_
-      ( BS.filter (/= BSI.c2w '\n')
+    .| Conduit.iterM
+      ( ByteString.filter (/= BSI.c2w '\n')
           .> (\t -> Log.fmt ["info", "bild", nschunk ns, decodeUtf8 t])
-          .> Text.take 77
-          .> (<> "...\r")
+          .> Text.take 79
+          .> (<> "…\r")
           .> putStr
       )
+    .| Conduit.foldC
 
 nschunk :: Namespace -> Text
 nschunk = Namespace.toPath .> Text.pack
@@ -886,6 +897,7 @@ nixBuild :: Bool -> Target -> IO (Exit.ExitCode, ByteString)
 nixBuild loud Target {..} =
   Env.getEnv "BIZ_ROOT" +> \root ->
     instantiate root |> run +> \case
+      (_, "") -> panic "instantiate did not produce a drv"
       (Exit.ExitSuccess, drv) ->
         drv
           |> str
diff --git a/Biz/Bild.nix b/Biz/Bild.nix
index 0391d84..dca1b3b 100644
--- a/Biz/Bild.nix
+++ b/Biz/Bild.nix
@@ -32,7 +32,7 @@ rec {
     ghcPackageSetBild = private.ghcWith (hpkgs: with hpkgs; [
       aeson async base bytestring conduit conduit-extra containers directory
       docopt filepath process protolude rainbow regex-applicative split tasty
-      tasty-hunit tasty-quickcheck text neat-interpolation
+      tasty-hunit tasty-quickcheck text hostname
       wai # can remove when removed from Biz.Log
     ]);
 
@@ -50,14 +50,13 @@ rec {
     # this is just to get access to ghc-pkg in bild
     (private.ghcWith (hpkgs: with hpkgs; []))
 
-    /* disable until nixified builds are complete
+    /* disable until nixified builds are complete */
     rustc
     # c deps
     gcc gdb valgrind argp-standalone SDL
     # lisp deps
     guile
     (private.sbclWith (p: with p; [asdf alexandria])) # just enough to build Example.lisp
-    */
   ];
 
   # a standard nix build for `bild` - this should be the only hand-written
@@ -75,6 +74,7 @@ rec {
         ${private.ghcPackageSetFull}/lib/ghc-${private.ghcPackageSetFull.version}/package.conf.d \
         $out/lib/ghc-${private.ghcPackageSetFull.version}
       ghc \
+        -threaded \
         -Werror \
         -i. \
         --make Biz/Bild.hs \
diff --git a/Biz/Bild/Deps/Haskell.nix b/Biz/Bild/Deps/Haskell.nix
index d8108d7..066fd86 100644
--- a/Biz/Bild/Deps/Haskell.nix
+++ b/Biz/Bild/Deps/Haskell.nix
@@ -27,6 +27,7 @@ with hpkgs;
   hashids
   haskeline
   hmacaroons
+  hostname
   http-types
   ixset
   katip
diff --git a/Biz/Lint.hs b/Biz/Lint.hs
index b1cc0d4..f9b16d0 100644
--- a/Biz/Lint.hs
+++ b/Biz/Lint.hs
@@ -14,7 +14,6 @@ import Biz.Namespace (Ext (..), Namespace (..))
 import qualified Biz.Namespace as Namespace
 import Biz.Test ((@=?))
 import qualified Biz.Test as Test
-import qualified Control.Concurrent.Async as Async
 import qualified Data.String as String
 import qualified Data.Text as Text
 import qualified System.Directory as Directory
@@ -153,7 +152,7 @@ run :: Mode -> [FilePath] -> IO [Result]
 run mode paths = do
   cwd <- Directory.getCurrentDirectory
   root <- Environment.getEnv "BIZ_ROOT"
-  concat </ Async.mapConcurrently (runOne mode root cwd) paths
+  concat </ traverse (runOne mode root cwd) paths
 
 runOne :: Mode -> FilePath -> FilePath -> FilePath -> IO [Result]
 runOne mode root cwd path_ = results +> traverse_ printResult >> results
diff --git a/Biz/Log.hs b/Biz/Log.hs
index a1afd1d..8dba657 100644
--- a/Biz/Log.hs
+++ b/Biz/Log.hs
@@ -10,6 +10,10 @@
 --
 --    * don't use `br` after `info`, unless verbose mode is requested (--loud flag in bild)
 --
+--    * always use `br` after `good`, `fail`, and `pass`
+--
+--    * often use `br` after `warn`, unless its really unimportant
+--
 --    * labels should be roughly hierarchical from general->specific
 module Biz.Log
   ( Lvl (..),