git-annex/CmdLine/Batch.hs

{- git-annex batch commands
 -
 - Copyright 2015-2021 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}

module CmdLine.Batch where

import Annex.Common
import qualified Annex
import Types.Command
import CmdLine.Action
import CmdLine.GitAnnex.Options
import CmdLine.Seek
import Options.Applicative
import Limit
import Types.FileMatcher
import Annex.BranchState
import Annex.WorkTree
import Annex.Content
import Annex.Concurrent
import Types.Concurrency

data BatchMode = Batch BatchFormat | NoBatch

data BatchFormat = BatchFormat BatchSeparator BatchKeys

data BatchSeparator = BatchLine | BatchNull

newtype BatchKeys = BatchKeys Bool

parseBatchOption :: Bool -> Parser BatchMode
parseBatchOption supportbatchkeysoption = go 
	<$> switch
		( long "batch"
		<> help batchhelp
		)
	<*> batchkeysswitch
	<*> flag BatchLine BatchNull
		( short 'z'
		<> help "null delimited batch input"
		)
  where
	go True False batchseparator = 
		Batch (BatchFormat batchseparator (BatchKeys False))
	go _ True batchseparator = 
		Batch (BatchFormat batchseparator (BatchKeys True))
	go _ _ _ = NoBatch

	batchhelp = "enable batch mode" ++
		if supportbatchkeysoption
			then ", with files input"
			else ""
	batchkeyshelp = "enable batch mode, with keys input"

	batchkeysswitch
		| supportbatchkeysoption = switch
			( long "batch-keys"
			<> help batchkeyshelp
			)
		| otherwise = pure False

-- A batchable command can run in batch mode, or not.
-- In batch mode, one line at a time is read, parsed, and a reply output to
-- stdout. In non batch mode, the command's parameters are parsed and
-- a reply output for each.
--
-- Note that the actions are not run concurrently.
batchable :: (opts -> SeekInput -> String -> Annex Bool) -> Parser opts -> CmdParamsDesc -> CommandParser
batchable handler parser paramdesc = batchseeker <$> batchparser
  where
	batchparser = (,,)
		<$> parser
		<*> parseBatchOption False
		<*> cmdParams paramdesc
	
	batchseeker (opts, NoBatch, params) =
		mapM_ (\p -> go NoBatch opts (SeekInput [p], p)) params
	batchseeker (opts, batchmode@(Batch fmt), _) = 
		batchInput fmt (pure . Right) (go batchmode opts)

	go batchmode opts (si, p) =
		unlessM (handler opts si p) $
			batchBadInput batchmode

-- bad input is indicated by an empty line in batch mode. In non batch
-- mode, exit on bad input.
batchBadInput :: BatchMode -> Annex ()
batchBadInput NoBatch = liftIO exitFailure
batchBadInput _ = liftIO $ putStrLn ""

-- Reads lines of batch mode input, runs a parser, and passes the result
-- to the action.
--
-- Note that if the batch input includes a worktree filename, it should
-- be converted to relative. Normally, filename parameters are passed
-- through git ls-files, which makes them relative, but batch mode does
-- not use that, and absolute worktree files are likely to cause breakage.
batchInput :: BatchFormat -> (String -> Annex (Either String v)) -> ((SeekInput, v) -> Annex ()) -> Annex ()
batchInput fmt parser a = go =<< batchLines fmt
  where
	go [] = return ()
	go (l:rest) = do
		either parseerr (\v -> a (SeekInput [l], v)) =<< parser l
		go rest
	parseerr s = giveup $ "Batch input parse failure: " ++ s

batchLines :: BatchFormat -> Annex [String]
batchLines (BatchFormat sep _) = do
	checkBatchConcurrency
	enableInteractiveBranchAccess
	liftIO $ splitter <$> getContents
  where
	splitter = case sep of
		BatchLine -> lines
		BatchNull -> splitc '\0'

