diff options
author | Joey Hess <joey@kitenet.net> | 2012-10-29 11:40:22 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-10-29 11:40:22 -0400 |
commit | f901112e1ce30f43dc7294e0bd0616bb02556500 (patch) | |
tree | 92ab6d6f220ea21e0cc7feeff6caca52d4d2b677 /Assistant/Threads/ConfigMonitor.hs | |
parent | 710dfa7e3ec897d6f02930540b10bb303e3a9c91 (diff) |
converted 6 more threads
Diffstat (limited to 'Assistant/Threads/ConfigMonitor.hs')
-rw-r--r-- | Assistant/Threads/ConfigMonitor.hs | 72 |
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) |