diff options
author | Joey Hess <joey@kitenet.net> | 2012-10-30 14:11:14 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-10-30 14:11:14 -0400 |
commit | dbf9ac41086ffb39296bd1d977cc1db844ff0b32 (patch) | |
tree | 357f7397929bc0545b0097e503b4fc2c352a533f | |
parent | 8ccbaabb0a6b85753f9899f6c066e203281f01e4 (diff) |
split out daemonstatus types
-rw-r--r-- | Assistant/Common.hs | 1 | ||||
-rw-r--r-- | Assistant/DaemonStatus.hs | 49 | ||||
-rw-r--r-- | Assistant/Monad.hs | 1 | ||||
-rw-r--r-- | Assistant/Threads/PairListener.hs | 1 | ||||
-rw-r--r-- | Assistant/Threads/PushNotifier.hs | 1 | ||||
-rw-r--r-- | Assistant/Threads/Pusher.hs | 1 | ||||
-rw-r--r-- | Assistant/TransferQueue.hs | 1 | ||||
-rw-r--r-- | Assistant/TransferSlots.hs | 1 | ||||
-rw-r--r-- | Assistant/Types/DaemonStatus.hs | 66 | ||||
-rw-r--r-- | Command/WebApp.hs | 1 |
10 files changed, 71 insertions, 52 deletions
diff --git a/Assistant/Common.hs b/Assistant/Common.hs index ebef9469a..e65564a17 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 44547fbf6..421ade975 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 7db6cbc5e..4286e0afb 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 77f84a4f6..70981b99e 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 b36eb6359..cbc3877bb 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 905cf81db..1dea0a79e 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 125b6d164..daf736c13 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 c41b1d28c..478bb573a 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 000000000..ca4122d55 --- /dev/null +++ b/Assistant/Types/DaemonStatus.hs @@ -0,0 +1,66 @@ +{- git-annex assistant daemon status + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + - + - 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/Command/WebApp.hs b/Command/WebApp.hs index aff760ee4..6a995fdca 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 |