summaryrefslogtreecommitdiff
path: root/Assistant
diff options
context:
space:
mode:
Diffstat (limited to 'Assistant')
-rw-r--r--Assistant/Changes.hs25
-rw-r--r--Assistant/Commits.hs32
-rw-r--r--Assistant/Committer.hs6
-rw-r--r--Assistant/Syncer.hs29
-rw-r--r--Assistant/ThreadedMonad.hs3
-rw-r--r--Assistant/Watcher.hs4
6 files changed, 77 insertions, 22 deletions
diff --git a/Assistant/Changes.hs b/Assistant/Changes.hs
index 173ba1922..47eae83ef 100644
--- a/Assistant/Changes.hs
+++ b/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
diff --git a/Assistant/Commits.hs b/Assistant/Commits.hs
new file mode 100644
index 000000000..152544e7c
--- /dev/null
+++ b/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
diff --git a/Assistant/Committer.hs b/Assistant/Committer.hs
index 63df8cafc..acdee1408 100644
--- a/Assistant/Committer.hs
+++ b/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
diff --git a/Assistant/Syncer.hs b/Assistant/Syncer.hs
new file mode 100644
index 000000000..059859c07
--- /dev/null
+++ b/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
diff --git a/Assistant/ThreadedMonad.hs b/Assistant/ThreadedMonad.hs
index 51f579d07..91a311dee 100644
--- a/Assistant/ThreadedMonad.hs
+++ b/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
diff --git a/Assistant/Watcher.hs b/Assistant/Watcher.hs
index db58f01e8..78330c8d0 100644
--- a/Assistant/Watcher.hs
+++ b/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