easier to use progress display

1 files changed, 17 insertions, 0 deletions

diff --git a/UI.hs b/UI.hs
index 279f6b9..c025bb3 100644
--- a/UI.hs
+++ b/UI.hs
@@ -3,12 +3,15 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE BangPatterns #-}
+
 module UI (module UI, module Types.UI) where
 
 import Types.UI
 import Control.Monad
 import UI.Zenity
 import UI.Readline
+import Control.Concurrent.MVar
 
 availableUIs :: IO [UI]
 availableUIs = filterM isAvailable [readlineUI, zenityUI]
@@ -25,3 +28,17 @@ selectUI needgui
 		case l of
 			(u:_) -> return u
 			[] -> error "Neither zenity nor the readline UI are available"
+
+-- Adds a percent to whatever amount the progress bar is at.
+type AddPercent = Percent -> IO ()
+
+withProgressIncremental :: UI -> Title -> Desc -> (AddPercent -> IO a) -> IO a
+withProgressIncremental ui title desc a = 
+	withProgress ui title desc $ \setpercent -> do
+		v <- newMVar 0
+		let addpercent = \p -> do
+			oldp <- takeMVar v
+			let !newp = oldp + p
+			putMVar v newp
+			setpercent newp
+		a addpercent