module System.Process.Read.Verbosity
( quieter
, noisier
, withModifiedVerbosity
, defaultVerbosity
, verbosity
, runProcess
, runProcessF
, qPutStr
, qPutStrLn
, qMessage
, qMessageLn
, qBracket
) where
import Control.Monad (when)
import Control.Monad.Trans (MonadIO, liftIO)
import System.Process (CreateProcess)
import System.Posix.EnvPlus (getEnv, modifyEnv)
import System.Process.Read.Chunks (Output, NonBlocking)
import System.Process.Read.Convenience (ePutStr, ePutStrLn)
import System.Process.Read.Monad (runProcessS, runProcessQ, runProcessD, runProcessV,
runProcessSF, runProcessVF,
runProcessSE, runProcessQE, runProcessDE)
quieter :: MonadIO m => Int -> m a -> m a
quieter n action = withModifiedVerbosity (\ v -> v n) action
noisier :: MonadIO m => Int -> m a -> m a
noisier n action = withModifiedVerbosity (\ v -> v + n) action
withModifiedVerbosity :: MonadIO m => (Int -> Int) -> m a -> m a
withModifiedVerbosity f action =
verbosity >>= \ v ->
liftIO (modifyEnv "VERBOSITY" (const (Just (show (f v))))) >>
action >>= \ result ->
liftIO (modifyEnv "VERBOSITY" (const (Just (show v)))) >>
return result
defaultVerbosity :: Int
defaultVerbosity = 1
verbosity :: MonadIO m => m Int
verbosity = liftIO $ getEnv "VERBOSITY" >>= return . maybe 1 read
runProcess :: (NonBlocking s c, Enum c, MonadIO m) => CreateProcess -> s -> m [Output s]
runProcess p input = liftIO $
verbosity >>= \ v ->
case v of
_ | v <= 0 -> runProcessS p input
1 -> runProcessQ p input
2 -> runProcessD p input
_ -> runProcessV p input
runProcessF :: (NonBlocking s c, Enum c, MonadIO m) => Maybe (s, s) -> CreateProcess -> s -> m [Output s]
runProcessF prefixes p input = liftIO $
verbosity >>= \ v ->
case v of
_ | v < 0 -> runProcessSF p input
0 -> runProcessSE prefixes p input
1 -> runProcessQE prefixes p input
2 -> runProcessDE prefixes p input
_ -> runProcessVF p input
qPutStrLn :: MonadIO m => String -> m ()
qPutStrLn s = verbosity >>= \ v -> when (v > 0) (ePutStrLn s)
qPutStr :: MonadIO m => String -> m ()
qPutStr s = verbosity >>= \ v -> when (v > 0) (ePutStr s)
qMessage :: MonadIO m => String -> a -> m a
qMessage s x = qPutStr s >> return x
qMessageLn :: MonadIO m => String -> a -> m a
qMessageLn s x = qPutStrLn s >> return x
qBracket :: MonadIO m => String -> m a -> m a
qBracket message action = do
v <- verbosity
case v of
n | n < 1 -> action
1 -> do
qPutStr (message ++ "...")
result <- quieter 1 action
qPutStrLn "done."
return result
n -> do
qPutStrLn message
result <- quieter 1 action
qPutStrLn (message ++ "...done.")
return result