git-annex/Command/ExamineKey.hs
Joey Hess b223988e22
remove --backend from global options
--backend is no longer a global option, and is only accepted by commands
that actually need it.

Three commands that used to support backend but don't any longer are
watch, webapp, and assistant. It would be possible to make them support it,
but I doubt anyone used the option with these. And in the case of webapp
and assistant, the option was handled inconsistently, only taking affect
when the command is run with an existing git-annex repo, not when it
creates a new one.

Also, renamed GlobalOption etc to AnnexOption. Because there are many
options of this type that are not actually global (any more) and get
added to commands that need them.

Sponsored-by: Kevin Mueller on Patreon
2022-06-29 13:33:25 -04:00

79 lines
2.2 KiB
Haskell

{- git-annex command
-
- Copyright 2013-2020 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Command.ExamineKey where
import Command
import qualified Utility.Format
import Command.Find (parseFormatOption, showFormatted, formatVars)
import Annex.Link
import Backend
import Types.Backend
import Types.Key
import Data.Char
import qualified Data.ByteString as B
cmd :: Command
cmd = noCommit $ noMessages $ dontCheck repoExists $
withAnnexOptions [jsonOptions] $
command "examinekey" SectionPlumbing
"prints information from a key"
(paramRepeating paramKey)
(batchable run optParser)
data ExamineOptions = ExamineOptions
{ format :: Maybe Utility.Format.Format
, migrateToBackend :: Maybe (DeferredParse Backend)
, associatedFile :: AssociatedFile
}
optParser :: Parser ExamineOptions
optParser = ExamineOptions
<$> optional parseFormatOption
<*> (fmap (DeferredParse . tobackend) <$> migrateopt)
<*> (AssociatedFile <$> fileopt)
where
fileopt = optional $ strOption
( long "filename" <> metavar paramFile
<> help "file associated with the key"
)
migrateopt = optional $ strOption
( long "migrate-to-backend" <> metavar paramName
<> help "migrate key to other backend when possible"
)
tobackend = lookupBackendVariety . parseKeyVariety . encodeBS
run :: ExamineOptions -> SeekInput -> String -> Annex Bool
run o _ input = do
k <- getkey
objectpath <- calcRepo $ gitAnnexLocation k
let objectpointer = formatPointer k
showFormatted (format o) (serializeKey' k) $
[ ("objectpath", fromRawFilePath objectpath)
, ("objectpointer", fromRawFilePath objectpointer)
] ++ formatVars k af
return True
where
-- Parse the input, which is either a key, or in batch mode
-- can be "key filename"
(ikb, ifb) = B.break (== (fromIntegral (ord ' '))) (toRawFilePath input)
ifb' = B.drop 1 ifb
ik = fromMaybe (giveup "bad key") (deserializeKey' ikb)
af = if B.null ifb'
then associatedFile o
else AssociatedFile (Just ifb')
getkey = case migrateToBackend o of
Nothing -> pure ik
Just v -> getParsed v >>= \b ->
maybeLookupBackendVariety (fromKey keyVariety ik) >>= \case
Just ib -> case fastMigrate ib of
Just fm -> fromMaybe ik <$> fm ik b af
Nothing -> pure ik
Nothing -> pure ik