From d9d8b83714e0c297858801c5fbf5bca056738ca8 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 25 Feb 2016 16:11:13 -0400
Subject: adjusted branches, proof of concept

"git annex adjust" may be a temporary interface, but works for a proof of
concept.

It is pretty fast at creating the adjusted branch. The main overhead is
injecting pointer files. It might be worth optimising that by reusing the
symlink target as the pointer file content. When I tried to do that,
the problem was that the clean filter doesn't use that same format, and so
git thought files had changed. Could be dealt with, perhaps make the clean
filter use symlink format for pointer files when on an adjusted branch?

But the real overhead is in checking out the branch, when git runs the
smudge filter once per file. That is perhaps too slow to be usable,
although it may only affect initial checkout of the branch, and not
updates. TBD.
---
 Annex/AdjustedBranch.hs | 102 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 102 insertions(+)
 create mode 100644 Annex/AdjustedBranch.hs

(limited to 'Annex/AdjustedBranch.hs')

diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs
new file mode 100644
index 000000000..b80ade7c4
--- /dev/null
+++ b/Annex/AdjustedBranch.hs
@@ -0,0 +1,102 @@
+{- adjusted version of main branch
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.AdjustedBranch where
+
+import Annex.Common
+import qualified Annex
+import Git.Types
+import qualified Git.Branch
+import qualified Git.Ref
+import qualified Git.Command
+import Git.Tree
+import Git.Env
+import Annex.CatFile
+import Annex.Link
+import Git.HashObject
+
+data Adjustment = UnlockAdjustment
+	deriving (Show)
+
+adjustTreeItem :: Adjustment -> HashObjectHandle -> TreeItem -> Annex (Maybe TreeItem)
+adjustTreeItem UnlockAdjustment h ti@(TreeItem f m s)
+	| toBlobType m == Just SymlinkBlob = do
+		mk <- catKey s
+		case mk of
+			Just k -> Just . TreeItem f (fromBlobType FileBlob)
+				<$> hashPointerFile' h k
+			Nothing -> return (Just ti)
+	| otherwise = return (Just ti)
+
+type OrigBranch = Branch
+type AdjBranch = Branch
+
+adjustedBranchPrefix :: String
+adjustedBranchPrefix = "refs/heads/adjusted/"
+
+originalToAdjusted :: OrigBranch -> AdjBranch
+originalToAdjusted orig = Ref $ adjustedBranchPrefix ++ takeFileName (fromRef orig)
+
+adjustedToOriginal :: AdjBranch -> Maybe (OrigBranch)
+adjustedToOriginal b
+	| adjustedBranchPrefix `isPrefixOf` bs =
+		Just $ Ref $ drop prefixlen bs
+	| otherwise = Nothing
+  where
+	bs = fromRef b
+	prefixlen = length adjustedBranchPrefix
+
+originalBranch :: Annex (Maybe OrigBranch)
+originalBranch = fmap getorig <$> inRepo Git.Branch.current
+  where
+	getorig currbranch = fromMaybe currbranch (adjustedToOriginal currbranch)
+
+{- Enter an adjusted version of current branch (or, if already in an
+ - adjusted version of a branch, changes the adjustment of the original
+ - branch).
+ -
+ - Can fail, if no branch is checked out, or perhaps if staged changes
+ - conflict with the adjusted branch.
+ -}
+enterAdjustedBranch :: Adjustment -> Annex ()
+enterAdjustedBranch adj = go =<< originalBranch
+  where
+	go (Just origbranch) = do
+		adjbranch <- adjustBranch adj origbranch
+		inRepo $ Git.Command.run
+			[ Param "checkout"
+			, Param $ fromRef $ Git.Ref.base $ adjbranch
+			]
+	go Nothing = error "not on any branch!"
+
+adjustBranch :: Adjustment -> OrigBranch -> Annex AdjBranch
+adjustBranch adj origbranch = do
+	h <- inRepo hashObjectStart
+	treesha <- adjustTree (adjustTreeItem adj h) origbranch =<< Annex.gitRepo
+	liftIO $ hashObjectStop h
+	commitsha <- commitAdjustedTree treesha origbranch
+	inRepo $ Git.Branch.update adjbranch commitsha
+	return adjbranch
+  where
+	adjbranch = originalToAdjusted origbranch
+
+{- Commits a given adjusted tree, with the provided parent ref.
+ -
+ - This should always yield the same value, even if performed in different 
+ - clones of a repo, at different times. The commit message and other
+ - metadata is based on the parent.
+ -}
+commitAdjustedTree :: Sha -> Ref -> Annex Sha
+commitAdjustedTree treesha parent = go =<< catCommit parent
+  where
+	go Nothing = inRepo mkcommit
+	go (Just parentcommit) = inRepo $ commitWithMetaData
+		(commitAuthorMetaData parentcommit)
+		(commitCommitterMetaData parentcommit)
+		mkcommit
+	mkcommit = Git.Branch.commitTree
+		Git.Branch.AutomaticCommit "adjusted branch" [parent] treesha
-- 
cgit v1.2.3