better ordering of alerts

1 files changed, 39 insertions, 2 deletions

diff --git a/Assistant/Alert.hs b/Assistant/Alert.hs
index 6b0804fd8..648ea5854 100644
--- a/Assistant/Alert.hs
+++ b/Assistant/Alert.hs
@@ -17,8 +17,8 @@ import Yesod
 type Widget = forall sub master. GWidget sub master ()
 
 {- Different classes of alerts are displayed differently. -}
-data AlertClass = Activity | Warning | Error | Success | Message
-	deriving (Eq)
+data AlertClass = Success | Message | Activity | Warning | Error
+	deriving (Eq, Ord)
 
 {- An alert can be a simple message, or an arbitrary Yesod Widget -}
 data AlertMessage = StringAlert String | WidgetAlert Widget
@@ -28,19 +28,53 @@ data Alert = Alert
 	, alertHeader :: Maybe String
 	, alertMessage :: AlertMessage
 	, alertBlockDisplay :: Bool
+	, alertPriority :: AlertPriority
 	}
 
+{- Higher AlertId indicates a more recent alert. -}
+type AlertId = Integer
+
+type AlertPair = (AlertId, Alert)
+
+data AlertPriority = Low | Medium | High
+	deriving (Eq, Ord)
+
+{- The desired order is the reverse of:
+ -
+ - - High priority alerts, newest first
+ - - Medium priority Activity, newest first (mostly used for Activity)
+ - - Low priority alwerts, newest first
+ - - Ties are broken by the AlertClass, with Errors etc coming first.
+ -}
+compareAlertPairs :: AlertPair -> AlertPair -> Ordering
+compareAlertPairs
+	(aid, Alert {alertClass = aclass, alertPriority = aprio})
+	(bid, Alert {alertClass = bclass, alertPriority = bprio})
+	 = compare aprio bprio
+		`thenOrd` compare aid bid
+			`thenOrd` compare aclass bclass
+
+sortAlertPairs :: [AlertPair] -> [AlertPair]
+sortAlertPairs = reverse . sortBy compareAlertPairs
+
 activityAlert :: Maybe String -> String -> Alert
 activityAlert header message = Alert
 	{ alertClass = Activity
 	, alertHeader = header
 	, alertMessage = StringAlert message
 	, alertBlockDisplay = False
+	, alertPriority = Medium
 	}
 
 startupScanAlert :: Alert
 startupScanAlert = activityAlert Nothing "Performing startup scan"
 
+runningAlert :: Alert
+runningAlert = (activityAlert Nothing "Running")
+	{ alertClass = Success
+	, alertPriority = High -- pin above the other activity alerts
+	}
+
 pushAlert :: [Remote] -> Alert
 pushAlert rs = activityAlert Nothing $
 	"Syncing with " ++ unwords (map Remote.name rs)
@@ -59,6 +93,7 @@ syncMountAlert dir rs = Alert
 		, " -- let's get it in sync!"
 		]
 	, alertBlockDisplay = True
+	, alertPriority = Low
         }
 
 scanAlert :: Remote -> Alert
@@ -69,6 +104,7 @@ scanAlert r = Alert
 		[ "Ensuring that ", Remote.name r
 		, "is fully in sync." ]
 	, alertBlockDisplay = True
+	, alertPriority = Low
 	}
 
 sanityCheckAlert :: Alert
@@ -85,4 +121,5 @@ sanityCheckFixAlert msg = Alert
 		, "If these problems persist, consider filing a bug report."
 		]
 	, alertBlockDisplay = True
+	, alertPriority = High
 	}