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
|
{- 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 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)
{- An alert can be a simple message, or an arbitrary Yesod Widget -}
data AlertMessage = StringAlert String | WidgetAlert Widget
data Alert = Alert
{ alertClass :: AlertClass
, 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)
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 = Alert
{ alertClass = Activity
, alertHeader = Just $ "Syncing with " ++ unwords (map Remote.name rs)
, alertMessage = StringAlert $ unwords
["I noticed you plugged in"
, dir
, " -- let's get it in sync!"
]
, alertBlockDisplay = True
, alertPriority = Low
}
scanAlert :: Remote -> Alert
scanAlert r = Alert
{ alertClass = Activity
, 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 I've not missed anything."
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
}
|
