run event handlers all in the same Annex monad

Uses a MVar again, as there seems no other way to thread the state through
inotify events.

This is a rather unsatisfactory result. I had wanted to run them in
the same monad so that the git queue could be used to coleasce git commands
and speed things up. But, that led to fragility: If several files are
added, and one is removed before queue flush, git add will fail to add
any of them. So, the queue is still explicitly flushed after each add for
now.

TODO: Investigate using git add --ignore-errors. This would need to be done
in Command.Add. And, git add still exits nonzero with it, so would need
to avoid crashing on queue flush.

Annex.hs

@@ -14,6 +14,7 @@ module Annex (
 	newState,
 	run,
 	eval,
+	exec,
 	getState,
 	changeState,
 	setFlag,
@@ -134,6 +135,8 @@ run :: AnnexState -> Annex a -> IO (a, AnnexState)
 run s a = runStateT (runAnnex a) s
 eval :: AnnexState -> Annex a -> IO a
 eval s a = evalStateT (runAnnex a) s
+exec :: AnnexState -> Annex a -> IO AnnexState
+exec s a = execStateT (runAnnex a) s
 
 {- Sets a flag to True -}
 setFlag :: String -> Annex ()

Command/Watch.hs

@@ -5,14 +5,16 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE BangPatterns #-}
+
 module Command.Watch where
 
-import CmdLine
 import Common.Annex
 import Command
 import Utility.Inotify
 import Utility.ThreadLock
 import qualified Annex
+import qualified Annex.Queue
 import qualified Command.Add as Add
 import qualified Git.Command
 import qualified Backend
@@ -20,6 +22,7 @@ import Annex.Content
 
 import Control.Exception as E
 import System.INotify
+import Control.Concurrent.MVar
 
 def :: [Command]
 def = [command "watch" paramPaths seek "watch for changes"]
@@ -33,8 +36,9 @@ start = notBareRepo $ do
 	showAction "scanning"
 	inRepo $ Git.Command.run "add" [Param "--update"]
 	state <- Annex.getState id
+	mvar <- liftIO $ newMVar state
 	next $ next $ liftIO $ withINotify $ \i -> do
-		let hook a = Just $ run state a
+		let hook a = Just $ runAnnex mvar a
 		watchDir i "." (not . gitdir)
 			(hook onAdd) (hook onAddSymlink)
 			(hook onDel) (hook onDelDir)
@@ -44,31 +48,33 @@ start = notBareRepo $ do
 	where
 		gitdir dir = takeFileName dir /= ".git"
 
-{- Inotify events are run in separate threads, and so each is a
+{- Runs a handler, inside the Annex monad.
- - self-contained Annex monad.
  -
- - Exceptions by the handlers are ignored,
+ - Exceptions by the handlers are ignored, otherwise a whole watcher
- - otherwise a whole watcher thread could be crashed.
+ - thread could be crashed.
  -}
-run :: Annex.AnnexState -> (FilePath -> Annex a) -> FilePath -> IO ()
+runAnnex :: MVar Annex.AnnexState -> (FilePath -> Annex a) -> FilePath -> IO ()
-run startstate a f = do
+runAnnex mvar a f = do
-	r <- E.try go :: IO (Either E.SomeException ())
+	startstate <- takeMVar mvar
+	r <- E.try (go startstate) :: IO (Either E.SomeException Annex.AnnexState)
 	case r of
-		Left e -> putStrLn (show e)
+		Left e -> do
-		_ -> return ()
+			putStrLn (show e)
+			putMVar mvar startstate
+		Right !newstate ->
+			putMVar mvar newstate
 	where
-		go = Annex.eval startstate $ do
+		go state = Annex.exec state $ a f
-			_ <- a f
-			_ <- shutdown True
-			return ()
 
 {- Adding a file is the same as git-annex add.
  - The git queue is immediately flushed, so the file is added to git
  - now, rather than later (when it may have been already moved or deleted!) -}
 onAdd :: FilePath -> Annex ()
-onAdd file = void $ doCommand $ do
+onAdd file = do
+	void $ doCommand $ do
 		showStart "add" file
 		next $ Add.perform file
+	Annex.Queue.flush
 
 {- A symlink might be an arbitrary symlink, which is just added.
  - Or, if it is a git-annex symlink, ensure it points to the content