152 lines
4.9 KiB
Haskell
152 lines
4.9 KiB
Haskell
{- git-annex general metadata storage log and per-remote metadata storage log.
|
|
-
|
|
- A line of the log will look like "timestamp field [+-]value [...]"
|
|
-
|
|
- (In the per-remote log, each field is prefixed with "uuid:")
|
|
-
|
|
- Note that unset values are preserved. Consider this case:
|
|
-
|
|
- We have:
|
|
-
|
|
- 100 foo +x
|
|
- 200 foo -x
|
|
-
|
|
- An unmerged remote has:
|
|
-
|
|
- 150 foo +x
|
|
-
|
|
- After union merge, because the foo -x was preserved, we know that
|
|
- after the other remote redundantly set foo +x, it was unset,
|
|
- and so foo currently has no value.
|
|
-
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Logs.MetaData (
|
|
getCurrentMetaData,
|
|
getCurrentRemoteMetaData,
|
|
addMetaData,
|
|
addRemoteMetaData,
|
|
addMetaDataClocked,
|
|
currentMetaData,
|
|
copyMetaData,
|
|
) where
|
|
|
|
import Annex.Common
|
|
import Types.MetaData
|
|
import Annex.MetaData.StandardFields
|
|
import Annex.VectorClock
|
|
import qualified Annex.Branch
|
|
import qualified Annex
|
|
import Logs
|
|
import Utility.TimeStamp
|
|
import Logs.MetaData.Pure
|
|
|
|
import qualified Data.Set as S
|
|
import qualified Data.Map as M
|
|
|
|
{- Go through the log from oldest to newest, and combine it all
|
|
- into a single MetaData representing the current state.
|
|
-
|
|
- Automatically generates a lastchanged metadata for each field that's
|
|
- currently set, based on timestamps in the log.
|
|
-}
|
|
getCurrentMetaData :: Key -> Annex MetaData
|
|
getCurrentMetaData = getCurrentMetaData' metaDataLogFile
|
|
|
|
getCurrentMetaData' :: (GitConfig -> Key -> FilePath) -> Key -> Annex MetaData
|
|
getCurrentMetaData' getlogfile k = do
|
|
config <- Annex.getGitConfig
|
|
ls <- S.toAscList <$> readLog (getlogfile config k)
|
|
let loggedmeta = logToCurrentMetaData ls
|
|
return $ currentMetaData $ unionMetaData loggedmeta
|
|
(lastchanged ls loggedmeta)
|
|
where
|
|
lastchanged [] _ = emptyMetaData
|
|
lastchanged ls (MetaData currentlyset) =
|
|
let m = foldl' (flip M.union) M.empty (map genlastchanged ls)
|
|
in MetaData $
|
|
-- Add a overall lastchanged using the oldest log
|
|
-- item (log is in ascending order).
|
|
M.insert lastChangedField (lastchangedval $ Prelude.last ls) $
|
|
M.mapKeys mkLastChangedField $
|
|
-- Only include fields that are currently set.
|
|
m `M.intersection` currentlyset
|
|
-- Makes each field have the timestamp as its value.
|
|
genlastchanged l =
|
|
let MetaData m = value l
|
|
ts = lastchangedval l
|
|
in M.map (const ts) m
|
|
lastchangedval l = S.singleton $ toMetaValue $ showts $
|
|
case changed l of
|
|
VectorClock t -> t
|
|
Unknown -> 0
|
|
showts = formatPOSIXTime "%F@%H-%M-%S"
|
|
|
|
getCurrentRemoteMetaData :: UUID -> Key -> Annex RemoteMetaData
|
|
getCurrentRemoteMetaData u k = extractRemoteMetaData u <$>
|
|
getCurrentMetaData' remoteMetaDataLogFile k
|
|
|
|
{- Adds in some metadata, which can override existing values, or unset
|
|
- them, but otherwise leaves any existing metadata as-is. -}
|
|
addMetaData :: Key -> MetaData -> Annex ()
|
|
addMetaData = addMetaData' metaDataLogFile
|
|
|
|
addMetaData' :: (GitConfig -> Key -> FilePath) -> Key -> MetaData -> Annex ()
|
|
addMetaData' getlogfile k metadata =
|
|
addMetaDataClocked' getlogfile k metadata =<< liftIO currentVectorClock
|
|
|
|
{- Reusing the same VectorClock when making changes to the metadata
|
|
- of multiple keys is a nice optimisation. The same metadata lines
|
|
- will tend to be generated across the different log files, and so
|
|
- git will be able to pack the data more efficiently. -}
|
|
addMetaDataClocked :: Key -> MetaData -> VectorClock -> Annex ()
|
|
addMetaDataClocked = addMetaDataClocked' metaDataLogFile
|
|
|
|
addMetaDataClocked' :: (GitConfig -> Key -> FilePath) -> Key -> MetaData -> VectorClock -> Annex ()
|
|
addMetaDataClocked' getlogfile k d@(MetaData m) c
|
|
| d == emptyMetaData = noop
|
|
| otherwise = do
|
|
config <- Annex.getGitConfig
|
|
Annex.Branch.change (getlogfile config k) $
|
|
showLog . simplifyLog
|
|
. S.insert (LogEntry c metadata)
|
|
. parseLog
|
|
where
|
|
metadata = MetaData $ M.filterWithKey (\f _ -> not (isLastChangedField f)) m
|
|
|
|
addRemoteMetaData :: Key -> RemoteMetaData -> Annex ()
|
|
addRemoteMetaData k m = do
|
|
addMetaData' remoteMetaDataLogFile k (fromRemoteMetaData m)
|
|
|
|
getMetaDataLog :: Key -> Annex (Log MetaData)
|
|
getMetaDataLog key = do
|
|
config <- Annex.getGitConfig
|
|
readLog $ metaDataLogFile config key
|
|
|
|
{- Copies the metadata from the old key to the new key.
|
|
-
|
|
- The exact content of the metadata file is copied, so that the timestamps
|
|
- remain the same, and because this is more space-efficient in the git
|
|
- repository.
|
|
-
|
|
- Any metadata already attached to the new key is not preserved.
|
|
-
|
|
- Returns True when metadata was copied.
|
|
-}
|
|
copyMetaData :: Key -> Key -> Annex Bool
|
|
copyMetaData oldkey newkey
|
|
| oldkey == newkey = return False
|
|
| otherwise = do
|
|
l <- getMetaDataLog oldkey
|
|
if logToCurrentMetaData (S.toAscList l) == emptyMetaData
|
|
then return False
|
|
else do
|
|
config <- Annex.getGitConfig
|
|
Annex.Branch.change (metaDataLogFile config newkey) $
|
|
const $ showLog l
|
|
return True
|
|
|
|
readLog :: FilePath -> Annex (Log MetaData)
|
|
readLog = parseLog <$$> Annex.Branch.get
|