prune old filler alerts

This commit is contained in:
Joey Hess 2012-07-30 12:21:53 -04:00
parent 40c9973675
commit 8d2667715b
3 changed files with 43 additions and 16 deletions

View file

@ -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