split Commits and lifted

Assistant/Commits.hs

@@ -7,25 +7,21 @@
 
 module Assistant.Commits where
 
+import Assistant.Common
+import Assistant.Types.Commits
+
 import Utility.TSet
 
-type CommitChan = TSet Commit
-
-data Commit = Commit
-
-newCommitChan :: IO CommitChan
-newCommitChan = newTSet
-
 {- Gets all unhandled commits.
  - Blocks until at least one commit is made. -}
-getCommits :: CommitChan -> IO [Commit]
+getCommits :: Assistant [Commit]
-getCommits = getTSet
+getCommits = getTSet <<~ commitChan
 
 {- Puts unhandled commits back into the channel.
  - Note: Original order is not preserved. -}
-refillCommits :: CommitChan -> [Commit] -> IO ()
+refillCommits :: [Commit] -> Assistant ()
-refillCommits = putTSet
+refillCommits cs = flip putTSet cs <<~ commitChan
 
 {- Records a commit in the channel. -}
-recordCommit :: CommitChan -> IO ()
+recordCommit :: Assistant ()
-recordCommit = flip putTSet1 Commit
+recordCommit = flip putTSet1 Commit <<~ commitChan

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 }

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

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. -}

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

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"

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