summaryrefslogtreecommitdiff
path: root/Assistant/Threads/ConfigMonitor.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-10-29 11:40:22 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-10-29 11:40:22 -0400
commitf901112e1ce30f43dc7294e0bd0616bb02556500 (patch)
tree92ab6d6f220ea21e0cc7feeff6caca52d4d2b677 /Assistant/Threads/ConfigMonitor.hs
parent710dfa7e3ec897d6f02930540b10bb303e3a9c91 (diff)
converted 6 more threads
Diffstat (limited to 'Assistant/Threads/ConfigMonitor.hs')
-rw-r--r--Assistant/Threads/ConfigMonitor.hs72
1 files changed, 33 insertions, 39 deletions
diff --git a/Assistant/Threads/ConfigMonitor.hs b/Assistant/Threads/ConfigMonitor.hs
index 2d5df48dd..fe98b10e8 100644
--- a/Assistant/Threads/ConfigMonitor.hs
+++ b/Assistant/Threads/ConfigMonitor.hs
@@ -9,7 +9,6 @@ module Assistant.Threads.ConfigMonitor where
import Assistant.Common
import Assistant.BranchChange
-import Assistant.ThreadedMonad
import Assistant.DaemonStatus
import Assistant.Commits
import Utility.ThreadScheduler
@@ -19,10 +18,8 @@ import Logs.Remote
import Logs.PreferredContent
import Logs.Group
import Remote.List (remoteListRefresh)
-import qualified Git
import qualified Git.LsTree as LsTree
import qualified Annex.Branch
-import qualified Annex
import qualified Data.Set as S
@@ -37,26 +34,22 @@ thisThread = "ConfigMonitor"
- if the branch has not changed in a while, configuration changes will
- be detected immediately.
-}
-configMonitorThread :: ThreadState -> DaemonStatusHandle -> BranchChangeHandle -> CommitChan -> NamedThread
-configMonitorThread st dstatus branchhandle commitchan = thread $ liftIO $ do
- r <- runThreadState st Annex.gitRepo
- go r =<< getConfigs r
- where
- thread = NamedThread thisThread
-
- go r old = do
- threadDelaySeconds (Seconds 60)
- waitBranchChange branchhandle
- new <- getConfigs r
- when (old /= new) $ do
- let changedconfigs = new `S.difference` old
- brokendebug thisThread $ "reloading config" :
- map fst (S.toList changedconfigs)
- reloadConfigs st dstatus changedconfigs
- {- Record a commit to get this config
- - change pushed out to remotes. -}
- recordCommit commitchan
- go r new
+configMonitorThread :: NamedThread
+configMonitorThread = NamedThread "ConfigMonitor" $ loop =<< getConfigs
+ where
+ loop old = do
+ liftIO $ threadDelaySeconds (Seconds 60)
+ waitBranchChange <<~ branchChangeHandle
+ new <- getConfigs
+ when (old /= new) $ do
+ let changedconfigs = new `S.difference` old
+ debug $ "reloading config" :
+ map fst (S.toList changedconfigs)
+ reloadConfigs new
+ {- Record a commit to get this config
+ - change pushed out to remotes. -}
+ recordCommit <<~ commitChan
+ loop new
{- Config files, and their checksums. -}
type Configs = S.Set (FilePath, String)
@@ -73,22 +66,23 @@ configFilesActions =
, (preferredContentLog, noop)
]
-reloadConfigs :: ThreadState -> DaemonStatusHandle -> Configs -> IO ()
-reloadConfigs st dstatus changedconfigs = runThreadState st $ do
- sequence_ as
- void preferredContentMapLoad
+reloadConfigs :: Configs -> Assistant ()
+reloadConfigs changedconfigs = do
+ liftAnnex $ do
+ sequence_ as
+ void preferredContentMapLoad
{- Changes to the remote log, or the trust log, can affect the
- syncRemotes list -}
- when (Logs.Remote.remoteLog `elem` fs || Logs.Trust.trustLog `elem` fs) $
- updateSyncRemotes dstatus
- where
- (fs, as) = unzip $ filter (flip S.member changedfiles . fst)
- configFilesActions
- changedfiles = S.map fst changedconfigs
+ when (Logs.Remote.remoteLog `elem` fs || Logs.Trust.trustLog `elem` fs) $
+ liftAnnex . updateSyncRemotes =<< getAssistant daemonStatusHandle
+ where
+ (fs, as) = unzip $ filter (flip S.member changedfiles . fst)
+ configFilesActions
+ changedfiles = S.map fst changedconfigs
-getConfigs :: Git.Repo -> IO Configs
-getConfigs r = S.fromList . map extract
- <$> LsTree.lsTreeFiles Annex.Branch.fullname files r
- where
- files = map fst configFilesActions
- extract treeitem = (LsTree.file treeitem, LsTree.sha treeitem)
+getConfigs :: Assistant Configs
+getConfigs = S.fromList . map extract
+ <$> liftAnnex (inRepo $ LsTree.lsTreeFiles Annex.Branch.fullname files)
+ where
+ files = map fst configFilesActions
+ extract treeitem = (LsTree.file treeitem, LsTree.sha treeitem)