summaryrefslogtreecommitdiff
path: root/Biz/Bild.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Biz/Bild.hs')
-rw-r--r--Biz/Bild.hs34
1 files changed, 16 insertions, 18 deletions
diff --git a/Biz/Bild.hs b/Biz/Bild.hs
index ae9244a..e2f1ef1 100644
--- a/Biz/Bild.hs
+++ b/Biz/Bild.hs
@@ -110,6 +110,7 @@ import qualified Biz.Log as Log
import Biz.Namespace (Namespace (..))
import qualified Biz.Namespace as Namespace
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
@@ -118,7 +119,6 @@ import qualified Data.ByteString.Internal as BSI
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.Map as Map
@@ -668,22 +668,16 @@ data Proc = Proc
run :: Proc -> IO Exit.ExitCode
run Proc {..} =
Conduit.proc cmd args |> Conduit.streamingProcess
- +> \(Conduit.UseProvidedHandle, stdin_, stderr_, hdl) ->
- loud ?: (verboseLog stdin_ stderr_ hdl, shortLog stdin_ stderr_ hdl)
+ +> \(Conduit.UseProvidedHandle, stdout_, stderr_, hdl) ->
+ Async.Concurrently (loud ?: (puts stdout_, logs ns stdout_))
+ *> Async.Concurrently (loud ?: (puts stderr_, logs ns stderr_))
+ *> Async.Concurrently (putsToTmp stdout_ "/tmp/bild-log.out")
+ *> Async.Concurrently (putsToTmp stderr_ "/tmp/bild-log.err")
+ *> Async.Concurrently (Conduit.waitForStreamingProcess hdl)
+ |> Async.runConcurrently
+> \case
Exit.ExitFailure n -> puts stderr_ >> onFailure >> pure (Exit.ExitFailure n)
Exit.ExitSuccess -> onSuccess >> pure Exit.ExitSuccess
- where
- verboseLog stdin_ stderr_ hdl =
- Async.runConcurrently
- <| Async.Concurrently (puts stdin_)
- *> Async.Concurrently (puts stderr_)
- *> Async.Concurrently (Conduit.waitForStreamingProcess hdl)
- shortLog stdin_ stderr_ hdl =
- Async.runConcurrently
- <| Async.Concurrently (logs ns stdin_)
- *> Async.Concurrently (logs ns stderr_)
- *> Async.Concurrently (Conduit.waitForStreamingProcess hdl)
-- | Helper for running a standard bild subprocess.
proc :: ToNixFlag a => Bool -> Namespace -> a -> [Text] -> IO Exit.ExitCode
@@ -699,13 +693,17 @@ proc loud namespace cmd args =
}
-- | Helper for printing during a subprocess
-puts :: Conduit.ConduitM () ByteString IO () -> IO ()
-puts src = Conduit.runConduit <| src .| Conduit.mapM_ putStr
+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
-- | Like 'puts' but logs the output via 'Biz.Log'.
-logs :: Namespace -> Conduit.ConduitM () ByteString IO () -> IO ()
+logs :: Namespace -> Conduit.ConduitT () ByteString (Conduit.ResourceT IO) () -> IO ()
logs ns src =
- Conduit.runConduit
+ Conduit.runConduitRes
<| src
.| Conduit.mapM_
( BS.filter (/= BSI.c2w '\n')