mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

convert History to use Set

Browse source 
This way the Ord instance doesn't care what order parent
Histories come in.
This commit is contained in:
Joey Hess 2019-04-23 15:08:37 -04:00
parent 8d01b00507
commit 29705d83f4
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 14 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

23
Annex/Import.hs
View file

@ -65,13 +65,13 @@ data ImportCommitConfig = ImportCommitConfig
, importCommitMessage :: String , importCommitMessage :: String
} }
{- Builds a commit for an import from a special remote. {- Buils a commit for an import from a special remote.
- -
- When a remote provided a history of versions of files, - When a remote provided a history of versions of files,
- builds a corresponding tree of git commits. - builds a corresponding tree of git commits.
- -
- When there are no changes to commit (ie, the imported tree is the same - When there are no changes to commit on top of the importCommitParent,
- as the tree in the importCommitParent), returns Nothing. - returns Nothing.
- -
- After importing from a remote, exporting the same thing back to the - After importing from a remote, exporting the same thing back to the
- remote should be a no-op. So, the export log and database are - remote should be a no-op. So, the export log and database are
@ -111,7 +111,7 @@ buildImportCommit remote importtreeconfig importcommitconfig importable =
return (Just finalcommit) return (Just finalcommit)
mkcommits origtree basecommit (History importedtree hs) = do mkcommits origtree basecommit (History importedtree hs) = do
parents <- catMaybes <$> mapM (mkcommits origtree basecommit) hs parents <- catMaybes <$> mapM (mkcommits origtree basecommit) (S.toList hs)
if importedtree == origtree && null parents if importedtree == origtree && null parents
then return Nothing -- no changes to commit then return Nothing -- no changes to commit
else do else do
@ -176,8 +176,8 @@ buildImportCommit remote importtreeconfig importcommitconfig importable =
Export.runExportDiffUpdater updater db oldtree finaltree Export.runExportDiffUpdater updater db oldtree finaltree
Export.closeDb db Export.closeDb db
data History t = History t [History t] data History t = History t (S.Set (History t))
deriving (Show) deriving (Show, Eq, Ord)
{- Builds a history of git trees reflecting the ImportableContents. {- Builds a history of git trees reflecting the ImportableContents.
- -
@ -190,10 +190,14 @@ buildImportTrees
-> ImportableContents Key -> ImportableContents Key
-> Annex (History Sha) -> Annex (History Sha)
buildImportTrees basetree msubdir importable = History buildImportTrees basetree msubdir importable = History
<$> (go (importableContents importable) =<< Annex.gitRepo) <$> (buildtree (importableContents importable) =<< Annex.gitRepo)
<*> mapM (buildImportTrees basetree msubdir) (importableHistory importable) <*> buildhistory
where where
go ls repo = withMkTreeHandle repo $ \hdl -> do buildhistory = S.fromList
<$> mapM (buildImportTrees basetree msubdir)
(importableHistory importable)
buildtree ls repo = withMkTreeHandle repo $ \hdl -> do
importtree <- liftIO . recordTree' hdl importtree <- liftIO . recordTree' hdl
. treeItemsToTree . treeItemsToTree
=<< mapM mktreeitem ls =<< mapM mktreeitem ls
@ -201,6 +205,7 @@ buildImportTrees basetree msubdir importable = History
Nothing -> return importtree Nothing -> return importtree
Just subdir -> liftIO $ Just subdir -> liftIO $
graftTree' importtree subdir basetree repo hdl graftTree' importtree subdir basetree repo hdl
mktreeitem (loc, k) = do mktreeitem (loc, k) = do
let lf = fromImportLocation loc let lf = fromImportLocation loc
let treepath = asTopFilePath lf let treepath = asTopFilePath lf