diff options
| -rw-r--r-- | Annex/View.hs | 48 | ||||
| -rw-r--r-- | Command/PreCommit.hs | 47 | ||||
| -rw-r--r-- | Logs/MetaData.hs | 12 | ||||
| -rw-r--r-- | Types/MetaData.hs | 6 | ||||
| -rw-r--r-- | debian/changelog | 2 | ||||
| -rw-r--r-- | doc/git-annex.mdwn | 11 |
6 files changed, 103 insertions, 23 deletions
diff --git a/Annex/View.hs b/Annex/View.hs index 6db31ce92..abf8f073e 100644 --- a/Annex/View.hs +++ b/Annex/View.hs @@ -13,19 +13,25 @@ import Common.Annex import Types.View import Types.MetaData import qualified Git -import qualified Git.DiffTree +import qualified Git.DiffTree as DiffTree import qualified Git.Branch import qualified Git.LsFiles +import qualified Git.Ref import Git.UpdateIndex import Git.Sha import Git.HashObject import Git.Types +import Git.FilePath import qualified Backend import Annex.Index import Annex.Link +import Annex.CatFile import Logs.MetaData import Logs.View import Utility.FileMode +import Types.Command +import Config +import CmdLine.Action import qualified Data.Set as S import System.Path.WildMatch @@ -337,14 +343,50 @@ applyView' mkfileview view = do -} updateView :: View -> Git.Ref -> Git.Ref -> Annex Git.Branch updateView view ref oldref = genViewBranch view $ do - (diffs, cleanup) <- inRepo $ Git.DiffTree.diffTree oldref ref + (diffs, cleanup) <- inRepo $ DiffTree.diffTree oldref ref forM_ diffs go void $ liftIO cleanup where go diff - | Git.DiffTree.dstsha diff == nullSha = error "TODO delete file" + | DiffTree.dstsha diff == nullSha = error "TODO delete file" | otherwise = error "TODO add file" +{- Diff between currently checked out branch and staged changes, and + - update metadata to reflect the changes that are being committed to the + - view. + - + - Adding a file to a directory adds the metadata represented by + - that directory to the file, and removing a file from a directory + - removes the metadata. + - + - Note that removes must be handled before adds. This is so + - that moving a file from x/foo/ to x/bar/ adds back the metadata for x. + -} +withViewChanges :: (FileView -> Key -> CommandStart) -> (FileView -> Key -> CommandStart) -> Annex () +withViewChanges addmeta removemeta = do + makeabs <- flip fromTopFilePath <$> gitRepo + (diffs, cleanup) <- inRepo $ DiffTree.diffIndex Git.Ref.headRef + forM_ diffs handleremovals + forM_ diffs (handleadds makeabs) + void $ liftIO cleanup + where + handleremovals item + | DiffTree.srcsha item /= nullSha = + handle item removemeta + =<< catKey (DiffTree.srcsha item) (DiffTree.srcmode item) + | otherwise = noop + handleadds makeabs item + | DiffTree.dstsha item /= nullSha = + handle item addmeta + =<< ifM isDirect + ( catKey (DiffTree.dstsha item) (DiffTree.dstmode item) + -- optimisation + , isAnnexLink $ makeabs $ DiffTree.file item + ) + | otherwise = noop + handle item a = maybe noop + (void . commandAction . a (getTopFilePath $ DiffTree.file item)) + {- Generates a branch for a view. This is done using a different index - file. An action is run to stage the files that will be in the branch. - Then a commit is made, to the view branch. The view branch is not diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs index 388d065c0..4b90b5c2e 100644 --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010, 2013 Joey Hess <joey@kitenet.net> + - Copyright 2010-2014 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -13,6 +13,13 @@ import Config import qualified Command.Add import qualified Command.Fix import Annex.Direct +import Annex.View +import Logs.View +import Logs.MetaData +import Types.View +import Types.MetaData + +import qualified Data.Set as S def :: [Command] def = [command "pre-commit" paramPaths seek SectionPlumbing @@ -27,13 +34,45 @@ seek ps = ifM isDirect withFilesToBeCommitted (whenAnnexed Command.Fix.start) ps -- inject unlocked files into the annex withFilesUnlockedToBeCommitted startIndirect ps + -- committing changes to a view updates metadata + mv <- currentView + case mv of + Nothing -> noop + Just v -> withViewChanges + (addViewMetaData v) + (removeViewMetaData v) ) startIndirect :: FilePath -> CommandStart -startIndirect file = next $ do - unlessM (callCommandAction $ Command.Add.start file) $ - error $ "failed to add " ++ file ++ "; canceling commit" +startIndirect f = next $ do + unlessM (callCommandAction $ Command.Add.start f) $ + error $ "failed to add " ++ f ++ "; canceling commit" next $ return True startDirect :: [String] -> CommandStart startDirect _ = next $ next $ preCommitDirect + +addViewMetaData :: View -> FileView -> Key -> CommandStart +addViewMetaData v f k = do + showStart "metadata" f + next $ next $ changeMetaData k $ fromView v f + +removeViewMetaData :: View -> FileView -> Key -> CommandStart +removeViewMetaData v f k = do + showStart "metadata" f + next $ next $ changeMetaData k $ unsetMetaData $ fromView v f + +changeMetaData :: Key -> MetaData -> CommandCleanup +changeMetaData k metadata = do + showMetaDataChange metadata + addMetaData k metadata + return True + +showMetaDataChange :: MetaData -> Annex () +showMetaDataChange = showLongNote . unlines . concatMap showmeta . fromMetaData + where + showmeta (f, vs) = map (showmetavalue f) $ S.toList vs + showmetavalue f v = fromMetaField f ++ showset v ++ "=" ++ fromMetaValue v + showset v + | isSet v = "+" + | otherwise = "-" diff --git a/Logs/MetaData.hs b/Logs/MetaData.hs index a959743df..807b50afa 100644 --- a/Logs/MetaData.hs +++ b/Logs/MetaData.hs @@ -28,8 +28,6 @@ module Logs.MetaData ( getCurrentMetaData, getMetaData, - setMetaData, - unsetMetaData, addMetaData, addMetaData', currentMetaData, @@ -58,16 +56,6 @@ getCurrentMetaData = currentMetaData . collect <$$> getMetaData where collect = foldl' unionMetaData newMetaData . map value . S.toAscList -setMetaData :: Key -> MetaField -> String -> Annex () -setMetaData = setMetaData' True - -unsetMetaData :: Key -> MetaField -> String -> Annex () -unsetMetaData = setMetaData' False - -setMetaData' :: Bool -> Key -> MetaField -> String -> Annex () -setMetaData' isset k field s = addMetaData k $ - updateMetaData field (mkMetaValue (CurrentlySet isset) s) newMetaData - {- Adds in some metadata, which can override existing values, or unset - them, but otherwise leaves any existing metadata as-is. -} addMetaData :: Key -> MetaData -> Annex () diff --git a/Types/MetaData.hs b/Types/MetaData.hs index 601757315..617c122a6 100644 --- a/Types/MetaData.hs +++ b/Types/MetaData.hs @@ -22,12 +22,14 @@ module Types.MetaData ( toMetaValue, mkMetaValue, unsetMetaValue, + unsetMetaData, fromMetaValue, fromMetaData, newMetaData, updateMetaData, unionMetaData, differenceMetaData, + isSet, currentMetaData, currentMetaDataValues, metaDataValues, @@ -137,6 +139,10 @@ mkMetaValue = MetaValue unsetMetaValue :: MetaValue -> MetaValue unsetMetaValue (MetaValue _ s) = MetaValue (CurrentlySet False) s +{- Marks all MetaValues as no longer currently set. -} +unsetMetaData :: MetaData -> MetaData +unsetMetaData (MetaData m) = MetaData $ M.map (S.map unsetMetaValue) m + fromMetaField :: MetaField -> String fromMetaField (MetaField f) = f diff --git a/debian/changelog b/debian/changelog index f1afdb821..36ed0b4d5 100644 --- a/debian/changelog +++ b/debian/changelog @@ -8,6 +8,8 @@ git-annex (5.20140211) UNRELEASED; urgency=medium * view: New command that creates and checks out a branch that provides a structured view of selected metadata. * vadd, vpop, vcycle: New commands for operating within views. + * pre-commit: Update metadata when committing changes to annexed files + within a view. * Add progress display for transfers to/from external special remotes. * Windows webapp: Can set up box.com, Amazon S3, and rsync.net remotes * Windows webapp: Can create repos on removable drives. diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index a5f73ac8e..cdd59ef9c 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -321,10 +321,12 @@ subdirectories). shown in the view. Multiple values for a metadata field can be specified, either by using - a glob (field="\*") or by listing each wanted value. + a glob (field="\*") or by listing each wanted value. The resulting view + will put files in subdirectories according to the value of their fields. - When multiple field values match, the view branch will have a - subdirectory for each value. + Once within a view, you can make additional subdirectories, and + copy or move files into them. When you commit, the metadata will + be updated to correspond to your changes. * `vpop [N]` @@ -801,7 +803,8 @@ subdirectories). Fixes up symlinks that are staged as part of a commit, to ensure they point to annexed content. Also handles injecting changes to unlocked - files into the annex. + files into the annex. When in a view, updates metadata to reflect changes + made to files in the view. * `lookupkey [file ...]` |