converted MetaData, eliminating a global value from Annex state .. beautiful

This commit is contained in:
Joey Hess 2015-07-12 09:25:43 -04:00
parent fdcb54d4f2
commit adec382bc2
4 changed files with 58 additions and 62 deletions

View file

@ -57,7 +57,6 @@ import Types.UUID
import Types.FileMatcher
import Types.NumCopies
import Types.LockCache
import Types.MetaData
import Types.DesktopNotify
import Types.CleanupActions
#ifdef WITH_QUVI
@ -121,7 +120,6 @@ data AnnexState = AnnexState
, lockcache :: LockCache
, flags :: M.Map String Bool
, fields :: M.Map String String
, modmeta :: [ModMeta]
, cleanup :: M.Map CleanupAction (Annex ())
, sentinalstatus :: Maybe SentinalStatus
, useragent :: Maybe String
@ -166,7 +164,6 @@ newState c r = AnnexState
, lockcache = M.empty
, flags = M.empty
, fields = M.empty
, modmeta = []
, cleanup = M.empty
, sentinalstatus = Nothing
, useragent = Nothing

View file

@ -36,7 +36,7 @@ import qualified Command.SetPresentKey
import qualified Command.ReadPresentKey
import qualified Command.CheckPresentKey
import qualified Command.ReKey
--import qualified Command.MetaData
import qualified Command.MetaData
import qualified Command.View
import qualified Command.VAdd
import qualified Command.VFilter
@ -171,7 +171,7 @@ cmds =
, Command.ReadPresentKey.cmd
, Command.CheckPresentKey.cmd
, Command.ReKey.cmd
-- , Command.MetaData.cmd
, Command.MetaData.cmd
, Command.View.cmd
, Command.VAdd.cmd
, Command.VFilter.cmd

View file

@ -8,7 +8,6 @@
module Command.MetaData where
import Common.Annex
import qualified Annex
import Command
import Annex.MetaData
import Logs.MetaData
@ -17,67 +16,65 @@ import qualified Data.Set as S
import Data.Time.Clock.POSIX
cmd :: Command
cmd = withOptions metaDataOptions $
command "metadata"
SectionMetaData "sets or gets metadata of a file"
paramPaths (withParams seek)
cmd = withGlobalOptions ([jsonOption] ++ annexedMatchingOptions) $
command "metadata" SectionMetaData
"sets or gets metadata of a file"
paramPaths (seek <$$> optParser)
metaDataOptions :: [Option]
metaDataOptions =
[ setOption
, tagOption
, untagOption
, getOption
, jsonOption
] ++ keyOptions ++ annexedMatchingOptions
data MetaDataOptions = MetaDataOptions
{ forFiles :: CmdParams
, getSet :: GetSet
, keyOptions :: Maybe KeyOptions
}
storeModMeta :: ModMeta -> Annex ()
storeModMeta modmeta = Annex.changeState $
\s -> s { Annex.modmeta = modmeta:Annex.modmeta s }
data GetSet = Get MetaField | Set [ModMeta]
setOption :: Option
setOption = Option ['s'] ["set"] (ReqArg mkmod "FIELD[+-]=VALUE") "set metadata"
optParser :: CmdParamsDesc -> Parser MetaDataOptions
optParser desc = MetaDataOptions
<$> cmdParams desc
<*> ((Get <$> getopt) <|> (Set <$> many modopts))
<*> optional (parseKeyOptions False)
where
mkmod = either error storeModMeta . parseModMeta
getopt = option (eitherReader mkMetaField)
( long "get" <> short 'g' <> metavar paramField
<> help "get single metadata field"
)
modopts = option (eitherReader parseModMeta)
( long "set" <> short 's' <> metavar "FIELD[+-]=VALUE"
<> help "set or unset metadata value"
)
<|> (AddMeta tagMetaField . toMetaValue <$> strOption
( long "tag" <> short 't' <> metavar "TAG"
<> help "set a tag"
))
<|> (AddMeta tagMetaField . mkMetaValue (CurrentlySet False) <$> strOption
( long "untag" <> short 'u' <> metavar "TAG"
<> help "remove a tag"
))
getOption :: Option
getOption = fieldOption ['g'] "get" paramField "get single metadata field"
tagOption :: Option
tagOption = Option ['t'] ["tag"] (ReqArg mkmod "TAG") "set a tag"
where
mkmod = storeModMeta . AddMeta tagMetaField . toMetaValue
untagOption :: Option
untagOption = Option ['u'] ["untag"] (ReqArg mkmod "TAG") "remove a tag"
where
mkmod = storeModMeta . AddMeta tagMetaField . mkMetaValue (CurrentlySet False)
seek :: CmdParams -> CommandSeek
seek ps = do
modmeta <- Annex.getState Annex.modmeta
getfield <- getOptionField getOption $ \ms ->
return $ either error id . mkMetaField <$> ms
seek :: MetaDataOptions -> CommandSeek
seek o = do
now <- liftIO getPOSIXTime
let seeker = if null modmeta
then withFilesInGit
else withFilesInGitNonRecursive
withKeyOptions False
(startKeys now getfield modmeta)
(seeker $ whenAnnexed $ start now getfield modmeta)
ps
let seeker = case getSet o of
Get _ -> withFilesInGit
Set _ -> withFilesInGitNonRecursive
withKeyOptions (keyOptions o) False
(startKeys now o)
(seeker $ whenAnnexed $ start now o)
(forFiles o)
start :: POSIXTime -> Maybe MetaField -> [ModMeta] -> FilePath -> Key -> CommandStart
start now f ms file = start' (Just file) now f ms
start :: POSIXTime -> MetaDataOptions -> FilePath -> Key -> CommandStart
start now o file = start' (Just file) now o
startKeys :: POSIXTime -> Maybe MetaField -> [ModMeta] -> Key -> CommandStart
startKeys :: POSIXTime -> MetaDataOptions -> Key -> CommandStart
startKeys = start' Nothing
start' :: AssociatedFile -> POSIXTime -> Maybe MetaField -> [ModMeta] -> Key -> CommandStart
start' afile now Nothing ms k = do
start' :: AssociatedFile -> POSIXTime -> MetaDataOptions -> Key -> CommandStart
start' afile now o k = case getSet o of
Set ms -> do
showStart' "metadata" k afile
next $ perform now ms k
start' _ _ (Just f) _ k = do
Get f -> do
l <- S.toList . currentMetaDataValues f <$> getCurrentMetaData k
liftIO $ forM_ l $
putStrLn . fromMetaValue

4
debian/changelog vendored
View file

@ -1,6 +1,8 @@
* Switched option parsing to use optparse-applicative. This was a very large
and invasive change, and may have caused some minor behavior changes to
edge cases of option parsing.
edge cases of option parsing. (For example, the metadata command no
longer accepts the combination of --get and --set, which never actually
worked.)
* Bash completion code is built-in to git-annex, and can be enabled by
running: source <(git-annex --bash-completion-script git-annex)
* version --raw now works when run outside a git repository.