prune old filler alerts
This commit is contained in:
parent
40c9973675
commit
8d2667715b
3 changed files with 43 additions and 16 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue