progress-meter 0.1.0 → 1.0.0
raw patch · 4 files changed
+500/−434 lines, 4 filesdep +ansi-terminaldep −containersdep ~asyncdep ~base
Dependencies added: ansi-terminal
Dependencies removed: containers
Dependency ranges changed: async, base
Files
- README.md +1/−1
- progress-meter.cabal +29/−11
- src/System/Progress.hs +470/−0
- src/System/ProgressMeter.hs +0/−422
README.md view
@@ -3,7 +3,7 @@ This library can be used to display progress meters or other diagnostics for concurrently running actions. It supports dynamic creation and-removal of new sub-meters as well es correct behaviour when printing+removal of new sub-meters as well as correct behaviour when printing diagnostics that are not part of the progress meter and should just scroll by.
progress-meter.cabal view
@@ -1,5 +1,5 @@ name: progress-meter-version: 0.1.0+version: 1.0.0 category: System synopsis: Live diagnostics for concurrent activity @@ -11,13 +11,13 @@ license: BSD3 license-file: LICENSE -description: This library can be used to display progress meters or- other diagnostics for concurrently running actions. It supports- dynamic creation and removal of new sub-meters as well es correct- behaviour when printing diagnostics that are not part of the- progress meter and should just scroll by.+description: This library can be used to display a progress bar or+ other live diagnostics for your application. It supports partial+ updates from multiple threads without interfering with each other,+ and it has the correct behaviour when printing diagnostics that are+ not part of the progress bar and should just scroll by. .- The @System.ProgressMeter@ module contains a tutorial.+ The @System.Progress@ module contains a tutorial. build-type: Simple cabal-version: >= 1.10@@ -32,12 +32,17 @@ description: Development dependencies manual: True +flag Examples+ default: False+ description: Build the example programs+ manual: True + library build-depends:- async == 2.1.*,- base >= 4.8 && < 4.10,- containers == 0.5.*,+ ansi-terminal >= 0.6 && < 0.8,+ async >= 2.1.1 && < 2.2,+ base >= 4.8 && < 4.11, stm == 2.4.* if flag(devel) build-depends: rapid, rapid-term@@ -45,4 +50,17 @@ ghc-options: -W hs-source-dirs: src exposed-modules:- System.ProgressMeter+ System.Progress++-- executable pm-http-get+-- if flag(examples)+-- build-depends:+-- base >= 4.8 && < 4.10,+-- http-conduit,+-- progress-meter+-- else+-- buildable: False+-- default-language: Haskell2010+-- ghc-options: -W -threaded+-- hs-source-dirs: examples+-- main-is: pm-http-get.hs
+ src/System/Progress.hs view
@@ -0,0 +1,470 @@+-- |+-- Copyright: (c) 2017 Ertugrul Söylemez+-- License: BSD3+-- Maintainer: Ertugrul Söylemez <esz@posteo.de>+--+-- This module implements a progress bar with support for multiple+-- individual text chunks that can be updated independently (called+-- /meters/).++{-# LANGUAGE RankNTypes #-}++module System.Progress+ ( -- * Tutorial+ -- $tutorial++ -- ** Zooming+ -- $zooming++ -- ** Concurrent updates+ -- $concurrent_updates++ -- ** Further notes+ -- $notes++ -- * Progress bars+ Progress(..),+ withProgress,+ withProgress_,+ -- ** I/O+ meterIO,+ putMsg,+ putMsgLn,++ -- * Meters+ Meter,+ Meter',+ modifyMeter,+ setMeter,+ zoomMeter,+ zoomMeterL,+ -- ** STM variants+ modifyMeterSTM,+ setMeterSTM+ )+ where++import Control.Concurrent+import Control.Concurrent.Async+import Control.Concurrent.STM+import Control.Exception+import Control.Monad+import Data.Functor.Identity+import System.Console.ANSI+import System.IO+++-- | Progress bars displaying state information of the given type++data Progress a =+ Progress {+ progressDelay :: Int, -- ^ Update delay in microseconds+ progressHandle :: Handle, -- ^ Output handle+ progressInitial :: a, -- ^ Initial state+ progressRender :: a -> String -- ^ State renderer+ }+++-- | A value of type @Meter a b@ can be used to update part of the+-- current state of the progress bar by supplying a function of type @(a+-- -> b)@, where @a@ is the type of the current value and @b@ is the+-- type of the new value. See the 'modifyMeter' function for details.+--+-- In most cases you can just assume @a = b@ and use the @Meter'@ alias.++data Meter a b =+ Meter {+ _mModify :: (a -> b) -> STM (),+ _mRunIO :: forall r. (Handle -> IO r) -> IO r+ }+++-- | Handy type alias for the common case where the current state type+-- and the new state type are the same++type Meter' a = Meter a a+++-- | Perform the given action while temporarily hiding the progress bar+--+-- The given action is sequenced with concurrent uses of @meterIO@, so+-- it can be used for regular output without artifacts. The function+-- receives the output handle of the progress bar.++meterIO :: Meter a b -> (Handle -> IO r) -> IO r+meterIO = _mRunIO+++-- | Modify the part of the state represented by the given meter using+-- the given function+--+-- The function receives the current value of type @a@ of the meter and+-- should return the new value of type @b@. Note that for most+-- applications those types will be the same.+--+-- Updates are performed strictly, so they don't pile up when updates+-- are throttled, unless the progress bar is disabled (because the+-- output handle is not a terminal), in which case no state is+-- maintained at all.++modifyMeter :: Meter a b -> (a -> b) -> IO ()+modifyMeter meter = atomically . _mModify meter+++-- | STM variant of 'modifyMeter': modify the given meter in a+-- transaction+--+-- You can use this function to modify multiple meters simultaneously.+-- This is useful, if you want to make sure that users don't observe+-- partial updates.++modifyMeterSTM :: Meter a b -> (a -> b) -> STM ()+modifyMeterSTM = _mModify+++-- | Variant of 'putMsgLn' that omits the final line feed+--+-- Note: Use this function only when the given string ends with a line+-- feed, otherwise the progress bar will overwrite its last line when it+-- is redisplayed.++putMsg :: Meter a b -> String -> IO ()+putMsg meter str = meterIO meter (\h -> hPutStr h str)+++-- | Print the given string to the output handle of the progress bar+--+-- This is implemented in terms of 'meterIO', so it does The Right+-- Thing: it temporarily hides the progress bar, prints the string, then+-- redisplays it. It also makes sure that concurrent messages are+-- properly sequenced.++putMsgLn :: Meter a b -> String -> IO ()+putMsgLn meter str = meterIO meter (\h -> hPutStrLn h str)+++-- | Variant of 'modifyMeter': set the given meter to the given new+-- state+--+-- See 'modifyMeter' for details.++setMeter :: Meter a b -> b -> IO ()+setMeter m = modifyMeter m . const+++-- | Variant of 'modifyMeterSTM': set the given meter to the given new+-- state in a transaction+--+-- See 'modifyMeterSTM' for details.++setMeterSTM :: Meter a b -> b -> STM ()+setMeterSTM m = modifyMeterSTM m . const+++-- | Display a progress bar for the duration of the given action+--+-- Note: If the output handle is not a terminal (as determined by+-- 'hIsTerminalDevice'), no progress bar is displayed and no state is+-- maintained. In this case 'modifyMeter' and 'modifyMeterSTM' are+-- no-ops.+--+-- For most applications the simpler variant 'withProgress_' is+-- sufficient.++withProgress+ :: Progress a -- ^ Progress bar configuration+ -> (Meter' a -> IO r) -- ^ Action with a progress bar+ -> IO r+withProgress prog k = do+ let h = progressHandle prog+ x0 = progressInitial prog++ stateVar <- newTVarIO (progressInitial prog)+ changeVar <- newTVarIO False+ drawLock <- newMVar ()++ let withDrawLock c =+ modifyMVar drawLock (\s -> (,) s <$> c)++ clear = do+ hPutChar h '\r'+ hClearFromCursorToLineEnd h+ hFlush h++ render x = do+ hPutChar h '\r'+ hPutStr h (progressRender prog x)+ hClearFromCursorToLineEnd h+ hFlush h++ renderLoop = (withDrawLock (render x0) >> go)+ `finally` withDrawLock clear+ where+ go = join . atomically $ do+ readTVar changeVar >>= check+ writeTVar changeVar False+ x <- readTVar stateVar+ pure $ do+ withDrawLock (render x)+ threadDelay (progressDelay prog)+ go++ mModify f = do+ x <- f <$> readTVar stateVar+ x `seq` writeTVar stateVar x+ writeTVar changeVar True++ mRunIO f = withDrawLock $ do+ clear+ f h `finally` (atomically (readTVar stateVar) >>= render)++ mRunIONoTerm f = withDrawLock (f h)++ isTerm <- hIsTerminalDevice h+ if isTerm+ then withAsync renderLoop $ \_ ->+ k (Meter { _mModify = mModify,+ _mRunIO = mRunIO })+ else k (Meter { _mModify = const (pure ()),+ _mRunIO = mRunIONoTerm })+++-- | Simpler variant of 'withProgress'+--+-- Uses a delay of 0.1 seconds and displays the progress bar on stderr.++withProgress_+ :: a -- ^ Initial state value+ -> (a -> String) -- ^ State renderer+ -> (Meter' a -> IO r) -- ^ Action with a progress bar+ -> IO r+withProgress_ x0 render = withProgress prog+ where+ prog = Progress {+ progressDelay = 100000,+ progressHandle = stderr,+ progressInitial = x0,+ progressRender = render+ }+++-- | Zoom into part of the state+--+-- This function returns a variant of the given meter that focusses on+-- the value(s) the given setter modifies. You can use this for example+-- to focus on a single key in a map or all the values in a list.+--+-- Examples:+--+-- > -- Zoom into all values of a list (warning: non-strict!):+-- > zoomMeter map :: Meter' [a] -> Meter' a+-- >+-- > -- Zoom into the left component of a tuple:+-- > zoomMeter (\f (x', y) -> let x = f x' in x `seq` (x, y))+-- > :: Meter' (a, b) -> Meter' a+-- >+-- > -- Zoom into the element indexed by the "foo" key,+-- > -- where M = Data.Map.Strict:+-- > zoomMeter (\f -> M.alter f "foo")+-- > :: Meter' (M.Map String a) -> Meter' (Maybe a)+-- >+-- > -- Variant of the previous example that always+-- > -- adds the element if it didn't exist before:+-- > zoomMeter (\f -> M.alter (Just . f) "foo")+-- > :: Meter' (M.Map String a) -> Meter (Maybe a) a++zoomMeter :: ((a -> b) -> s -> t) -> Meter s t -> Meter a b+zoomMeter f meter =+ meter { _mModify = _mModify meter . f }+++-- | Variant of 'zoomMeter' that works with van Laarhoven setters as+-- used by libraries like <https://hackage.haskell.org/package/lens lens>:+--+-- > zoomMeterL f = zoomMeter (over f)+--+-- Keep in mind that most predefined lenses are non-strict. See the+-- tutorial section on zooming to understand why this can be a problem.++zoomMeterL :: ((a -> Identity b) -> s -> Identity t) -> Meter s t -> Meter a b+zoomMeterL f =+ zoomMeter (\g -> runIdentity . f (Identity . g))+++{- $tutorial++A progress bar runs concurrently and redraws itself whenever something+changes to inform the impatient user that, yes, your application is+actually doing stuff. Redraws are throttled to a user-chosen rate in+order not to impact performance in the inconceivable case that changes+come in too frequently.++The 'withProgress_' function adds a progress bar to your application for+the duration of the given action:++> withProgress_+> :: s+> -> (s -> String)+> -> (Meter' s -> IO r)+> -> IO r++Progress bars maintain mutable state of a user-chosen type @s@ and use a+user-supplied rendering function of type @(s -> String)@ in order to+display the current state whenever your application brings itself to+update it. The first argument is the initial state, the second argument+is the rendering function.++For example if you would like to display a simple percentage you could+use @s = 'Int'@ and an initial state of @0@. The rendering function+could turn the plain number into simple text, an ASCII art or any other+single-line entertainment:++> render :: Int -> String+> render x = "Progress: " ++ show x ++ "%"++To change the current state (in this case: the current percentage) you+can use the 'setMeter' function with the @Meter'@ value that your+application receives from 'withProgress_' (simplified type signature):++> setMeter :: Meter' s -> s -> IO ()++Here is a full example in the spirit of the last percent challenging+your patience much worse than the rest:++> import Control.Concurrent+> import Data.Foldable+> import System.Progress+>+> main :: IO ()+> main =+> withProgress_ 0 render $ \pm -> do+> for_ [1..99] $ \p -> do+> threadDelay 20000+> setMeter pm p+> threadDelay 3000000+> setMeter pm 100+> threadDelay 1000000+>+> where+> render :: Int -> String+> render x = "Progress: " ++ show x ++ "%"++From time to time you might like to perform regular output for+diagnostics, logging or other purposes. However, you can't just write+to 'stderr' as that would corrupt the progress bar. Instead you should+use the 'putMsgLn' function (simplified type signature):++> putMsgLn :: Meter' s -> String -> IO ()++You can perform arbitrary actions while temporarily hiding the progress+bar by using the 'meterIO' function, of which 'putMsgLn' is a special+case.++This library fully supports concurrency. You can use 'setMeter' and+'meterIO' from multiple threads. The latter will also properly sequence+concurrent actions, so you can safely output diagnostics from multiple+threads.++-}+++{- $zooming++A meter of type @('Meter'' s)@ allows you update the current state of+type @s@. However, especially in highly concurrent applications it can+be useful to give a thread a meter that updates only the part of the+state that is relevant to that thread. For those applications you can+use the 'zoomMeter' function (simplified type signature):++> zoomMeter :: ((a -> a) -> s -> s) -> Meter' s -> Meter' a++Given a function that can map a function of type @(a -> a)@ over values+of type @s@, this function converts a @('Meter'' s)@ into a @('Meter''+a)@. This is best illustrated with an example. The following function+strictly maps over the left component of a tuple:++> {-# LANGUAGE BangPatterns #-}+>+> mapLeft :: (a -> b) -> (a, c) -> (b, c)+> mapLeft f (x', y) = let !x = f x' in (x, y)++You can use this function with 'zoomMeter' to turn a @('Meter'' (a, b))@+into a @('Meter'' a)@:++> zoomMeter mapLeft :: Meter' (a, b) -> Meter' a++This meter can then be used to update only the left component of the+state. Zooms can be cascaded as well.++If you are using van Laarhoven lenses as defined by the+<https://hackage.haskell.org/package/lens lens library> you can also use+the 'zoomMeterL' function (simplified type signature):++> zoomMeterL :: ASetter' s a -> Meter' s -> Meter' a++Caveat: Unfortunately most if not all of the predefined lenses are+non-strict. As mentioned earlier the progress bar's rendering loop is+throttled, so a state update may not cause an immediate redraw. For+that reason the 'setMeter' function updates the state strictly, so that+updates don't cause unevaluated expressions to pile up. However, it's+only WHNF-strict, so if you do any deep updates using a non-strict+function, they will not be evaluated until the next redraw. The+@mapLeft@ example above is strict in order to avoid that.++The solution is either to write strict lenses by hand, or to make sure+the state type is fully strict in all its fields on all layers.++-}+++{- $concurrent_updates++The rendering loop waits for updates to the current state. Whenever an+update comes in, it redraws the progress bar and then sleeps for a+user-specified duration (0.1 seconds if you use 'withProgress_'). If+further state updates have been done in the meantime, it redraws itself+and sleeps again, etc. Otherwise it waits for updates.++Now imagine you need to do two state updates in a row to inform the user+of a certain change, for example you have done one step to completion+and want to start a new phase:++> setMeter statusMeter "Done with foo, now doing bar"+> setMeter percentMeter 0++If the rendering loop is currently in the waiting phase it is very+likely that the first 'setMeter' will immediately wake up the rendering+thread and cause a redraw, after which it goes to its throttle sleep.+Users would then observe a partial state update for a brief amount of+time (the new message, but not the new percentage). In order to avoid+that you should use the STM variant of 'setMeter' called 'setMeterSTM':++> atomically $ do+> setMeterSTM statusMeter "Done with foo, now doing bar"+> setMeterSTM percentMeter 0++This will make sure that the rendering loop never observes a partial+update.++-}+++{- $notes++* This library does not do any fancy terminal magic; in particular it+ doesn't check the terminal width, so if the text is too long, the user+ may observe some undesired scrolling. You may know this effect from+ @curl@. However, this keeps the implementation simple and portable+ (terminfo is not portable to Windows).++ The author's recommendation is to just ignore this fact. Even if+ you overdraw the progress bar itself will still work, and it will+ span multiple lines properly. The scrolling effect is ugly, but+ doesn't severely impact the user experience.++* The default throttle of 0.1 seconds may seem too low, but it really+ isn't. Keep in mind that the rendering loop does not draw at all,+ unless there are actual updates, so even if your application updates+ very infrequently the default throttle is fine.++-}
− src/System/ProgressMeter.hs
@@ -1,422 +0,0 @@--- |--- Copyright: (c) 2017 Ertugrul Söylemez--- License: BSD3--- Maintainer: Ertugrul Söylemez <esz@posteo.de>------ This module implements a progress bar with support for multiple--- individual text chunks that can be updated independently (called--- /meters/).--{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE RecordWildCards #-}--module System.ProgressMeter- ( -- * Tutorial- -- $tutorial-- -- * Progress handles- Progress,- withProgress,- hWithProgress,- setProgressSep,- -- ** Low-level- newProgress,- runProgress,- quitProgress,-- -- * Meters- Meter,- setMeter,- -- ** Creation and deletion- appendMeter,- deleteMeter,- prependMeter,- withAppendMeter,- withPrependMeter,-- -- * Commands and messages- putCmd,- putMsg,- putMsgLn- )- where--import Control.Applicative-import Control.Concurrent-import Control.Concurrent.Async-import Control.Concurrent.STM-import Control.Exception-import Control.Monad-import Data.Foldable-import Data.IORef-import Data.IntMap.Strict (IntMap)-import qualified Data.IntMap.Strict as Mi-import Data.List (intercalate)-import System.IO-import System.Mem.Weak----- | Handle to an individual progress meter--data Meter =- Meter {- _meterGcVar :: IORef (),- _meterProg :: Progress,- _meterProgVar :: TVar String,- _meterWeakRef :: Weak (IORef ())- }----- | Handle to a progress bar--data Progress =- Progress {- _progCmdVar :: TQueue (Handle -> IO ()),- _progProgsVar :: TVar (IntMap (TVar String)),- _progQuitVar :: TVar Bool,- _progSepVar :: TVar String,- _progSignalVar :: TVar Bool- }----- | Add a progress meter using the given key selection function--addMeterWith :: (forall a. IntMap a -> Int) -> Progress -> IO Meter-addMeterWith key _meterProg@Progress{..} =- mask_ $ do- (k, _meterProgVar) <- atomically $ do- ps <- readTVar _progProgsVar- let k = key ps- progVar <- newTVar mempty- writeTVar _progSignalVar True- (k, progVar) <$ writeTVar _progProgsVar (Mi.insert k progVar ps)- _meterGcVar <- newIORef ()- _meterWeakRef <- mkWeakIORef _meterGcVar . atomically $- modifyTVar _progProgsVar (Mi.delete k)- pure Meter{..}----- | 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.--appendMeter :: Progress -> IO Meter-appendMeter =- addMeterWith (maybe 0 (succ . fst . fst) . Mi.maxViewWithKey)----- | Delete the given progress meter------ Changes to the meter after running this action will not have any--- effect.--deleteMeter :: Meter -> IO ()-deleteMeter Meter{..} = do- finalize _meterWeakRef- atomically (writeTVar (_progSignalVar _meterProg) True)----- | 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.--hWithProgress- :: Int -- ^ Update delay (microseconds)- -> Handle -- ^ Output handle (most likely 'stderr')- -> (Progress -> IO a) -- ^ Action with progress bar- -> IO a-hWithProgress delay h k = do- prog <- newProgress- withAsync (runProgress prog delay h) $ \a ->- k prog `finally` do- quitProgress prog- waitCatch a----- | Create a progress handle using the given update delay (in--- microseconds)------ Note: In most cases you can and should just use 'withProgress'.--newProgress :: IO Progress-newProgress = do- _progCmdVar <- newTQueueIO- _progProgsVar <- newTVarIO mempty- _progQuitVar <- newTVarIO False- _progSepVar <- newTVarIO " | "- _progSignalVar <- newTVarIO False- pure Progress{..}----- | 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.--prependMeter :: Progress -> IO Meter-prependMeter =- addMeterWith (maybe 0 (pred . fst . fst) . Mi.minViewWithKey)----- | 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.--putCmd- :: Progress -- ^ Progress bar- -> (Handle -> IO ()) -- ^ Action to run, receives output handle- -> IO ()-putCmd Progress{..} = atomically . writeTQueue _progCmdVar----- | 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.--putMsg :: Progress -> String -> IO ()-putMsg prog str = putCmd prog (\h -> hPutStr h str)----- | Variant of 'putMsg' that prints a line feed after the message--putMsgLn :: Progress -> String -> IO ()-putMsgLn prog str = putCmd prog (\h -> hPutStrLn h str)----- | Make 'runProgress' clear its display and return------ Note: In most cases you can and should just use 'withProgress'.--quitProgress :: Progress -> IO ()-quitProgress Progress{..} =- atomically (writeTVar _progQuitVar True)----- | 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'.--runProgress :: Progress -> Int -> Handle -> IO ()-runProgress Progress{..} delay h = do- -- NOTE: Terminal width handling is disabled until the wcwidth()- -- function is integrated in some way-- -- widthVar <- newTVarIO 80-- -- let updateTermWidth = do- -- runInBoundThread $ do- -- term <- setupTermFromEnv- -- maybe (pure ())- -- (\w -> atomically (writeTVar widthVar w))- -- (getCapability term (tiGetNum "cols"))- -- stopDelay prog- -- atomically (writeTVar _progSignalVar True)-- -- when isTerm $ Codensity $ \k ->- -- bracket- -- (installHandler sigWINCH (Catch updateTermWidth) Nothing)- -- (\old -> installHandler sigWINCH old Nothing)- -- (\_ -> k ())-- isTerm <- hIsTerminalDevice h-- let go delayA =- join . atomically $- if isTerm- then command <|> quit <|> redrawNow- else commandNoTerm <|> quit-- where- command = do- c <- readTQueue _progCmdVar- writeTVar _progSignalVar True- pure $ do- cancel delayA- hPutStr h "\r\027[2K"- hFlush h- c h `catch` \(SomeException ex) -> do- hPrint h ex- hFlush h- go delayA-- commandNoTerm = do- c <- readTQueue _progCmdVar- pure $ do- c h `catch` \(SomeException ex) -> do- hPrint h ex- hFlush h- go delayA-- quit = do- readTVar _progQuitVar >>= check- pure (cancel delayA)-- redrawNow = do- readTVar _progSignalVar >>= check- waitCatchSTM delayA- writeTVar _progSignalVar False- sep <- readTVar _progSepVar- str <- readTVar _progProgsVar >>=- fmap (intercalate sep . toList) . traverse readTVar- pure $ do- hPutChar h '\r'- hPutStr h str- hPutStr h "\027[K"- hFlush h- async (threadDelay delay) >>= go-- (async (pure ()) >>= go) `finally`- when isTerm (hPutStr h "\r\027[2K" >> hFlush h)----- | Set the text of the given meter--setMeter :: Meter -> String -> IO ()-setMeter Meter{..} str = do- readIORef _meterGcVar- atomically $ do- writeTVar _meterProgVar str- writeTVar (_progSignalVar _meterProg) True----- | Set the separator string between individual meters (@" | "@ by--- default)--setProgressSep :: Progress -> String -> IO ()-setProgressSep Progress{..} sep =- atomically $ do- writeTVar _progSepVar sep- writeTVar _progSignalVar True----- | High-level interface to 'appendMeter' that makes sure the meter is--- deleted after the given action--withAppendMeter :: Progress -> (Meter -> IO a) -> IO a-withAppendMeter prog =- bracket (appendMeter prog)- deleteMeter----- | High-level interface to 'prependMeter' that makes sure the meter is--- deleted after the given action--withPrependMeter :: Progress -> (Meter -> IO a) -> IO a-withPrependMeter prog =- bracket (prependMeter prog)- deleteMeter----- | Variant of 'hWithProgress' that uses 'stderr'--withProgress- :: Int -- ^ Update delay (microseconds)- -> (Progress -> IO a) -- ^ Action with progress bar- -> IO a-withProgress delay = hWithProgress delay stderr---{- $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.---}