tweak Alert closability and construction

2 files changed, 23 insertions, 15 deletions

diff --git a/Assistant/Alert.hs b/Assistant/Alert.hs
index 648ea5854..78771b1ea 100644
--- a/Assistant/Alert.hs
+++ b/Assistant/Alert.hs
@@ -28,6 +28,7 @@ data Alert = Alert
 	, alertHeader :: Maybe String
 	, alertMessage :: AlertMessage
 	, alertBlockDisplay :: Bool
+	, alertClosable :: Bool
 	, alertPriority :: AlertPriority
 	}
 
@@ -36,11 +37,12 @@ type AlertId = Integer
 
 type AlertPair = (AlertId, Alert)
 
-data AlertPriority = Low | Medium | High
+data AlertPriority = Low | Medium | High | Pinned
 	deriving (Eq, Ord)
 
 {- The desired order is the reverse of:
  -
+ - - Pinned alerts
  - - High priority alerts, newest first
  - - Medium priority Activity, newest first (mostly used for Activity)
  - - Low priority alwerts, newest first
@@ -57,22 +59,30 @@ compareAlertPairs
 sortAlertPairs :: [AlertPair] -> [AlertPair]
 sortAlertPairs = reverse . sortBy compareAlertPairs
 
-activityAlert :: Maybe String -> String -> Alert
-activityAlert header message = Alert
+baseActivityAlert :: Alert
+baseActivityAlert = Alert
 	{ alertClass = Activity
-	, alertHeader = header
-	, alertMessage = StringAlert message
+	, alertHeader = Nothing
+	, alertMessage = StringAlert ""
 	, alertBlockDisplay = False
+	, alertClosable = False
 	, alertPriority = Medium
 	}
 
+activityAlert :: Maybe String -> String -> Alert
+activityAlert header message = baseActivityAlert
+	{ alertHeader = header
+	, alertMessage = StringAlert message
+	}
+
 startupScanAlert :: Alert
 startupScanAlert = activityAlert Nothing "Performing startup scan"
 
 runningAlert :: Alert
-runningAlert = (activityAlert Nothing "Running")
+runningAlert = baseActivityAlert
 	{ alertClass = Success
-	, alertPriority = High -- pin above the other activity alerts
+	, alertMessage = StringAlert "Running"
+	, alertPriority = Pinned
 	}
 
 pushAlert :: [Remote] -> Alert
@@ -84,9 +94,8 @@ pushRetryAlert rs = activityAlert (Just "Retrying sync") $
 	"with " ++ unwords (map Remote.name rs) ++ ", which failed earlier."
 
 syncMountAlert :: FilePath -> [Remote] -> Alert
-syncMountAlert dir rs = Alert
-	{ alertClass = Activity
-	, alertHeader = Just $ "Syncing with " ++ unwords (map Remote.name rs)
+syncMountAlert dir rs = baseActivityAlert
+	{ alertHeader = Just $ "Syncing with " ++ unwords (map Remote.name rs)
 	, alertMessage = StringAlert $ unwords
 		["I noticed you plugged in"
 		, dir
@@ -97,9 +106,8 @@ syncMountAlert dir rs = Alert
         }
 
 scanAlert :: Remote -> Alert
-scanAlert r = Alert
-	{ alertClass = Activity
-	, alertHeader = Just $ "Scanning " ++ Remote.name r
+scanAlert r = baseActivityAlert
+	{ alertHeader = Just $ "Scanning " ++ Remote.name r
 	, alertMessage = StringAlert $ unwords
 		[ "Ensuring that ", Remote.name r
 		, "is fully in sync." ]
@@ -122,4 +130,5 @@ sanityCheckFixAlert msg = Alert
 		]
 	, alertBlockDisplay = True
 	, alertPriority = High
+	, alertClosable = True
 	}
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs
index 4d37a941a..84b9bcd20 100644
--- a/Assistant/Threads/WebApp.hs
+++ b/Assistant/Threads/WebApp.hs
@@ -177,8 +177,7 @@ sideBarDisplay noScript = do
 
 		renderalert (alertid, alert) = addalert
 			(show alertid)
-			-- Activity alerts auto-close
-			(alertClass alert /= Activity)
+			(alertClosable alert)
 			(alertBlockDisplay alert)
 			(bootstrapclass $ alertClass alert)
 			(alertHeader alert)