diff options
| author |  Joey Hess <joeyh@joeyh.name> | 2016-03-11 16:00:14 -0400 |
|---|---|---|
| committer | Joey Hess <joeyh@joeyh.name> | 2016-03-11 16:05:06 -0400 |
| commit | 92e8a321090bb45e0ae37e4298160f56652b1f1f (patch) | |
| tree | d59562279f36267414cdd63d756ce74caeeb15e6 /Git | |
| parent | e082d72b6a1afa651ddb5384f0b768ed26298536 (diff) | |
improve propigation of commits from adjusted branches
Only reverse adjust the changes in the commit, which means that adjustments
do not need to be generally cleanly reversable.
For example, an adjustment can unlock all locked files, but does not need
to worry about files that were originally unlocked when reversing, because
it will only ever be run on files that have been changed. So, it's ok
if it locks all files when reversed, or even leaves all files as-is when
reversed.
Diffstat (limited to 'Git')
| -rw-r--r-- | Git/FilePath.hs | 2 | ||||
| -rw-r--r-- | Git/Tree.hs | 10 |
2 files changed, 8 insertions, 4 deletions
diff --git a/Git/FilePath.hs b/Git/FilePath.hs index 5af74c067..db576fc8e 100644 --- a/Git/FilePath.hs +++ b/Git/FilePath.hs @@ -31,7 +31,7 @@ import qualified System.FilePath.Posix {- A FilePath, relative to the top of the git repository. -} newtype TopFilePath = TopFilePath { getTopFilePath :: FilePath } - deriving (Show, Eq) + deriving (Show, Eq, Ord) {- Path to a TopFilePath, within the provided git repo. -} fromTopFilePath :: TopFilePath -> Git.Repo -> FilePath diff --git a/Git/Tree.hs b/Git/Tree.hs index 9515dfc8b..7f28bcb6c 100644 --- a/Git/Tree.hs +++ b/Git/Tree.hs @@ -107,7 +107,7 @@ mkTreeOutput fm ot s f = concat ] data TreeItem = TreeItem TopFilePath FileMode Sha - deriving (Eq) + deriving (Show, Eq) treeItemToTreeContent :: TreeItem -> TreeContent treeItemToTreeContent (TreeItem f m s) = TreeBlob f m s @@ -122,7 +122,7 @@ adjustTree :: (MonadIO m, MonadMask m) => (TreeItem -> m (Maybe TreeItem)) -> [T adjustTree adjusttreeitem addtreeitems r repo = withMkTreeHandle repo $ \h -> do (l, cleanup) <- liftIO $ lsTreeWithObjects r repo (l', _, _) <- go h False [] inTopTree l - sha <- liftIO $ mkTree h l' + sha <- liftIO $ mkTree h (map treeItemToTreeContent addedtotop ++ l') void $ liftIO cleanup return sha where @@ -149,6 +149,7 @@ adjustTree adjusttreeitem addtreeitems r repo = withMkTreeHandle repo $ \h -> do go h modified' (subtree : c) intree is' _ -> error ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"") | otherwise = return (c, wasmodified, i:is) + addedtotop = filter (\(TreeItem f _ _) -> inTopTree' f) addtreeitems {- Assumes the list is ordered, with tree objects coming right before their - contents. -} @@ -176,7 +177,10 @@ extractTree l = case go [] inTopTree l of type InTree = LsTree.TreeItem -> Bool inTopTree :: InTree -inTopTree = notElem '/' . getTopFilePath . LsTree.file +inTopTree = inTopTree' . LsTree.file + +inTopTree' :: TopFilePath -> Bool +inTopTree' f = takeDirectory (getTopFilePath f) == "." beneathSubTree :: LsTree.TreeItem -> InTree beneathSubTree t = |