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
|
{- 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
, alertClosable :: Bool
, alertPriority :: AlertPriority
}
{- Higher AlertId indicates a more recent alert. -}
type AlertId = Integer
type AlertPair = (AlertId, Alert)
data AlertPriority = Low | Medium | High | Pinned
deriving (Eq, Ord)
{- 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 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
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
}
|
