prune old filler alerts

1 files changed, 39 insertions, 6 deletions

diff --git a/Assistant/Alert.hs b/Assistant/Alert.hs
index 23a93b1c1..817a1be27 100644
--- a/Assistant/Alert.hs
+++ b/Assistant/Alert.hs
@@ -12,6 +12,7 @@ module Assistant.Alert where
 import Common.Annex
 import qualified Remote
 
+import qualified Data.Map as M
 import Yesod
 
 type Widget = forall sub master. GWidget sub master ()
@@ -20,6 +21,9 @@ type Widget = forall sub master. GWidget sub master ()
 data AlertClass = Success | Message | Activity | Warning | Error
 	deriving (Eq, Ord)
 
+data AlertPriority = Filler | Low | Medium | High | Pinned
+	deriving (Eq, Ord)
+
 {- An alert can be a simple message, or an arbitrary Yesod Widget. -}
 data AlertMessage = StringAlert String | WidgetAlert (Alert -> Widget)
 
@@ -37,8 +41,19 @@ type AlertId = Integer
 
 type AlertPair = (AlertId, Alert)
 
-data AlertPriority = Filler | Low | Medium | High | Pinned
-	deriving (Eq, Ord)
+type AlertMap = M.Map AlertId Alert
+
+{- This is as many alerts as it makes sense to display at a time.
+ - A display might be smaller ,or larger, the point is to not overwhelm the
+ - user with a ton of alerts. -}
+displayAlerts :: Int
+displayAlerts = 10
+
+{- This is not a hard maximum, but there's no point in keeping a great
+ - many filler alerts in an AlertMap, so when there's more than this many,
+ - they start being pruned, down toward displayAlerts. -}
+maxAlerts :: Int
+maxAlerts = displayAlerts * 2
 
 {- The desired order is the reverse of:
  -
@@ -57,9 +72,12 @@ compareAlertPairs
 		`thenOrd` compare aid bid
 			`thenOrd` compare aclass bclass
 
+sortAlertPairs :: [AlertPair] -> [AlertPair]
+sortAlertPairs = sortBy compareAlertPairs
+
 makeAlertFiller :: Bool -> Alert -> Alert
 makeAlertFiller success alert
-	| alertPriority alert == Filler = alert
+	| isFiller alert = alert
 	| otherwise = alert
 		{ alertClass = if c == Activity then c' else c
 		, alertPriority = Filler
@@ -79,11 +97,26 @@ makeAlertFiller success alert
 			maybe (finished s) (const s) h
 
 		finished s
-			| success = s ++ ": Succeeded"
+			| success = s ++ ": Ok"
 			| otherwise = s ++ ": Failed"
 
-sortAlertPairs :: [AlertPair] -> [AlertPair]
-sortAlertPairs = reverse . sortBy compareAlertPairs
+isFiller :: Alert -> Bool
+isFiller alert = alertPriority alert == Filler
+
+{- Converts a given alert into filler, manipulating it in the AlertMap.
+ -
+ - Old filler alerts are pruned once maxAlerts is reached.
+ -}
+convertToFiller :: AlertId -> Bool -> AlertMap -> AlertMap
+convertToFiller i success m
+	| bloat > 0 = M.fromList $ prune $ M.toList m'
+	| otherwise = m'
+	where
+		bloat = M.size m - maxAlerts
+		m' = M.adjust (\al -> makeAlertFiller success al) i m
+		prune l =
+			let (f, rest) = partition (\(_, al) -> isFiller al) l
+			in drop bloat f ++ rest
 
 baseActivityAlert :: Alert
 baseActivityAlert = Alert