summaryrefslogtreecommitdiffhomepage
path: root/UI.hs
blob: 6cab66730b1e517e0e39355ecfa5e101730546e1 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
{- Copyright 2016 Joey Hess <id@joeyh.name>
 -
 - 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 UI.NonInteractive
import Control.Concurrent.MVar

availableUIs :: IO [UI]
availableUIs = filterM isAvailable [readlineUI, zenityUI]

selectUI :: Bool -> IO UI
selectUI needgui
	| needgui = do
		ok <- isAvailable zenityUI
		if ok
			then return zenityUI
			else error "zenity is not installed, GUI not available"
	| otherwise = do
		l <- availableUIs
		case l of
			(u:_) -> return u
			[] -> return noninteractiveUI

-- 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