remove last use of TSet

Assistant/Commits.hs

@@ -9,20 +9,15 @@ module Assistant.Commits where
 
 import Assistant.Common
 import Assistant.Types.Commits
-import Utility.TSet
+import Utility.TList
 
 import Control.Concurrent.STM
 
 {- Gets all unhandled commits.
  - Blocks until at least one commit is made. -}
 getCommits :: Assistant [Commit]
-getCommits = (atomically . getTSet) <<~ commitChan
-
-{- Puts unhandled commits back into the channel.
- - Note: Original order is not preserved. -}
-refillCommits :: [Commit] -> Assistant ()
-refillCommits cs = (atomically . flip putTSet cs) <<~ commitChan
+getCommits = (atomically . getTList) <<~ commitChan
 
 {- Records a commit in the channel. -}
 recordCommit :: Assistant ()
-recordCommit = (atomically . flip putTSet1 Commit) <<~ commitChan
+recordCommit = (atomically . flip consTList Commit) <<~ commitChan

Assistant/Threads/Pusher.hs

@@ -33,13 +33,9 @@ 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
+	void getCommits
 	-- Now see if now's a good time to push.
-	if shouldPush commits
-		then void $ pushToRemotes True =<< pushTargets
-		else do
-			debug ["delaying push of", show (length commits), "commits"]
-			refillCommits commits
+	void $ pushToRemotes True =<< pushTargets
 
 {- We want to avoid pushing to remotes that are marked readonly.
  -
@@ -51,14 +47,3 @@ pushTargets = liftIO . filterM available =<< candidates <$> getDaemonStatus
   where
 	candidates = filter (not . Remote.readonly) . syncGitRemotes
 	available = maybe (return True) doesDirectoryExist . Remote.localpath
-
-{- Decide if now is a good time to push to remotes.
- -
- - Current strategy: Immediately push all commits. The commit machinery
- - already determines batches of changes, so we can't easily determine
- - batches better.
- -}
-shouldPush :: [Commit] -> Bool
-shouldPush commits
-	| not (null commits) = True
-	| otherwise = False

Assistant/Types/Commits.hs

@@ -7,13 +7,13 @@
 
 module Assistant.Types.Commits where
 
-import Utility.TSet
+import Utility.TList
 
 import Control.Concurrent.STM
 
-type CommitChan = TSet Commit
+type CommitChan = TList Commit
 
 data Commit = Commit
 
 newCommitChan :: IO CommitChan
-newCommitChan = atomically newTSet
+newCommitChan = atomically newTList

Utility/TSet.hs

@@ -1,41 +0,0 @@
-{- Transactional sets
- -
- - Copyright 2012, 2013 Joey Hess <joey@kitenet.net>
- -}
-
-module Utility.TSet where
-
-import Common
-
-import Control.Concurrent.STM
-
-type TSet = TChan
-
-newTSet :: STM (TSet a)
-newTSet = newTChan
-
-{- Gets the contents of the TSet. Blocks until at least one item is
- - present. -}
-getTSet :: TSet a -> STM [a]
-getTSet tset = do
-	c <- readTChan tset
-	l <- readTSet tset
-	return $ c:l
-
-{- Gets anything currently in the TSet, without blocking. -}
-readTSet :: TSet a -> STM [a]
-readTSet tset = go []
-  where
-	go l = do
-		v <- tryReadTChan tset
-		case v of
-			Nothing -> return l
-			Just c -> go (c:l)
-
-{- Puts items into a TSet. -}
-putTSet :: TSet a -> [a] -> STM ()
-putTSet tset vs = mapM_ (writeTChan tset) vs
-
-{- Put a single item into a TSet. -}
-putTSet1 :: TSet a -> a -> STM ()
-putTSet1 tset v = void $ writeTChan tset v