diff options
| -rw-r--r-- | Biz/Bild.hs | 34 |
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') |