add a thread to commit changes
Currently the stupidest possible version, just wakes up every second, and may make empty commits sometimes.
This commit is contained in:
parent
c5707c84d3
commit
6e54907e35
1 changed files with 24 additions and 2 deletions
|
@ -24,7 +24,7 @@ import qualified Git.UpdateIndex
|
||||||
import qualified Backend
|
import qualified Backend
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
|
|
||||||
import Control.Concurrent.MVar
|
import Control.Concurrent
|
||||||
|
|
||||||
#if defined linux_HOST_OS
|
#if defined linux_HOST_OS
|
||||||
import System.INotify
|
import System.INotify
|
||||||
|
@ -52,6 +52,7 @@ start = notBareRepo $ do
|
||||||
, errHook = hook onErr
|
, errHook = hook onErr
|
||||||
}
|
}
|
||||||
watchDir i "." (ignored . takeFileName) hooks
|
watchDir i "." (ignored . takeFileName) hooks
|
||||||
|
_ <- forkIO $ commitThread mvar
|
||||||
putStrLn "(started)"
|
putStrLn "(started)"
|
||||||
waitForTermination
|
waitForTermination
|
||||||
return True
|
return True
|
||||||
|
@ -91,8 +92,11 @@ runStateMVar mvar a = do
|
||||||
- Exceptions are ignored, otherwise a whole watcher thread could be crashed.
|
- Exceptions are ignored, otherwise a whole watcher thread could be crashed.
|
||||||
-}
|
-}
|
||||||
runHook :: MVar Annex.AnnexState -> (FilePath -> Annex ()) -> FilePath -> IO ()
|
runHook :: MVar Annex.AnnexState -> (FilePath -> Annex ()) -> FilePath -> IO ()
|
||||||
runHook mvar a f = handle =<< tryIO (runStateMVar mvar $ a f)
|
runHook mvar a f = handle =<< tryIO (runStateMVar mvar go)
|
||||||
where
|
where
|
||||||
|
go = do
|
||||||
|
a f
|
||||||
|
Annex.Queue.flushWhenFull
|
||||||
handle (Right ()) = return ()
|
handle (Right ()) = return ()
|
||||||
handle (Left e) = putStrLn $ show e
|
handle (Left e) = putStrLn $ show e
|
||||||
|
|
||||||
|
@ -155,3 +159,21 @@ stageSymlink :: FilePath -> String -> Annex ()
|
||||||
stageSymlink file linktext =
|
stageSymlink file linktext =
|
||||||
Annex.Queue.addUpdateIndex =<<
|
Annex.Queue.addUpdateIndex =<<
|
||||||
inRepo (Git.UpdateIndex.stageSymlink file linktext)
|
inRepo (Git.UpdateIndex.stageSymlink file linktext)
|
||||||
|
|
||||||
|
{- This thread wakes up periodically and makes git commits. -}
|
||||||
|
commitThread :: MVar Annex.AnnexState -> IO ()
|
||||||
|
commitThread mvar = forever $ do
|
||||||
|
threadDelay 1000000 -- 1 second
|
||||||
|
commit
|
||||||
|
where
|
||||||
|
commit = tryIO $ runStateMVar mvar $
|
||||||
|
whenM ((>) <$> Annex.Queue.size <*> pure 0) $ do
|
||||||
|
Annex.Queue.flush
|
||||||
|
{- Empty commits may be made if tree
|
||||||
|
- changes cancel each other out, etc. -}
|
||||||
|
inRepo $ Git.Command.run "commit"
|
||||||
|
[ Param "--allow-empty-message"
|
||||||
|
, Param "-m", Param ""
|
||||||
|
, Param "--allow-empty"
|
||||||
|
, Param "--quiet"
|
||||||
|
]
|
||||||
|
|
Loading…
Add table
Reference in a new issue