1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
|
{- git-annex assistant alerts
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE RankNTypes #-}
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 ()
{- Different classes of alerts are displayed differently. -}
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)
data Alert = Alert
{ alertClass :: AlertClass
, alertHeader :: Maybe String
, alertMessage :: AlertMessage
, alertBlockDisplay :: Bool
, alertClosable :: Bool
, alertPriority :: AlertPriority
}
{- Higher AlertId indicates a more recent alert. -}
type AlertId = Integer
type AlertPair = (AlertId, Alert)
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:
-
- - Pinned alerts
- - High priority alerts, newest first
- - Medium priority Activity, newest first (mostly used for Activity)
- - Low priority alerts, newest first
- - Filler priorty alerts, 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 = sortBy compareAlertPairs
makeAlertFiller :: Bool -> Alert -> Alert
makeAlertFiller success alert
| isFiller alert = alert
| otherwise = alert
{ alertClass = if c == Activity then c' else c
, alertPriority = Filler
, alertHeader = finished <$> h
, alertMessage = massage m
, alertClosable = True
}
where
h = alertHeader alert
m = alertMessage alert
c = alertClass alert
c'
| success = Success
| otherwise = Error
massage (WidgetAlert w) = WidgetAlert w -- renders old on its own
massage (StringAlert s) = StringAlert $
maybe (finished s) (const s) h
finished s
| success = s ++ ": Ok"
| otherwise = s ++ ": Failed"
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
{ alertClass = Activity
, alertHeader = Nothing
, alertMessage = StringAlert ""
, alertBlockDisplay = False
, alertClosable = False
, alertPriority = Medium
}
activityAlert :: Maybe String -> String -> Alert
activityAlert header message = baseActivityAlert
{ alertHeader = header
, alertMessage = StringAlert message
}
startupScanAlert :: Alert
startupScanAlert = activityAlert Nothing "Performing startup scan"
runningAlert :: Alert
runningAlert = baseActivityAlert
{ alertClass = Success
, alertMessage = StringAlert "Running"
, alertPriority = Pinned
}
pushAlert :: [Remote] -> Alert
pushAlert rs = activityAlert Nothing $
"Syncing with " ++ unwords (map Remote.name rs)
pushRetryAlert :: [Remote] -> Alert
pushRetryAlert rs = activityAlert (Just "Retrying sync") $
"with " ++ unwords (map Remote.name rs) ++ ", which failed earlier."
syncMountAlert :: FilePath -> [Remote] -> Alert
syncMountAlert dir rs = baseActivityAlert
{ alertHeader = Just $ "Syncing with " ++ unwords (map Remote.name rs)
, alertMessage = StringAlert $ unwords
["You plugged in"
, dir
, " -- let's get it in sync!"
]
, alertBlockDisplay = True
, alertPriority = Low
}
scanAlert :: Remote -> Alert
scanAlert r = baseActivityAlert
{ alertHeader = Just $ "Scanning " ++ Remote.name r
, alertMessage = StringAlert $ unwords
[ "Ensuring that ", Remote.name r
, "is fully in sync." ]
, alertBlockDisplay = True
, alertPriority = Low
}
sanityCheckAlert :: Alert
sanityCheckAlert = activityAlert (Just "Running daily sanity check")
"to make sure everything is ok."
sanityCheckFixAlert :: String -> Alert
sanityCheckFixAlert msg = Alert
{ alertClass = Warning
, alertHeader = Just "Fixed a problem"
, alertMessage = StringAlert $ unwords
[ "The daily sanity check found and fixed a problem:"
, msg
, "If these problems persist, consider filing a bug report."
]
, alertBlockDisplay = True
, alertPriority = High
, alertClosable = True
}
|
