@@ -3,6 +3,7 @@
33{-# LANGUAGE MultiParamTypeClasses #-}
44{-# LANGUAGE MultiWayIf #-}
55{-# LANGUAGE ScopedTypeVariables #-}
6+{-# LANGUAGE TupleSections #-}
67
78-- | An extension of `System.Process` that integrates with logging (`Obelisk.CLI.Logging`)
89-- and is thus spinner friendly.
@@ -12,7 +13,7 @@ module Obelisk.CLI.Process
1213 ) where
1314
1415import Control.Applicative (liftA2)
15−import Control.Monad (void)
16+import Control.Monad (void, (<=<))
1617import Control.Monad.Catch (MonadMask)
1718import Control.Monad.Fix (fix)
1819import Control.Monad.IO.Class (liftIO)
@@ -39,19 +40,24 @@ readProcessAndLogStderr
3940 => Severity -> CreateProcess -> m String
4041readProcessAndLogStderr sev process = do
4142 (out, _err) <- withProcess process $ \_out err -> do
42− streamToLog sev =<< liftIO (handleToInputStream err)
43+ streamToLog =<< liftIO (streamHandle sev err)
4344 -- TODO: Why are we using Text here?
4445 liftIO $ T.unpack . T.strip <$> T.hGetContents out
4546
46−-- | Like `System.Process.callProcess` but logs the combined output (stdout and stderr)
47+-- | Like `System.Process.callProcess` but logs the combined output, including stdout and stderr with the
48+-- corresponding severity.
49+--
50+-- Usually you would call this function as: `callProcessAndLogOutput (Notice, Error)`. However some processes
51+-- are known to spit out diagnostic or informative messages in stderr, in which case you are obviously
52+-- adviced to call it using something else like: `callProcessAndLogOutput (Debug, Debug)`.
4753callProcessAndLogOutput
4854 :: (MonadIO m, MonadMask m, MonadLog Output m)
49− => Severity -> CreateProcess -> m ()
50−callProcessAndLogOutput sev process = do
55+ => (Severity, Severity) -> CreateProcess -> m ()
56+callProcessAndLogOutput (sev_out, sev_err) process = do
5157 void $ withProcess process $ \out err -> do
5258 stream <- liftIO $ do
53− uncurry combineStream =<< liftA2 (,) (handleToInputStream out) (handleToInputStream err)
54− streamToLog sev stream
59+ uncurry combineStream =<< liftA2 (,) (streamHandle sev_out out) (streamHandle sev_err err)
60+ streamToLog stream
5561 where
5662 combineStream s1 s2 = concurrentMerge [s1, s2]
5763
@@ -71,11 +77,15 @@ withProcess process action = do
7177 failWith $ T.pack $ show (cmdspec process) <> " failed with exit code: " <> show code
7278 return (out, err) -- Return the handles
7379
80+-- Create an input stream from the file handle, associating each item with the severity.
81+streamHandle :: Severity -> Handle -> IO (InputStream (Severity, BSC.ByteString))
82+streamHandle sev = Streams.map (sev,) <=< handleToInputStream
83+
7484-- | Read from an input stream and log its contents
7585streamToLog
7686 :: (MonadIO m, MonadMask m, MonadLog Output m)
77− => Severity -> InputStream BSC.ByteString -> m ()
78−streamToLog sev stream = fix $ \loop -> do
87+ => InputStream (Severity, BSC.ByteString) -> m ()
88+streamToLog stream = fix $ \loop -> do
7989 liftIO (Streams.read stream) >>= \case
8090 Nothing -> return ()
81− Just line -> putLogRaw sev (decodeUtf8 line) >> loop
91+ Just (sev, line) -> putLogRaw sev (decodeUtf8 line) >> loop