diff options
author | 2012-07-29 08:52:57 -0400 | |
---|---|---|
committer | 2012-07-29 08:52:57 -0400 | |
commit | 57203e39811e4e769a6feb576a8779707664c40d (patch) | |
tree | b8b87a96027fa6a9804af9dd7e7d8ccbb685eaf4 /Assistant/Threads/WebApp.hs | |
parent | 62dac858807da8fb62ce55adbed84cfe582367b2 (diff) |
refactor
Diffstat (limited to 'Assistant/Threads/WebApp.hs')
-rw-r--r-- | Assistant/Threads/WebApp.hs | 37 |
1 files changed, 19 insertions, 18 deletions
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index 500297693..3db5f368c 100644 --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -5,7 +5,7 @@ - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings #-} +{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Assistant.Threads.WebApp where @@ -47,9 +47,20 @@ data WebApp = WebApp , getStatic :: Static } -getNotificationBroadcaster :: WebApp -> IO NotificationBroadcaster -getNotificationBroadcaster webapp = notificationBroadcaster - <$> getDaemonStatus (daemonStatus webapp) +waitNotifier :: forall sub. (DaemonStatus -> NotificationBroadcaster) -> NotificationId -> GHandler sub WebApp () +waitNotifier selector nid = do + notifier <- getNotifier selector + liftIO $ waitNotification $ notificationHandleFromId notifier nid + +newNotifier :: forall sub. (DaemonStatus -> NotificationBroadcaster) -> GHandler sub WebApp NotificationId +newNotifier selector = do + notifier <- getNotifier selector + liftIO $ notificationHandleToId <$> newNotificationHandle notifier + +getNotifier :: forall sub. (DaemonStatus -> NotificationBroadcaster) -> GHandler sub WebApp NotificationBroadcaster +getNotifier selector = do + webapp <- getYesod + liftIO $ selector <$> getDaemonStatus (daemonStatus webapp) staticFiles "static" @@ -133,10 +144,7 @@ transfersDisplayIdent = "transfers" -} getTransfersR :: NotificationId -> Handler RepHtml getTransfersR nid = do - {- Block until there is a change from last time. -} - webapp <- getYesod - b <- liftIO $ getNotificationBroadcaster webapp - liftIO $ waitNotification $ notificationHandleFromId b nid + waitNotifier transferNotifier nid page <- widgetToPageContent $ transfersDisplay False hamletToRepHtml $ [hamlet|^{pageBody page}|] @@ -149,9 +157,7 @@ sideBarDisplay noScript = do $(widgetFile "sidebar") unless noScript $ do {- Set up automatic updates of the sidebar. -} - webapp <- lift getYesod - nid <- liftIO $ notificationHandleToId <$> - (newNotificationHandle =<< getNotificationBroadcaster webapp) + nid <- lift $ newNotifier transferNotifier autoUpdate ident (SideBarR nid) (10 :: Int) (10 :: Int) {- Called by client to get a sidebar display. @@ -164,10 +170,7 @@ sideBarDisplay noScript = do -} getSideBarR :: NotificationId -> Handler RepHtml getSideBarR nid = do - {- Block until there is a change from last time. -} - webapp <- getYesod - b <- liftIO $ getNotificationBroadcaster webapp - liftIO $ waitNotification $ notificationHandleFromId b nid + waitNotifier transferNotifier nid page <- widgetToPageContent $ sideBarDisplay True hamletToRepHtml $ [hamlet|^{pageBody page}|] @@ -180,9 +183,7 @@ dashboard noScript warnNoScript = do getHomeR :: Handler RepHtml getHomeR = defaultLayout $ do {- Set up automatic updates for the transfers display. -} - webapp <- lift getYesod - nid <- liftIO $ notificationHandleToId <$> - (newNotificationHandle =<< getNotificationBroadcaster webapp) + nid <- lift $ newNotifier transferNotifier autoUpdate transfersDisplayIdent (TransfersR nid) (10 :: Int) (10 :: Int) dashboard False True |