stub syncer thread and commit channel

Assistant/Changes.hs

@@ -8,14 +8,14 @@ module Assistant.Changes where
 import Common.Annex
 import qualified Annex.Queue
 import Types.KeySource
+import Utility.TSet
 
-import Control.Concurrent.STM
 import Data.Time.Clock
 
 data ChangeType = AddChange | LinkChange | RmChange | RmDirChange
 	deriving (Show, Eq)
 
-type ChangeChan = TChan Change
+type ChangeChan = TSet Change
 
 data Change
 	= Change 
@@ -29,11 +29,8 @@ data Change
 		}
 	deriving (Show)
 
-runChangeChan :: STM a -> IO a
-runChangeChan = atomically
-
 newChangeChan :: IO ChangeChan
-newChangeChan = atomically newTChan
+newChangeChan = newTSet
 
 {- Handlers call this when they made a change that needs to get committed. -}
 madeChange :: FilePath -> ChangeType -> Annex (Maybe Change)
@@ -65,17 +62,13 @@ finishedChange c = c
 {- Gets all unhandled changes.
  - Blocks until at least one change is made. -}
 getChanges :: ChangeChan -> IO [Change]
-getChanges chan = runChangeChan $ do
-	c <- readTChan chan
-	go [c]
-	where
-		go l = do
-			v <- tryReadTChan chan
-			case v of
-				Nothing -> return l
-				Just c -> go (c:l)
+getChanges = getTSet
 
 {- Puts unhandled changes back into the channel.
  - Note: Original order is not preserved. -}
 refillChanges :: ChangeChan -> [Change] -> IO ()
-refillChanges chan cs = runChangeChan $ mapM_ (writeTChan chan) cs
+refillChanges = putTSet
+
+{- Records a change in the channel. -}
+recordChange :: ChangeChan -> Change -> IO ()
+recordChange = putTSet1

Assistant/Commits.hs

@@ -0,0 +1,32 @@
+{- git-annex assistant commit tracking
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -}
+
+module Assistant.Commits where
+
+import Utility.TSet
+
+import Data.Time.Clock
+
+type CommitChan = TSet Commit
+
+data Commit = Commit UTCTime
+	deriving (Show)
+
+newCommitChan :: IO CommitChan
+newCommitChan = newTSet
+
+{- Gets all unhandled commits.
+ - Blocks until at least one commit is made. -}
+getCommits :: CommitChan -> IO [Commit]
+getCommits = getTSet
+
+{- Puts unhandled commits back into the channel.
+ - Note: Original order is not preserved. -}
+refillCommits :: CommitChan -> [Commit] -> IO ()
+refillCommits = putTSet
+
+{- Records a commit in the channel. -}
+recordCommit :: CommitChan -> Commit -> IO ()
+recordCommit = putTSet1

Assistant/Committer.hs

@@ -7,6 +7,7 @@ module Assistant.Committer where
 
 import Common.Annex
 import Assistant.Changes
+import Assistant.Commits
 import Assistant.ThreadedMonad
 import Assistant.Watcher
 import qualified Annex
@@ -26,8 +27,8 @@ import qualified Data.Set as S
 import Data.Either
 
 {- This thread makes git commits at appropriate times. -}
-commitThread :: ThreadState -> ChangeChan -> IO ()
-commitThread st changechan = runEvery (Seconds 1) $ do
+commitThread :: ThreadState -> ChangeChan -> CommitChan -> IO ()
+commitThread st changechan commitchan = runEvery (Seconds 1) $ do
 	-- We already waited one second as a simple rate limiter.
 	-- Next, wait until at least one change is available for
 	-- processing.
@@ -40,6 +41,7 @@ commitThread st changechan = runEvery (Seconds 1) $ do
 			if shouldCommit time readychanges
 				then do
 					void $ tryIO $ runThreadState st commitStaged
+					recordCommit commitchan (Commit time)
 				else refillChanges changechan readychanges
 		else refillChanges changechan changes
 

Assistant/Syncer.hs

@@ -0,0 +1,29 @@
+{- git-annex assistant git syncing thread
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -}
+
+module Assistant.Syncer where
+
+import Assistant.Commits
+import Assistant.ThreadedMonad
+import qualified Command.Sync
+import Utility.ThreadScheduler
+
+{- This thread syncs git commits out to remotes. -}
+syncThread :: ThreadState -> CommitChan -> IO ()
+syncThread st commitchan = 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
+	-- Now see if now's a good time to sync.
+	if shouldSync commits
+		then syncToRemotes
+		else refillCommits commitchan commits
+
+{- Decide if now is a good time to sync commits to remotes. -}
+shouldSync :: [Commit] -> Bool
+shouldSync commits = not (null commits)
+
+syncToRemotes :: IO ()
+syncToRemotes = return () -- TOOD

Assistant/ThreadedMonad.hs

@@ -32,7 +32,8 @@ withThreadState a = do
 
 {- Runs an Annex action, using the state from the MVar. 
  -
- - This serializes calls by threads. -}
+ - This serializes calls by threads; only one thread can run in Annex at a
+ - time. -}
 runThreadState :: ThreadState -> Annex a -> IO a
 runThreadState mvar a = do
 	startstate <- takeMVar mvar

Assistant/Watcher.hs

@@ -27,7 +27,6 @@ import Annex.Content
 import Annex.CatFile
 import Git.Types
 
-import Control.Concurrent.STM
 import Data.Bits.Utils
 import qualified Data.ByteString.Lazy as L
 
@@ -96,8 +95,7 @@ runHandler st dstatus changechan handler file filestatus = void $ do
 	case r of
 		Left e -> print e
 		Right Nothing -> noop
-		Right (Just change) -> void $
-			runChangeChan $ writeTChan changechan change
+		Right (Just change) -> recordChange changechan change
 	where
 		go = runThreadState st $ handler file filestatus dstatus