{- Copyright 2016 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}

module UI.Zenity (zenityUI) where

import Types
import Types.UI
import Control.Monad
import System.Process
import Control.Exception
import System.IO
import System.FilePath
import System.Directory
import System.Exit
import qualified Data.ByteString.UTF8 as BU8

zenityUI :: UI
zenityUI = UI
	{ isAvailable = do
		ps <- getSearchPath
		loc <- filterM (\p -> doesFileExist (p </> "zenity")) ps
		return (not (null loc))
	, promptName = name
	, promptPassword = password
	, withProgress = progress
	}

name :: Title -> Desc -> (Name -> Maybe Problem) -> IO (Maybe Name)
name title desc checkproblem = go ""
  where
	go extradesc = do
		h <- runZenity
			[ "--entry"
			, "--title", title
			, "--text", desc ++ "\n" ++ extradesc
			]
		(ret, ok) <- waitZenity h
		if ok
			then 
				let n = Name $ BU8.fromString ret
				in case checkproblem n of
					Nothing -> return $ Just n
					Just problem -> go problem
			else return Nothing

password :: Title -> Desc -> (Password -> Maybe Problem) -> IO (Maybe Password)
password title desc checkproblem = go ""
  where
	go extradesc = do
		h <- runZenity
			[ "--forms"
			, "--title", title
			, "--text", desc ++ "\n" ++ extradesc ++ "\n"
			, "--add-password", "Enter password"
			, "--add-password", "Confirm password"
			, "--separator", "\BEL"
			]
		(ret, ok) <- waitZenity h
		if ok
			then
				let (p1, _:p2) = break (== '\BEL') ret
				in if p1 /= p2
					then go "Passwords didn't match, try again..."
					else
						let p = Password $ BU8.fromString p1
						in case checkproblem p of
							Nothing -> return $ Just p
							Just problem -> go problem
			else return Nothing

progress :: Title -> Desc -> ((Percent -> IO ()) -> IO ()) -> IO ()
progress title desc a = bracket setup teardown (a . sendpercent)
  where
	setup = do
		h <- runZenity
			[ "--progress"
			, "--title", title
			, "--text", desc
			, "--auto-close"
			, "--auto-kill"
			]
		return h
	sendpercent h p = sendZenity h (show p)
	teardown h = do
		_ <- waitZenity h
		return ()

data ZenityHandle = ZenityHandle Handle Handle ProcessHandle

runZenity :: [String] -> IO ZenityHandle
runZenity ps = do
	(Just hin, Just hout, Nothing, ph) <- createProcess
		(proc "zenity" ps)
		{ std_out = CreatePipe
		, std_in = CreatePipe
		}
	return $ ZenityHandle hin hout ph

sendZenity :: ZenityHandle -> String -> IO ()
sendZenity (ZenityHandle hin _ _) s = do
	hPutStrLn hin s
	hFlush hin

waitZenity :: ZenityHandle -> IO (String, Bool)
waitZenity (ZenityHandle hin hout ph) = do
	hClose hin
	ret <- hGetContents hout
	exit <- waitForProcess ph
	return (takeWhile (/= '\n') ret, exit == ExitSuccess)