converted MetaData, eliminating a global value from Annex state .. beautiful
This commit is contained in:
parent
fdcb54d4f2
commit
adec382bc2
4 changed files with 58 additions and 62 deletions
3
Annex.hs
3
Annex.hs
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
4
debian/changelog
vendored
|
@ -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.
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue