{- git-annex command
 -
 - Copyright 2012 Joey Hess <joey@kitenet.net>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}

module Command.Watch where

import Common.Annex
import Command
#if defined linux_HOST_OS
import Utility.Inotify
#endif
import Utility.ThreadLock
import qualified Annex
import qualified Annex.Queue
import qualified Command.Add
import qualified Git.Command
import qualified Git.UpdateIndex
import qualified Backend
import Annex.Content

import Control.Exception as E
import Control.Concurrent.MVar

#if defined linux_HOST_OS
import System.INotify
#endif

def :: [Command]
def = [command "watch" paramPaths seek "watch for changes"]

seek :: [CommandSeek]
seek = [withNothing start]

start :: CommandStart
#if defined linux_HOST_OS
start = notBareRepo $ do
	showStart "watch" "."
	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 $ runAnnex mvar a
		let hooks = WatchHooks
			{ addHook = hook onAdd
			, delHook = hook onDel
			, addSymlinkHook = hook onAddSymlink
			, delDirHook = hook onDelDir
			, errHook = hook onErr
			}
		watchDir i "." (ignored . takeFileName) hooks
		putStrLn "(started)"
		waitForTermination
		return True
#else
start = error "watch mode is so far only available on Linux"
#endif

ignored :: FilePath -> Bool
ignored ".git" = True
ignored ".gitignore" = True
ignored ".gitattributes" = True
ignored _ = False

{- Runs a handler, inside the Annex monad.
 -
 - Exceptions by the handlers are ignored, otherwise a whole watcher
 - thread could be crashed.
 -}
runAnnex :: MVar Annex.AnnexState -> (FilePath -> Annex a) -> FilePath -> IO ()
runAnnex mvar a f = do
	startstate <- takeMVar mvar
	r <- E.try (go startstate) :: IO (Either E.SomeException Annex.AnnexState)
	case r of
		Left e -> do
			putStrLn (show e)
			putMVar mvar startstate
		Right !newstate ->
			putMVar mvar newstate
	where
		go state = Annex.exec state $ a f

{- Adding a file is tricky; the file has to be replaced with a symlink
 - but this is race prone, as the symlink could be changed immediately
 - after creation. To avoid that race, git add is not used to stage the
 - symlink. -}
onAdd :: FilePath -> Annex ()
onAdd file = do
	showStart "add" file
	Command.Add.ingest file >>= go
	where
		go Nothing = showEndFail
		go (Just key) = do
			link <- Command.Add.link file key True
			stageSymlink file link
			showEndOk

{- 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
 - before adding it.
 -}
onAddSymlink :: FilePath -> Annex ()
onAddSymlink file = go =<< Backend.lookupFile file
	where
		go Nothing = addlink =<< liftIO (readSymbolicLink file)
		go (Just (key, _)) = do
			link <- calcGitLink file key
			ifM ((==) link <$> liftIO (readSymbolicLink file))
				( addlink link
				, do
					liftIO $ removeFile file
					liftIO $ createSymbolicLink link file
					addlink link
				)
		addlink link = stageSymlink file link

{- The file could reappear at any time, so --cached is used, to only delete
 - it from the index. -}
onDel :: FilePath -> Annex ()
onDel file = Annex.Queue.addUpdateIndex =<<
	inRepo (Git.UpdateIndex.unstageFile file)

{- A directory has been deleted, or moved, so tell git to remove anything
 - that was inside it from its cache. Since it could reappear at any time,
 - use --cached to only delete it from the index. 
 -
 - Note: This could use unstageFile, but would need to run another git
 - command to get the recursive list of files in the directory, so rm is
 - just as good. -}
onDelDir :: FilePath -> Annex ()
onDelDir dir = Annex.Queue.addCommand "rm"
	[Params "--quiet -r --cached --ignore-unmatch --"] [dir]

{- Called when there's an error with inotify. -}
onErr :: String -> Annex ()
onErr = warning

{- Adds a symlink to the index, without ever accessing the actual symlink
 - on disk. -}
stageSymlink :: FilePath -> String -> Annex ()
stageSymlink file linktext =
	Annex.Queue.addUpdateIndex =<<
		inRepo (Git.UpdateIndex.stageSymlink file linktext)