summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-10-29 19:35:18 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-10-29 19:35:18 -0400
commitde83800ab39649992cd7f9ae61689820138613bd (patch)
treeb0010403a376694f42cc3e36d8ccc3b5365c9d65
parent4c12d38e33923c929a1a264d5b511fb5b8afdf33 (diff)
split Commits and lifted
-rw-r--r--Assistant/Commits.hs22
-rw-r--r--Assistant/Monad.hs2
-rw-r--r--Assistant/Threads/Committer.hs2
-rw-r--r--Assistant/Threads/ConfigMonitor.hs2
-rw-r--r--Assistant/Threads/Pusher.hs5
-rw-r--r--Assistant/Threads/Transferrer.hs2
-rw-r--r--Assistant/Types/Commits.hs17
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