99 lines
2.7 KiB
Haskell
99 lines
2.7 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2014 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.MetaData where
|
|
|
|
import Common.Annex
|
|
import Command
|
|
import Annex.MetaData
|
|
import Logs.MetaData
|
|
|
|
import qualified Data.Set as S
|
|
import Data.Time.Clock.POSIX
|
|
|
|
cmd :: Command
|
|
cmd = withGlobalOptions ([jsonOption] ++ annexedMatchingOptions) $
|
|
command "metadata" SectionMetaData
|
|
"sets or gets metadata of a file"
|
|
paramPaths (seek <$$> optParser)
|
|
|
|
data MetaDataOptions = MetaDataOptions
|
|
{ forFiles :: CmdParams
|
|
, getSet :: GetSet
|
|
, keyOptions :: Maybe KeyOptions
|
|
}
|
|
|
|
data GetSet = Get MetaField | Set [ModMeta]
|
|
|
|
optParser :: CmdParamsDesc -> Parser MetaDataOptions
|
|
optParser desc = MetaDataOptions
|
|
<$> cmdParams desc
|
|
<*> ((Get <$> getopt) <|> (Set <$> many modopts))
|
|
<*> optional (parseKeyOptions False)
|
|
where
|
|
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"
|
|
))
|
|
|
|
seek :: MetaDataOptions -> CommandSeek
|
|
seek o = do
|
|
now <- liftIO getPOSIXTime
|
|
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 -> MetaDataOptions -> FilePath -> Key -> CommandStart
|
|
start now o file = start' (Just file) now o
|
|
|
|
startKeys :: POSIXTime -> MetaDataOptions -> Key -> CommandStart
|
|
startKeys = start' Nothing
|
|
|
|
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
|
|
Get f -> do
|
|
l <- S.toList . currentMetaDataValues f <$> getCurrentMetaData k
|
|
liftIO $ forM_ l $
|
|
putStrLn . fromMetaValue
|
|
stop
|
|
|
|
perform :: POSIXTime -> [ModMeta] -> Key -> CommandPerform
|
|
perform _ [] k = next $ cleanup k
|
|
perform now ms k = do
|
|
oldm <- getCurrentMetaData k
|
|
let m = combineMetaData $ map (modMeta oldm) ms
|
|
addMetaData' k m now
|
|
next $ cleanup k
|
|
|
|
cleanup :: Key -> CommandCleanup
|
|
cleanup k = do
|
|
l <- map unwrapmeta . fromMetaData <$> getCurrentMetaData k
|
|
maybeShowJSON l
|
|
showLongNote $ unlines $ concatMap showmeta l
|
|
return True
|
|
where
|
|
unwrapmeta (f, v) = (fromMetaField f, map fromMetaValue (S.toList v))
|
|
showmeta (f, vs) = map ((f ++ "=") ++) vs
|