Copyright | (c) 2017 Ertugrul Söylemez |
---|---|
License | BSD3 |
Maintainer | Ertugrul Söylemez <esz@posteo.de> |
Safe Haskell | Safe |
Language | Haskell2010 |
System.ProgressMeter
Description
This module implements a progress bar with support for multiple individual text chunks that can be updated independently (called meters).
- data Progress
- withProgress :: Int -> (Progress -> IO a) -> IO a
- hWithProgress :: Int -> Handle -> (Progress -> IO a) -> IO a
- setProgressSep :: Progress -> String -> IO ()
- newProgress :: IO Progress
- runProgress :: Progress -> Int -> Handle -> IO ()
- quitProgress :: Progress -> IO ()
- data Meter
- setMeter :: Meter -> String -> IO ()
- appendMeter :: Progress -> IO Meter
- deleteMeter :: Meter -> IO ()
- prependMeter :: Progress -> IO Meter
- withAppendMeter :: Progress -> (Meter -> IO a) -> IO a
- withPrependMeter :: Progress -> (Meter -> IO a) -> IO a
- putCmd :: Progress -> (Handle -> IO ()) -> IO ()
- putMsg :: Progress -> String -> IO ()
- putMsgLn :: Progress -> String -> IO ()
Tutorial
First you need to create a progress bar. The easiest way is to use the
withProgress
function:
withProgress 100000 $ \prog -> do -- stuff --
The first argument to the function is the update delay in microseconds.
Each time the bar display is updated, a timer of that duration is
started, during which no further updates are drawn. When the action
given to withProgress
finishes, the display is cleared.
In order to actually draw something you need to create a Meter
, which
corresponds to a dynamic-width space within the progress bar. The
recommended interfaces to do that are withAppendMeter
and
withPrependMeter
. The function setMeter
sets the content of that
meter. Example:
import Control.Concurrent import System.ProgressMeter main = withProgress 100000 $ \prog -> withAppendMeter prog $ \meter -> do setMeter meter "Hello ..." threadDelay 1000000 setMeter meter "... world!" threadDelay 1000000
In many applications you will want to print diagnostic messages that
should not be treated as part of the progress bar, but should just
scroll by as regular terminal text. You can do that by using putCmd
,
putMsg
and putMsgLn
:
import Control.Concurrent import System.ProgressMeter main = withProgress 100000 $ \prog -> withAppendMeter prog $ \meter -> do setMeter meter "Hello ..." threadDelay 1000000 putMsgLn prog "Some diagnostics." threadDelay 1000000 putMsgLn prog "Some more diagnostics." threadDelay 1000000 setMeter meter "... world!" threadDelay 1000000 putMsgLn prog "More and more diagnostics." threadDelay 1000000
Of course the main purpose of this library is to show a progress bar for concurrent activity. Therefore meters can be created and updated from separate threads. Run the following program and watch how the individual threads update their meters, print diagnostics and disappear concurrently:
import Control.Concurrent import Control.Concurrent.Async import Control.Monad import Data.Foldable import Text.Printf main = withProgress 500000 $ \prog -> let thread n = do threadDelay (100000*n) withAppendMeter prog $ \meter -> do putMsgLn prog (printf "Thread %d started." n) for_ [0..100 :: Int] $ \p -> do when (p == 50) $ putMsgLn prog (printf "Thread %d reached half-way point." n) setMeter meter (printf "T%d: %d%%" n p) threadDelay (280000 - 40000*n) putMsgLn prog (printf "Thread %d done." n) threadDelay 500000 in mapConcurrently_ thread [1..6]
The actual terminal handling is very conservative. Only ANSI codes are
used to draw the display, and terminal width is not taken into account
in this version. If the output handle is not a terminal, the meters are
not drawn, but only messages sent by putMsg
and putMsgLn
are
printed.
Progress handles
Variant of hWithProgress
that uses stderr
Arguments
:: Int | Update delay (microseconds) |
-> Handle | Output handle (most likely |
-> (Progress -> IO a) | Action with progress bar |
-> IO a |
High-level interface to create a progress bar
This action creates a progress bar with the given update delay (in microseconds) on the given output handle and runs it in a background thread. It passes the progress handle to the given function and quits the bar after the action completes.
setProgressSep :: Progress -> String -> IO () Source #
Set the separator string between individual meters (" | "
by
default)
Low-level
newProgress :: IO Progress Source #
Create a progress handle using the given update delay (in microseconds)
Note: In most cases you can and should just use withProgress
.
runProgress :: Progress -> Int -> Handle -> IO () Source #
Run the given progress bar
If the given handle is not a terminal, this action
Note: In most cases you can and should just use withProgress
.
quitProgress :: Progress -> IO () Source #
Make runProgress
clear its display and return
Note: In most cases you can and should just use withProgress
.
Meters
Creation and deletion
appendMeter :: Progress -> IO Meter Source #
Append a new progress meter to the given progress bar
The meter is removed when garbage-collected or when deleteMeter
is
used. The latter is preferable.
deleteMeter :: Meter -> IO () Source #
Delete the given progress meter
Changes to the meter after running this action will not have any effect.
prependMeter :: Progress -> IO Meter Source #
Prepend a new progress to the given progress bar
The meter is removed when garbage-collected or when deleteMeter
is
used. The latter is preferable.
withAppendMeter :: Progress -> (Meter -> IO a) -> IO a Source #
High-level interface to appendMeter
that makes sure the meter is
deleted after the given action
withPrependMeter :: Progress -> (Meter -> IO a) -> IO a Source #
High-level interface to prependMeter
that makes sure the meter is
deleted after the given action
Commands and messages
Send an action to be executed by the progress bar after temporarily clearing its display
This function can be used, for example, to print something safely. It returns immediately after queuing the action. Commands are executed in the order they are sent.
Actions sent by this function are not subject to the update delay and cause the display to be redrawn immediately.
putMsg :: Progress -> String -> IO () Source #
Send a message to be printed by the progress bar after temporarily clearing its display
Messages are printed in the order they are sent. Note: unless the message includes a line feed, it will most likely be overwritten by the progress bar.
Messages sent by this function are not subject to the update delay and cause the display to be redrawn immediately.