1{- git-annex assistant alert types
2 -
3 - Copyright 2013 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8module Assistant.Types.Alert where
9
10import Utility.Tense
11
12import Data.Text (Text)
13import qualified Data.Map as M
14
15{- Different classes of alerts are displayed differently. -}
16data AlertClass = Success | Message | Activity | Warning | Error
17	deriving (Eq, Ord)
18
19data AlertPriority = Filler | Low | Medium | High | Pinned
20	deriving (Eq, Ord)
21
22{- An alert can have an name, which is used to combine it with other similar
23 - alerts. -}
24data AlertName
25	= FileAlert TenseChunk
26	| SanityCheckFixAlert
27	| WarningAlert String
28	| PairAlert String
29	| ConnectionNeededAlert
30	| RemoteRemovalAlert String
31	| CloudRepoNeededAlert
32	| SyncAlert
33	| NotFsckedAlert
34	| UpgradeAlert
35	| UnusedFilesAlert
36	deriving (Eq)
37
38{- The first alert is the new alert, the second is an old alert.
39 - Should return a modified version of the old alert. -}
40type AlertCombiner = Alert -> Alert -> Maybe Alert
41
42data Alert = Alert
43	{ alertClass :: AlertClass
44	, alertHeader :: Maybe TenseText
45	, alertMessageRender :: Alert -> TenseText
46	, alertData :: [TenseChunk]
47	, alertCounter :: Int
48	, alertBlockDisplay :: Bool
49	, alertClosable :: Bool
50	, alertPriority :: AlertPriority
51	, alertIcon :: Maybe AlertIcon
52	, alertCombiner :: Maybe AlertCombiner
53	, alertName :: Maybe AlertName
54	, alertButtons :: [AlertButton]
55	}
56
57data AlertIcon = ActivityIcon | SyncIcon | SuccessIcon | ErrorIcon | InfoIcon | UpgradeIcon | ConnectionIcon
58
59type AlertMap = M.Map AlertId Alert
60
61{- Higher AlertId indicates a more recent alert. -}
62newtype AlertId = AlertId Integer
63	deriving (Read, Show, Eq, Ord)
64
65firstAlertId :: AlertId
66firstAlertId = AlertId 0
67
68nextAlertId :: AlertId -> AlertId
69nextAlertId (AlertId i) = AlertId $ succ i
70
71{- When clicked, a button always redirects to a URL
72 - It may also run an IO action in the background, which is useful
73 - to make the button close or otherwise change the alert. -}
74data AlertButton = AlertButton
75	{ buttonLabel :: Text
76	, buttonUrl :: Text
77	, buttonAction :: Maybe (AlertId -> IO ())
78	, buttonPrimary :: Bool
79	}
80