From fdc80b7a2416782d3208acf154fb8afb7fb2279b Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 19 Aug 2016 14:10:15 -0400
Subject: easier to use progress display

---
 UI.hs | 17 +++++++++++++++++
 1 file changed, 17 insertions(+)

(limited to 'UI.hs')

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
-- 
cgit v1.2.3