blob: 2a007331980dddc45af1c6f1c5e4b19b944a4123 (
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
86
87
88
89
90
91
92
93
94
|
{- 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 :: AlertClass -> Text
bootstrapclass Activity = "alert-info"
bootstrapclass Warning = "alert"
bootstrapclass Error = "alert-error"
bootstrapclass Success = "alert-success"
bootstrapclass Message = "alert-info"
renderalert (aid, alert) = do
let alertid = show aid
let closable = alertClosable alert
let block = alertBlockDisplay alert
let divclass = bootstrapclass $ alertClass alert
$(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
liftIO $ removeAlert (daemonStatus webapp) i
{- When an alert with a button is clicked on, the button takes us here. -}
getClickAlert :: AlertId -> Handler ()
getClickAlert i = do
webapp <- getYesod
m <- alertMap <$> liftIO (getDaemonStatus $ daemonStatus webapp)
case M.lookup i m of
Just (Alert { alertButton = Just b }) -> do
{- Spawn a thread to run the action while redirecting. -}
case buttonAction b of
Nothing -> noop
Just a -> liftIO $ void $ forkIO $ a i
redirect $ buttonUrl b
_ -> redirectBack
|
