better UI flow through upgrade process

Move button to enable automatic upgrades to an alert displayed after
successful upgrade. Unclutters the UI and makes psychological sense.

3 files changed, 45 insertions, 34 deletions

diff --git a/Assistant/Alert.hs b/Assistant/Alert.hs
index 25a75eeab..e7d3e103d 100644
--- a/Assistant/Alert.hs
+++ b/Assistant/Alert.hs
@@ -15,6 +15,7 @@ import Assistant.Alert.Utility
 import qualified Remote
 import Utility.Tense
 import Logs.Transfer
+import Types.Distribution
 
 import Data.String
 import qualified Data.Text as T
@@ -216,44 +217,42 @@ notFsckedAlert mr button = Alert
 	, alertData = []
 	}
 
-canUpgradeAlert :: AlertPriority -> AlertButton -> Alert
-canUpgradeAlert priority button = Alert
-	{ alertHeader = Just $ fromString $
-		if priority >= High
-			then "An important upgrade of git-annex is available!"
-			else "An upgrade of git-annex is available."
+baseUpgradeAlert :: AlertButton -> TenseText -> Alert
+baseUpgradeAlert button message = Alert
+	{ alertHeader = Just message
 	, alertIcon = Just UpgradeIcon
-	, alertPriority = priority
+	, alertPriority = High
 	, alertButtons = [button]
 	, alertClosable = True
 	, alertClass = Message
 	, alertMessageRender = renderData
 	, alertCounter = 0
 	, alertBlockDisplay = True
-	, alertName = Just CanUpgradeAlert
-	, alertCombiner = Just $ dataCombiner $ \_old new -> new
+	, alertName = Just UpgradeAlert
+	, alertCombiner = Just $ fullCombiner $ \new _old -> new
 	, alertData = []
 	}
 
-upgradeReadyAlert :: [AlertButton] -> Alert
-upgradeReadyAlert buttons = Alert
-	{ alertHeader = Just $ fromString
-		"A new version of git-annex has been installed."
-	, alertIcon = Just UpgradeIcon
-	, alertPriority = High
-	, alertButtons = buttons
-	, alertClosable = True
-	, alertClass = Message
-	, alertMessageRender = renderData
-	, alertCounter = 0
-	, alertBlockDisplay = True
-	, alertName = Just UpgradeReadyAlert
-	, alertCombiner = Just $ dataCombiner $ \_old new -> new
-	, alertData = []
-	}
+canUpgradeAlert :: AlertPriority -> AlertButton -> Alert
+canUpgradeAlert priority button = 
+	(baseUpgradeAlert button $ fromString msg)
+		{ alertPriority = priority }
+  where
+	msg = if priority >= High
+		then "An important upgrade of git-annex is available!"
+		else "An upgrade of git-annex is available."
+
+upgradeReadyAlert :: AlertButton -> Alert
+upgradeReadyAlert button = baseUpgradeAlert button $
+	fromString "A new version of git-annex has been installed."
 
 upgradingAlert :: Alert
-upgradingAlert = activityAlert Nothing [fromString "Upgrading git-annex"]
+upgradingAlert = activityAlert Nothing [ fromString "Upgrading git-annex" ]
+
+upgradeFinishedAlert :: AlertButton -> GitAnnexVersion -> Alert
+upgradeFinishedAlert button version =
+	baseUpgradeAlert button $ fromString $ 
+		"Finished upgrading git-annex to version " ++ version
 
 brokenRepositoryAlert :: AlertButton -> Alert
 brokenRepositoryAlert = errorAlert "Serious problems have been detected with your repository. This needs your immediate attention!"
diff --git a/Assistant/Threads/UpgradeWatcher.hs b/Assistant/Threads/UpgradeWatcher.hs
index 7d0da5818..7cb42e597 100644
--- a/Assistant/Threads/UpgradeWatcher.hs
+++ b/Assistant/Threads/UpgradeWatcher.hs
@@ -23,6 +23,7 @@ import Assistant.Alert
 import Assistant.DaemonStatus
 #ifdef WITH_WEBAPP
 import Assistant.WebApp.Types
+import qualified Build.SysConfig
 #endif
 import qualified Annex
 import Types.Distribution
@@ -35,7 +36,10 @@ data WatcherState = InStartupScan | Started | Upgrading
 	deriving (Eq)
 
 upgradWatcherThread :: UrlRenderer -> NamedThread
-upgradWatcherThread urlrenderer = namedThread "UpgradeWatcher" $ go =<< liftIO programPath
+upgradWatcherThread urlrenderer = namedThread "UpgradeWatcher" $ do
+	whenM (liftIO $ checkSuccessfulUpgrade) $
+		showSuccessfulUpgrade urlrenderer
+	go =<< liftIO programPath
   where
 	go Nothing = debug [ "cannot determine program path" ]
 	go (Just program) = do
@@ -80,7 +84,7 @@ changedFile urlrenderer mvar program file _status
  -}
 sanityCheck :: FilePath -> Assistant Bool
 sanityCheck program = do
-	untilM (liftIO $ nowriter <&&> present) $ do
+	untilM (liftIO $ present <&&> nowriter) $ do
 		debug [program, "is still being written; waiting"]
 		liftIO $ threadDelaySeconds (Seconds 60)
 	debug [program, "has changed, and seems to be ready to run"]
@@ -104,11 +108,20 @@ handleUpgrade urlrenderer = do
 			unattendedUpgrade
 #ifdef WITH_WEBAPP
 		, do
-			finish <- mkAlertButton True (T.pack "Finish Upgrade") urlrenderer (ConfigFinishUpgradeR False)
-			noask <- mkAlertButton True (T.pack "Always Upgrade Automatically") urlrenderer (ConfigFinishUpgradeR True)
-			void $ addAlert $ upgradeReadyAlert
-				[finish, noask { buttonPrimary = False }]
+			button <- mkAlertButton True (T.pack "Finish Upgrade") urlrenderer ConfigFinishUpgradeR
+			void $ addAlert $ upgradeReadyAlert button
 #else
 		, noop
 #endif
 		)
+
+showSuccessfulUpgrade :: UrlRenderer -> Assistant ()
+showSuccessfulUpgrade urlrenderer = do
+#ifdef WITH_WEBAPP
+	button <- mkAlertButton True
+		(T.pack "Enable Automatic Upgrades")
+		urlrenderer ConfigEnableAutomaticUpgradeR
+	void $ addAlert $ upgradeFinishedAlert button Build.SysConfig.packageversion
+#else
+	noop
+#endif
diff --git a/Assistant/Types/Alert.hs b/Assistant/Types/Alert.hs
index 4079802ec..e6fbe86d3 100644
--- a/Assistant/Types/Alert.hs
+++ b/Assistant/Types/Alert.hs
@@ -31,8 +31,7 @@ data AlertName
 	| CloudRepoNeededAlert
 	| SyncAlert
 	| NotFsckedAlert
-	| CanUpgradeAlert
-	| UpgradeReadyAlert
+	| UpgradeAlert
 	deriving (Eq)
 
 {- The first alert is the new alert, the second is an old alert.