File: Batch.hs

package info (click to toggle)
git-annex 10.20230126-3
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 69,344 kB
  • sloc: haskell: 74,654; javascript: 9,103; sh: 1,304; makefile: 203; perl: 136; ansic: 44
file content (218 lines) | stat: -rw-r--r-- 7,148 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
{- 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), params) = 
		batchOnly Nothing params $
			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 f -> lookupKeyStaged f >>= \case
				Nothing -> return Nothing
				Just 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
		}

batchOnly :: Maybe KeyOptions -> CmdParams -> Annex () -> Annex ()
batchOnly Nothing [] a = a
batchOnly _ _ _ = giveup "Cannot combine batch option with file or key options"