-- When concurrency is enabled at the command line, it is used in batch
-- mode. But, if it's only set in git config, don't use it, because the
-- program using batch mode may not expect interleaved output.
checkBatchConcurrency :: Annex ()
checkBatchConcurrency = Annex.getState Annex.concurrency >>= \case
	ConcurrencyCmdLine _ -> noop
	ConcurrencyGitConfig _ -> 
		setConcurrency (ConcurrencyGitConfig (Concurrent 1))

batchCommandAction :: CommandStart -> Annex ()
batchCommandAction = commandAction . batchCommandStart

-- The batch mode user expects to read a line of output, and it's up to the
-- CommandStart to generate that output as it succeeds or fails to do its
-- job. However, if it stops without doing anything, it won't generate
-- any output. This modifies it so in that case, an empty line is printed.
batchCommandStart :: CommandStart -> CommandStart
batchCommandStart a = a >>= \case
	Just v -> return (Just v)
	Nothing -> do
		batchBadInput (Batch (BatchFormat BatchLine (BatchKeys False)))
		return Nothing

-- Reads lines of batch input and passes the filepaths to a CommandStart
-- to handle them.
--
-- File matching options are checked, and non-matching files skipped.
batchFiles :: BatchFormat -> ((SeekInput, RawFilePath) -> CommandStart) -> Annex ()
batchFiles fmt a = batchFilesKeys fmt $ \(si, v) -> case v of
	Right f -> a (si, f)
	Left _k -> return Nothing

batchFilesKeys :: BatchFormat -> ((SeekInput, Either Key RawFilePath) -> CommandStart) -> Annex ()
batchFilesKeys fmt a = do
	matcher <- getMatcher
	go $ \si v -> case v of
		Right f -> 
			let f' = toRawFilePath f
			in ifM (matcher $ MatchingFile $ FileInfo f' f' Nothing)
				( a (si, Right f')
				, return Nothing
				)
		Left k -> a (si, Left k)
  where
	go a' = batchInput fmt parser (batchCommandAction . uncurry a')
	parser = case fmt of
		-- Absolute filepaths are converted to relative,
		-- because in non-batch mode, that is done when
		-- CmdLine.Seek uses git ls-files.
		BatchFormat _ (BatchKeys False) -> 
			Right . Right . fromRawFilePath 
				<$$> liftIO . relPathCwdToFile . toRawFilePath
		BatchFormat _ (BatchKeys True) -> \i ->
			pure $ case deserializeKey i of
				Just k -> Right (Left k)
				Nothing -> Left "not a valid key"

batchAnnexedFiles :: BatchFormat -> AnnexedFileSeeker -> Annex ()
batchAnnexedFiles fmt seeker = batchAnnexed fmt seeker (const (return Nothing))

-- Reads lines of batch input and passes filepaths to the AnnexedFileSeeker
-- to handle them. Or, with --batch-keys, passes keys to the keyaction.
--
-- Matching options are checked, and non-matching items skipped.
batchAnnexed :: BatchFormat -> AnnexedFileSeeker -> ((SeekInput, Key, ActionItem) -> CommandStart) -> Annex ()
batchAnnexed fmt seeker keyaction = do
	matcher <- getMatcher
	batchFilesKeys fmt $ \(si, v) ->
		case v of
			Right bf -> flip whenAnnexed bf $ \f k ->
				checkpresent k $
					startAction seeker si f k
			Left k -> ifM (matcher (MatchingInfo (mkinfo k)))
				( checkpresent k $
					keyaction (si, k, mkActionItem k)
				, return Nothing)
  where
	checkpresent k cont = case checkContentPresent seeker of
		Just v -> do
			present <- inAnnex k
			if present == v
				then cont
				else return Nothing
		Nothing -> cont
	
	mkinfo k = ProvidedInfo
		{ providedFilePath = Nothing
		, providedKey = Just k
		, providedFileSize = Nothing
		, providedMimeType = Nothing
		, providedMimeEncoding = Nothing
		, providedLinkType = Nothing
		}