diff options
Diffstat (limited to 'Assistant')
| -rw-r--r-- | Assistant/Commits.hs | 22 | ||||
| -rw-r--r-- | Assistant/Monad.hs | 2 | ||||
| -rw-r--r-- | Assistant/Threads/Committer.hs | 2 | ||||
| -rw-r--r-- | Assistant/Threads/ConfigMonitor.hs | 2 | ||||
| -rw-r--r-- | Assistant/Threads/Pusher.hs | 5 | ||||
| -rw-r--r-- | Assistant/Threads/Transferrer.hs | 2 | ||||
| -rw-r--r-- | Assistant/Types/Commits.hs | 17 |
7 files changed, 33 insertions, 19 deletions
diff --git a/Assistant/Commits.hs b/Assistant/Commits.hs index 6c27ce3cb..79555fee5 100644 --- a/Assistant/Commits.hs +++ b/Assistant/Commits.hs @@ -7,25 +7,21 @@ module Assistant.Commits where -import Utility.TSet - -type CommitChan = TSet Commit +import Assistant.Common +import Assistant.Types.Commits -data Commit = Commit - -newCommitChan :: IO CommitChan -newCommitChan = newTSet +import Utility.TSet {- Gets all unhandled commits. - Blocks until at least one commit is made. -} -getCommits :: CommitChan -> IO [Commit] -getCommits = getTSet +getCommits :: Assistant [Commit] +getCommits = getTSet <<~ commitChan {- Puts unhandled commits back into the channel. - Note: Original order is not preserved. -} -refillCommits :: CommitChan -> [Commit] -> IO () -refillCommits = putTSet +refillCommits :: [Commit] -> Assistant () +refillCommits cs = flip putTSet cs <<~ commitChan {- Records a commit in the channel. -} -recordCommit :: CommitChan -> IO () -recordCommit = flip putTSet1 Commit +recordCommit :: Assistant () +recordCommit = flip putTSet1 Commit <<~ commitChan diff --git a/Assistant/Monad.hs b/Assistant/Monad.hs index 223376869..7db6cbc5e 100644 --- a/Assistant/Monad.hs +++ b/Assistant/Monad.hs @@ -33,7 +33,7 @@ import Assistant.TransferQueue import Assistant.TransferSlots import Assistant.Types.Pushes import Assistant.Types.BranchChange -import Assistant.Commits +import Assistant.Types.Commits import Assistant.Types.Changes newtype Assistant a = Assistant { mkAssistant :: ReaderT AssistantData IO a } diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index 3c283e38b..79b3812ee 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -61,7 +61,7 @@ commitThread = NamedThread "Committer" $ do ] void $ alertWhile commitAlert $ liftAnnex commitStaged - recordCommit <<~ commitChan + recordCommit else refill readychanges else refill changes where diff --git a/Assistant/Threads/ConfigMonitor.hs b/Assistant/Threads/ConfigMonitor.hs index aa4718cf3..ce44105df 100644 --- a/Assistant/Threads/ConfigMonitor.hs +++ b/Assistant/Threads/ConfigMonitor.hs @@ -48,7 +48,7 @@ configMonitorThread = NamedThread "ConfigMonitor" $ loop =<< getConfigs reloadConfigs new {- Record a commit to get this config - change pushed out to remotes. -} - recordCommit <<~ commitChan + recordCommit loop new {- Config files, and their checksums. -} diff --git a/Assistant/Threads/Pusher.hs b/Assistant/Threads/Pusher.hs index c87df1610..905cf81db 100644 --- a/Assistant/Threads/Pusher.hs +++ b/Assistant/Threads/Pusher.hs @@ -9,6 +9,7 @@ module Assistant.Threads.Pusher where import Assistant.Common import Assistant.Commits +import Assistant.Types.Commits import Assistant.Pushes import Assistant.Alert import Assistant.DaemonStatus @@ -41,7 +42,7 @@ pushThread :: NamedThread pushThread = NamedThread "Pusher" $ runEvery (Seconds 2) <~> do -- We already waited two seconds as a simple rate limiter. -- Next, wait until at least one commit has been made - commits <- getCommits <<~ commitChan + commits <- getCommits -- Now see if now's a good time to push. if shouldPush commits then do @@ -52,7 +53,7 @@ pushThread = NamedThread "Pusher" $ runEvery (Seconds 2) <~> do pushToRemotes now True remotes else do debug ["delaying push of", show (length commits), "commits"] - flip refillCommits commits <<~ commitChan + refillCommits commits where pushable r | Remote.specialRemote r = False diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs index 145abe86d..6bcb05e0e 100644 --- a/Assistant/Threads/Transferrer.hs +++ b/Assistant/Threads/Transferrer.hs @@ -81,7 +81,7 @@ startTransfer program t info = case (transferRemote info, associatedFile info) o liftIO $ void $ addAlert dstatus $ makeAlertFiller True $ transferFileAlert direction True file - recordCommit <<~ commitChan + recordCommit where params = [ Param "transferkey" diff --git a/Assistant/Types/Commits.hs b/Assistant/Types/Commits.hs new file mode 100644 index 000000000..bb17c578b --- /dev/null +++ b/Assistant/Types/Commits.hs @@ -0,0 +1,17 @@ +{- git-annex assistant commit tracking + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Assistant.Types.Commits where + +import Utility.TSet + +type CommitChan = TSet Commit + +data Commit = Commit + +newCommitChan :: IO CommitChan +newCommitChan = newTSet |