find, findkeys, examinekey: escape output to terminal when --format is not used

Note that filenames are not quoted, only escaped. This is to match the
output of --format with escaping.

Sponsored-by: Lawrence Brogan on Patreon
This commit is contained in:
Joey Hess 2023-04-11 14:57:09 -04:00
parent df6f9f1ee8
commit afa5b883dc
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
10 changed files with 85 additions and 28 deletions

View file

@ -5,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Command.ExamineKey where
import Command
@ -14,6 +16,7 @@ import Annex.Link
import Backend
import Types.Backend
import Types.Key
import Utility.SafeOutput
import Data.Char
import qualified Data.ByteString as B
@ -54,7 +57,8 @@ run o _ input = do
objectpath <- calcRepo $ gitAnnexLocation k
let objectpointer = formatPointer k
showFormatted (format o) (serializeKey' k) $
isterminal <- liftIO $ checkIsTerminal stdout
showFormatted isterminal (format o) (serializeKey' k) $
[ ("objectpath", fromRawFilePath objectpath)
, ("objectpointer", fromRawFilePath objectpointer)
] ++ formatVars k af

View file

@ -1,6 +1,6 @@
{- git-annex command
-
- Copyright 2010-2018 Joey Hess <id@joeyh.name>
- Copyright 2010-2023 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
@ -19,6 +19,7 @@ import Types.Key
import Git.FilePath
import qualified Utility.Format
import Utility.DataUnits
import Utility.SafeOutput
cmd :: Command
cmd = withAnnexOptions [annexedMatchingOptions] $ mkCommand $
@ -60,14 +61,15 @@ seek :: FindOptions -> CommandSeek
seek o = do
unless (isJust (keyOptions o)) $
checkNotBareRepo
isterminal <- liftIO $ checkIsTerminal stdout
seeker <- contentPresentUnlessLimited $ AnnexedFileSeeker
{ startAction = start o
{ startAction = start o isterminal
, checkContentPresent = Nothing
, usesLocationLog = False
}
case batchOption o of
NoBatch -> withKeyOptions (keyOptions o) False seeker
(commandAction . startKeys o)
(commandAction . startKeys o isterminal)
(withFilesInGitAnnex ww seeker)
=<< workTreeItems ww (findThese o)
Batch fmt -> batchOnly (keyOptions o) (findThese o) $
@ -86,22 +88,25 @@ contentPresentUnlessLimited s = do
else Just True
}
start :: FindOptions -> SeekInput -> RawFilePath -> Key -> CommandStart
start o _ file key = startingCustomOutput key $ do
showFormatted (formatOption o) file
start :: FindOptions -> IsTerminal -> SeekInput -> RawFilePath -> Key -> CommandStart
start o isterminal _ file key = startingCustomOutput key $ do
showFormatted isterminal (formatOption o) file
(formatVars key (AssociatedFile (Just file)))
next $ return True
startKeys :: FindOptions -> (SeekInput, Key, ActionItem) -> CommandStart
startKeys o (si, key, ActionItemBranchFilePath (BranchFilePath _ topf) _) =
start o si (getTopFilePath topf) key
startKeys _ _ = stop
startKeys :: FindOptions -> IsTerminal -> (SeekInput, Key, ActionItem) -> CommandStart
startKeys o isterminal (si, key, ActionItemBranchFilePath (BranchFilePath _ topf) _) =
start o isterminal si (getTopFilePath topf) key
startKeys _ _ _ = stop
showFormatted :: Maybe Utility.Format.Format -> S.ByteString -> [(String, String)] -> Annex ()
showFormatted format unformatted vars =
showFormatted :: IsTerminal -> Maybe Utility.Format.Format -> S.ByteString -> [(String, String)] -> Annex ()
showFormatted (IsTerminal isterminal) format unformatted vars =
unlessM (showFullJSON $ JSONChunk vars) $
case format of
Nothing -> liftIO $ S8.putStrLn unformatted
Nothing -> do
liftIO $ S8.putStrLn $ if isterminal
then Utility.Format.escapedFormat unformatted
else unformatted
Just formatter -> liftIO $ putStr $
Utility.Format.format formatter $
M.fromList vars

View file

@ -8,8 +8,9 @@
module Command.FindKeys where
import Command
import qualified Utility.Format
import qualified Command.Find
import qualified Utility.Format
import Utility.SafeOutput
cmd :: Command
cmd = withAnnexOptions [keyMatchingOptions] $ Command.Find.mkCommand $
@ -26,22 +27,23 @@ optParser _ = FindKeysOptions
seek :: FindKeysOptions -> CommandSeek
seek o = do
isterminal <- liftIO $ checkIsTerminal stdout
seeker <- Command.Find.contentPresentUnlessLimited $ AnnexedFileSeeker
{ checkContentPresent = Nothing
, usesLocationLog = False
-- startAction is not actually used since this
-- is not used to seek files
, startAction = \_ _ key -> start' o key
, startAction = \_ _ key -> start' o isterminal key
}
withKeyOptions (Just WantAllKeys) False seeker
(commandAction . start o)
(commandAction . start o isterminal)
(const noop) (WorkTreeItems [])
start :: FindKeysOptions -> (SeekInput, Key, ActionItem) -> CommandStart
start o (_si, key, _ai) = start' o key
start :: FindKeysOptions -> IsTerminal -> (SeekInput, Key, ActionItem) -> CommandStart
start o isterminal (_si, key, _ai) = start' o isterminal key
start' :: FindKeysOptions -> Key -> CommandStart
start' o key = startingCustomOutput key $ do
Command.Find.showFormatted (formatOption o) (serializeKey' key)
start' :: FindKeysOptions -> IsTerminal -> Key -> CommandStart
start' o isterminal key = startingCustomOutput key $ do
Command.Find.showFormatted isterminal (formatOption o) (serializeKey' key)
(Command.Find.formatVars key (AssociatedFile Nothing))
next $ return True

View file

@ -17,7 +17,6 @@ import Remote.Web (getWebUrls)
import Annex.UUID
import qualified Utility.Format
import qualified Command.Find
import Utility.SafeOutput
import qualified Data.Map as M
import qualified Data.Vector as V