blob: 20fd09c2e2f60e0f0535d5626f513883df88e5eb (
plain)
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
|
{- git-annex assistant webapp sidebar
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-}
module Assistant.WebApp.SideBar where
import Assistant.Common
import Assistant.WebApp
import Assistant.WebApp.Types
import Assistant.WebApp.Notifications
import Assistant.DaemonStatus
import Assistant.Alert
import Utility.NotificationBroadcaster
import Utility.Yesod
import Yesod
import Data.Text (Text)
import qualified Data.Map as M
import Control.Concurrent
sideBarDisplay :: Widget
sideBarDisplay = do
let content = do
{- Add newest alerts to the sidebar. -}
webapp <- lift getYesod
alertpairs <- M.toList . alertMap
<$> liftIO (getDaemonStatus $ daemonStatus webapp)
mapM_ renderalert $
take displayAlerts $ reverse $ sortAlertPairs alertpairs
let ident = "sidebar"
$(widgetFile "sidebar/main")
autoUpdate ident NotifierSideBarR (10 :: Int) (10 :: Int)
where
bootstrapclass Activity = "alert-info"
bootstrapclass Warning = "alert"
bootstrapclass Error = "alert-error"
bootstrapclass Success = "alert-success"
bootstrapclass Message = "alert-info"
renderalert (alertid, alert) = addalert
alertid
(alertClosable alert)
(alertBlockDisplay alert)
(bootstrapclass $ alertClass alert)
(renderAlertHeader alert)
(renderAlertMessage alert)
(alertIcon alert)
addalert :: AlertId -> Bool -> Bool -> Text -> Maybe Text -> Text -> Maybe String -> Widget
addalert i closable block divclass heading message icon = do
let alertid = show i
$(widgetFile "sidebar/alert")
{- Called by client to get a sidebar display.
-
- Returns a div, which will be inserted into the calling page.
-
- Note that the head of the widget is not included, only its
- body is. To get the widget head content, the widget is also
- inserted onto all pages.
-}
getSideBarR :: NotificationId -> Handler RepHtml
getSideBarR nid = do
waitNotifier alertNotifier nid
{- This 0.1 second delay avoids very transient notifications from
- being displayed and churning the sidebar unnecesarily.
-
- This needs to be below the level perceptable by the user,
- to avoid slowing down user actions like closing alerts. -}
liftIO $ threadDelay 100000
page <- widgetToPageContent sideBarDisplay
hamletToRepHtml $ [hamlet|^{pageBody page}|]
{- Called by the client to close an alert. -}
getCloseAlert :: AlertId -> Handler ()
getCloseAlert i = do
webapp <- getYesod
void $ liftIO $ removeAlert (daemonStatus webapp) i
|
