import qualified Git.DiffTree as DiffTree
import qualified Git.Branch
import qualified Git.LsFiles
+import qualified Git.LsTree
import qualified Git.Ref
import Git.UpdateIndex
import Git.Sha
- or a file in a dotdir in the top.
- Look up the metadata of annexed files, and generate any ViewedFiles,
- and stage them.
- -
- - Must be run from top of repository.
-}
applyView' :: MkViewedFile -> (FilePath -> MetaData) -> View -> Annex Git.Branch
applyView' mkviewedfile getfilemetadata view = do
top <- fromRepo Git.repoPath
(l, clean) <- inRepo $ Git.LsFiles.inRepoDetails [] [top]
- liftIO . removeWhenExistsWith R.removeLink =<< fromRepo gitAnnexViewIndex
- viewg <- withViewIndex gitRepo
- withUpdateIndex viewg $ \uh -> do
- forM_ l $ \(f, sha, mode) -> do
+ applyView'' mkviewedfile getfilemetadata view l clean $
+ \go (f, sha, mode) -> do
topf <- inRepo (toTopFilePath f)
- go uh topf sha (toTreeItemType mode) =<< lookupKey f
- liftIO $ void clean
+ go topf sha (toTreeItemType mode) =<< lookupKey f
genViewBranch view
+
+applyView''
+ :: MkViewedFile
+ -> (FilePath -> MetaData)
+ -> View
+ -> [t]
+ -> IO Bool
+ -> ((TopFilePath -> Sha -> Maybe TreeItemType -> Maybe Key -> Annex ()) -> t -> Annex ())
+ -> Annex ()
+applyView'' mkviewedfile getfilemetadata view l clean a = do
+ viewg <- withNewViewIndex gitRepo
+ withUpdateIndex viewg $ \uh -> do
+ forM_ l $ a (go uh)
+ liftIO $ void clean
where
genviewedfiles = viewedFiles view mkviewedfile -- enables memoization
liftIO . Git.UpdateIndex.streamUpdateIndex' uh
=<< inRepo (Git.UpdateIndex.stageSymlink f sha)
+{- Updates the current view with any changes that have been made to its
+ - parent branch or the metadata since the view was created or last updated.
+ -
+ - When there were changes, returns a ref to a commit for the updated view.
+ - Does not update the view branch with it.
+ -
+ - This is not very optimised. An incremental update would be possible to
+ - implement and would be faster, but more complicated.
+ -}
+updateView :: View -> Annex (Maybe Git.Ref)
+updateView view = do
+ (l, clean) <- inRepo $ Git.LsTree.lsTree
+ Git.LsTree.LsTreeRecursive
+ (Git.LsTree.LsTreeLong True)
+ (viewParentBranch view)
+ applyView'' viewedFileFromReference getWorkTreeMetaData view l clean $
+ \go ti -> do
+ let ref = Git.Ref.branchFileRef (viewParentBranch view)
+ (getTopFilePath (Git.LsTree.file ti))
+ k <- case Git.LsTree.size ti of
+ Nothing -> catKey ref
+ Just sz -> catKey' ref sz
+ go
+ (Git.LsTree.file ti)
+ (Git.LsTree.sha ti)
+ (toTreeItemType (Git.LsTree.mode ti))
+ k
+ oldcommit <- inRepo $ Git.Ref.sha (branchView view)
+ oldtree <- maybe (pure Nothing) (inRepo . Git.Ref.tree) oldcommit
+ newtree <- withViewIndex $ inRepo Git.Branch.writeTree
+ if oldtree /= Just newtree
+ then Just <$> do
+ cmode <- annexCommitMode <$> Annex.getGitConfig
+ let msg = "updated " ++ fromRef (branchView view)
+ let parent = catMaybes [oldcommit]
+ inRepo (Git.Branch.commitTree cmode msg parent newtree)
+ else return Nothing
+
{- Diff between currently checked out branch and staged changes, and
- update metadata to reflect the changes that are being committed to the
- view.
withViewIndex :: Annex a -> Annex a
withViewIndex = withIndexFile ViewIndexFile . const
+withNewViewIndex :: Annex a -> Annex a
+withNewViewIndex a = do
+ liftIO . removeWhenExistsWith R.removeLink =<< fromRepo gitAnnexViewIndex
+ withViewIndex a
+
{- Generates a branch for a view, using the view index file
- to make a commit to the view branch. The view branch is not
- checked out, but entering it will display the view. -}
{- git-annex command
-
- Copyright 2011 Joachim Breitner <mail@joachim-breitner.de>
- - Copyright 2011-2021 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2023 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
import Logs.UUID
import Logs.Export
import Logs.PreferredContent
-import Logs.View (fromViewBranch)
+import Logs.View
import Annex.AutoMerge
import Annex.AdjustedBranch
import Annex.AdjustedBranch.Merge
+import Annex.View
import Annex.Ssh
import Annex.BloomFilter
import Annex.UpdateInstead
-- to be updated, if the adjustment is not stable, and the usual
-- configuration does not update it.
case madj of
- Nothing -> noop
Just adj -> do
let origbranch = branch
propigateAdjustedCommits origbranch adj
annexAdjustedBranchRefresh <$> Annex.getGitConfig >>= \case
0 -> adjustedBranchRefreshFull adj origbranch
_ -> return ()
+ -- When in a view branch, update it to reflect any changes
+ -- of its parent branch or the metadata.
+ Nothing -> currentView >>= \case
+ Nothing -> noop
+ Just view -> updateView view >>= \case
+ Nothing -> noop
+ Just newcommit -> do
+ ok <- inRepo $ Git.Command.runBool
+ [ Param "merge"
+ , Param (Git.fromRef newcommit)
+ ]
+ unless ok $
+ giveup $ "failed to update view"
-- Update the sync branch to match the new state of the branch
inRepo $ updateBranch (syncBranch branch) branch
updateBranch :: Git.Branch -> Git.Branch -> Git.Repo -> IO ()
updateBranch syncbranch updateto g =
- unlessM go $ giveup $ "failed to update " ++ Git.fromRef syncbranch
+ unlessM go $
+ giveup $ "failed to update " ++ Git.fromRef syncbranch
where
go = Git.Command.runBool
[ Param "branch"
--- /dev/null
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2023-02-08T19:32:34Z"
+ content="""
+`git-annex sync` when in a view branch will now update it.
+
+Leaving this open for optimising it.
+
+Also because of this problem:
+
+ joey@darkstar:~/tmp/m#master(author=_)>git-annex sync
+ commit
+ On branch views/master(author=_)
+ nothing to commit, working tree clean
+ ok
+ merge synced/master
+ fatal: refusing to merge unrelated histories
+ failed
+
+Looks like it should not be trying to merge the synced/master
+branch into the view branch. But, this makes me wonder, does the master branch
+get updated with new files pulled from remotes? If not, the view branch
+won't be updated to have them either.
+
+Also, I think that it may try to import trees from importree special remotes,
+into the view branch. Perhaps those should also get imported but merged into
+the master branch...
+"""]]