From f78ca9bc5846ae8277d914ae558bf1a0d8c5534f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 30 Oct 2012 14:11:14 -0400 Subject: [PATCH] split out daemonstatus types --- Assistant/Common.hs | 1 + Assistant/DaemonStatus.hs | 49 +---------------------- Assistant/Monad.hs | 1 + Assistant/Threads/PairListener.hs | 1 - Assistant/Threads/PushNotifier.hs | 1 - Assistant/Threads/Pusher.hs | 1 - Assistant/TransferQueue.hs | 1 + Assistant/TransferSlots.hs | 1 + Assistant/Types/DaemonStatus.hs | 66 +++++++++++++++++++++++++++++++ Assistant/WebApp/Configurators.hs | 1 - Assistant/WebApp/DashBoard.hs | 1 - Assistant/WebApp/Notifications.hs | 1 - Assistant/WebApp/SideBar.hs | 1 - Command/WebApp.hs | 1 - 14 files changed, 71 insertions(+), 56 deletions(-) create mode 100644 Assistant/Types/DaemonStatus.hs diff --git a/Assistant/Common.hs b/Assistant/Common.hs index ebef9469a2..e65564a17a 100644 --- a/Assistant/Common.hs +++ b/Assistant/Common.hs @@ -20,6 +20,7 @@ module Assistant.Common ( import Common.Annex as X import Assistant.Monad as X +import Assistant.Types.DaemonStatus as X import Assistant.Alert import Assistant.DaemonStatus diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs index 44547fbf6b..421ade975d 100644 --- a/Assistant/DaemonStatus.hs +++ b/Assistant/DaemonStatus.hs @@ -10,8 +10,7 @@ module Assistant.DaemonStatus where import Common.Annex -import Assistant.Alert -import Assistant.Pairing +import Assistant.Types.DaemonStatus import Utility.TempFile import Utility.NotificationBroadcaster import Logs.Transfer @@ -27,52 +26,6 @@ import Data.Time import System.Locale import qualified Data.Map as M -data DaemonStatus = DaemonStatus - -- False when the daemon is performing its startup scan - { scanComplete :: Bool - -- Time when a previous process of the daemon was running ok - , lastRunning :: Maybe POSIXTime - -- True when the sanity checker is running - , sanityCheckRunning :: Bool - -- Last time the sanity checker ran - , lastSanityCheck :: Maybe POSIXTime - -- Currently running file content transfers - , currentTransfers :: TransferMap - -- Messages to display to the user. - , alertMap :: AlertMap - , lastAlertId :: AlertId - -- Ordered list of remotes to sync with. - , syncRemotes :: [Remote] - -- Pairing request that is in progress. - , pairingInProgress :: Maybe PairingInProgress - -- Broadcasts notifications about all changes to the DaemonStatus - , changeNotifier :: NotificationBroadcaster - -- Broadcasts notifications when queued or current transfers change. - , transferNotifier :: NotificationBroadcaster - -- Broadcasts notifications when there's a change to the alerts - , alertNotifier :: NotificationBroadcaster - } - -type TransferMap = M.Map Transfer TransferInfo - -{- This TMVar is never left empty, so accessing it will never block. -} -type DaemonStatusHandle = TMVar DaemonStatus - -newDaemonStatus :: IO DaemonStatus -newDaemonStatus = DaemonStatus - <$> pure False - <*> pure Nothing - <*> pure False - <*> pure Nothing - <*> pure M.empty - <*> pure M.empty - <*> pure firstAlertId - <*> pure [] - <*> pure Nothing - <*> newNotificationBroadcaster - <*> newNotificationBroadcaster - <*> newNotificationBroadcaster - getDaemonStatus :: DaemonStatusHandle -> IO DaemonStatus getDaemonStatus = atomically . readTMVar diff --git a/Assistant/Monad.hs b/Assistant/Monad.hs index 7db6cbc5ea..4286e0afb8 100644 --- a/Assistant/Monad.hs +++ b/Assistant/Monad.hs @@ -27,6 +27,7 @@ import Control.Monad.Base (liftBase, MonadBase) import Common.Annex import Assistant.Types.ThreadedMonad +import Assistant.Types.DaemonStatus import Assistant.DaemonStatus import Assistant.Types.ScanRemotes import Assistant.TransferQueue diff --git a/Assistant/Threads/PairListener.hs b/Assistant/Threads/PairListener.hs index 77f84a4f6f..70981b99e7 100644 --- a/Assistant/Threads/PairListener.hs +++ b/Assistant/Threads/PairListener.hs @@ -11,7 +11,6 @@ import Assistant.Common import Assistant.Pairing import Assistant.Pairing.Network import Assistant.Pairing.MakeRemote -import Assistant.DaemonStatus import Assistant.WebApp import Assistant.WebApp.Types import Assistant.Alert diff --git a/Assistant/Threads/PushNotifier.hs b/Assistant/Threads/PushNotifier.hs index b36eb63597..cbc3877bbe 100644 --- a/Assistant/Threads/PushNotifier.hs +++ b/Assistant/Threads/PushNotifier.hs @@ -12,7 +12,6 @@ module Assistant.Threads.PushNotifier where import Assistant.Common import Assistant.XMPP -import Assistant.DaemonStatus import Assistant.Pushes import Assistant.Sync import qualified Remote diff --git a/Assistant/Threads/Pusher.hs b/Assistant/Threads/Pusher.hs index 905cf81db6..1dea0a79e8 100644 --- a/Assistant/Threads/Pusher.hs +++ b/Assistant/Threads/Pusher.hs @@ -12,7 +12,6 @@ import Assistant.Commits import Assistant.Types.Commits import Assistant.Pushes import Assistant.Alert -import Assistant.DaemonStatus import Assistant.Sync import Utility.ThreadScheduler import qualified Remote diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs index 125b6d164f..daf736c137 100644 --- a/Assistant/TransferQueue.hs +++ b/Assistant/TransferQueue.hs @@ -23,6 +23,7 @@ module Assistant.TransferQueue ( import Common.Annex import Assistant.DaemonStatus +import Assistant.Types.DaemonStatus import Logs.Transfer import Types.Remote import qualified Remote diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs index c41b1d28c1..478bb573ae 100644 --- a/Assistant/TransferSlots.hs +++ b/Assistant/TransferSlots.hs @@ -12,6 +12,7 @@ module Assistant.TransferSlots where import Common.Annex import Utility.ThreadScheduler import Assistant.DaemonStatus +import Assistant.Types.DaemonStatus import Logs.Transfer import qualified Control.Exception as E diff --git a/Assistant/Types/DaemonStatus.hs b/Assistant/Types/DaemonStatus.hs new file mode 100644 index 0000000000..ca4122d55c --- /dev/null +++ b/Assistant/Types/DaemonStatus.hs @@ -0,0 +1,66 @@ +{- git-annex assistant daemon status + - + - Copyright 2012 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE RankNTypes, ImpredicativeTypes #-} + +module Assistant.Types.DaemonStatus where + +import Common.Annex +import Assistant.Alert +import Assistant.Pairing +import Utility.NotificationBroadcaster +import Logs.Transfer + +import Control.Concurrent.STM +import Data.Time.Clock.POSIX +import qualified Data.Map as M + +data DaemonStatus = DaemonStatus + -- False when the daemon is performing its startup scan + { scanComplete :: Bool + -- Time when a previous process of the daemon was running ok + , lastRunning :: Maybe POSIXTime + -- True when the sanity checker is running + , sanityCheckRunning :: Bool + -- Last time the sanity checker ran + , lastSanityCheck :: Maybe POSIXTime + -- Currently running file content transfers + , currentTransfers :: TransferMap + -- Messages to display to the user. + , alertMap :: AlertMap + , lastAlertId :: AlertId + -- Ordered list of remotes to sync with. + , syncRemotes :: [Remote] + -- Pairing request that is in progress. + , pairingInProgress :: Maybe PairingInProgress + -- Broadcasts notifications about all changes to the DaemonStatus + , changeNotifier :: NotificationBroadcaster + -- Broadcasts notifications when queued or current transfers change. + , transferNotifier :: NotificationBroadcaster + -- Broadcasts notifications when there's a change to the alerts + , alertNotifier :: NotificationBroadcaster + } + +type TransferMap = M.Map Transfer TransferInfo + +{- This TMVar is never left empty, so accessing it will never block. -} +type DaemonStatusHandle = TMVar DaemonStatus + +newDaemonStatus :: IO DaemonStatus +newDaemonStatus = DaemonStatus + <$> pure False + <*> pure Nothing + <*> pure False + <*> pure Nothing + <*> pure M.empty + <*> pure M.empty + <*> pure firstAlertId + <*> pure [] + <*> pure Nothing + <*> newNotificationBroadcaster + <*> newNotificationBroadcaster + <*> newNotificationBroadcaster diff --git a/Assistant/WebApp/Configurators.hs b/Assistant/WebApp/Configurators.hs index aa9f499f33..07dac0c208 100644 --- a/Assistant/WebApp/Configurators.hs +++ b/Assistant/WebApp/Configurators.hs @@ -15,7 +15,6 @@ import Assistant.WebApp.Types import Assistant.WebApp.SideBar import Assistant.WebApp.Utility import Assistant.WebApp.Configurators.Local -import Assistant.DaemonStatus import Assistant.XMPP import Utility.Yesod import qualified Remote diff --git a/Assistant/WebApp/DashBoard.hs b/Assistant/WebApp/DashBoard.hs index 7cf1e41521..4eb786518f 100644 --- a/Assistant/WebApp/DashBoard.hs +++ b/Assistant/WebApp/DashBoard.hs @@ -16,7 +16,6 @@ import Assistant.WebApp.Utility import Assistant.WebApp.SideBar import Assistant.WebApp.Notifications import Assistant.WebApp.Configurators -import Assistant.DaemonStatus import Assistant.TransferQueue import Utility.NotificationBroadcaster import Utility.Yesod diff --git a/Assistant/WebApp/Notifications.hs b/Assistant/WebApp/Notifications.hs index 7e71ee69f8..244785a2f3 100644 --- a/Assistant/WebApp/Notifications.hs +++ b/Assistant/WebApp/Notifications.hs @@ -12,7 +12,6 @@ module Assistant.WebApp.Notifications where import Assistant.Common import Assistant.WebApp import Assistant.WebApp.Types -import Assistant.DaemonStatus import Utility.NotificationBroadcaster import Utility.Yesod diff --git a/Assistant/WebApp/SideBar.hs b/Assistant/WebApp/SideBar.hs index 38ffbabdbe..27d0794077 100644 --- a/Assistant/WebApp/SideBar.hs +++ b/Assistant/WebApp/SideBar.hs @@ -13,7 +13,6 @@ 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 diff --git a/Command/WebApp.hs b/Command/WebApp.hs index aff760ee45..6a995fdcae 100644 --- a/Command/WebApp.hs +++ b/Command/WebApp.hs @@ -11,7 +11,6 @@ import Common.Annex import Command import Assistant import Assistant.Common -import Assistant.DaemonStatus import Assistant.Threads.WebApp import Assistant.WebApp import Assistant.Install