better ordering of alerts

This commit is contained in:
Joey Hess 2012-07-29 19:05:51 -04:00
parent d52c932424
commit d62b157194
6 changed files with 60 additions and 15 deletions

View file

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