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.

1 files changed, 57 insertions, 45 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