wip

Annex/Import.hs

@@ -105,9 +105,9 @@ buildImportCommit remote importtreeconfig importcommitconfig importable =
 	go basecommit = do
 		imported@(History finaltree _) <-
 			buildImportTrees basetree subdir importable
-		skipOldHistory basecommit imported >>= \case
-			Just toadd -> do
-				finalcommit <- mkcommits basecommit toadd
+		whatToCommit basecommit imported >>= \case
+			Just (toadd, basecommit') -> do
+				finalcommit <- mkcommits basecommit' toadd
 				updatestate finaltree
 				return (Just finalcommit)
 			Nothing -> return Nothing
@@ -177,14 +177,14 @@ buildImportCommit remote importtreeconfig importcommitconfig importable =
 {- Finds what to commit to update a basecommit with an imported History
  - of git trees.
  -
- - Returns a generally truncated History, as well as the Sha that it should
- - be committed on top of. Typically, the latter is the same as the
- - basecommit.
+ - Returns the part of the imported history that should be committed, 
+ - as well as the commit sha that it should be committed on top of. 
+ - Typically, the latter is the same as the basecommit.
  -
  - This uses skipOldHistory to try to match up common trees.
  - Sometimes, that matching doesn't work. For example, a remote without an
- - atomic rename operation might result in a History with two trees for
- - each rename, one with the old file removed an another with the new file
+ - atomic rename operation might result in an imported History with two trees
+ - for each rename, one with the old file removed an another with the new file
  - added. Since the remote tracking branch is updated on export to the git
  - commit that was exported, the basecommit could have a single tree for a
  - rename.
@@ -192,35 +192,37 @@ buildImportCommit remote importtreeconfig importcommitconfig importable =
  - In that situation, the top tree in the History will match the
  - basecommit's tree, but then there will be a run of different trees
  - before they re-converge. That is detected, and the History returned is
- - truncated to the part above the re-convergence point, and the Sha
- - returned is the re-convergence point.
+ - truncated to the part above the re-convergence point, to be committed
+ - on top of the re-convergence point.
  -}
-whatToCommit :: Maybe Sha -> History Sha -> Annex (Maybe (History Sha, Sha))
-whatToCommit Nothing importedhistory = return (Just importedhistory)
-whatToCommit (Just basecommit) importedhistory =
-	maybe (Just importedhistory) (whatToCommit' importedhistory) 
-		<$> getknownhistory
+whatToCommit :: Maybe Sha -> History Sha -> Annex (Maybe (History Sha, Maybe Sha))
+whatToCommit (Just basecommit) importedhistory = getknownhistory >>= return . \case
+	Just knownhistory -> whatToCommit' importedhistory basecommit knownhistory
+	Nothing -> Just (importedhistory, Nothing)
   where
-	getknownhistory = inRepo (getTreeHistoryToDepth (historyDepth importedhistory) basecommit)
+	getknownhistory = inRepo $
+		getHistoryToDepth (historyDepth importedhistory) basecommit
+whatToCommit Nothing importedhistory = return $ Just (importedhistory, Nothing)
 
-whatToCommit' :: History Sha -> History Sha -> Maybe (History Sha, Sha)
-whatToCommit' importedhistory knownhistory@(History ktop _) =
-	case skipOldHistory knownhistory importedhistory of
+whatToCommit' :: History Sha -> Sha -> History HistoryCommit -> Maybe (History Sha, Maybe Sha)
+whatToCommit' importedhistory basecommit knownhistory@(History ktop _) =
+	case skipOldHistory (mapHistory historyCommitTree knownhistory) importedhistory of
 		Nothing -> Nothing
 		Just newhistory@(History ntop _)
-			| ntop /= ktop -> newhistory
-			| otherwise -> 
-				-- XXX find convergence point
+			| ntop /= historyCommitTree ktop -> 
+				Just (newhistory, Just basecommit)
+			-- XXX find convergence point
+			| otherwise -> undefined
 
 {- Finds the part of the importedhistory of git trees that is new and
  - should be committed on top of the knownhistory, skipping parts that have
  - already been committed.
  -
- - Will be Nothing if the knownhistory already matches the top of the
- - importedhistory.
+ - Will be Nothing if the knownhistory is already present at the top of
+ - the importedhistory.
  -
  - In the simple case where there is only one level of importedhistory,
- - when the knownhistory is has the same tree at its top, there's nothing
+ - when the knownhistory has the same tree at its top, there's nothing
  - to commit. And otherwise it should be committed on top of the knownhistory.
  -
  - In the complex case where there are several levels of importedhistory, 
@@ -235,7 +237,7 @@ skipOldHistory knownhistory importedhistory@(History top rest)
 	| sametodepth importedhistory knownhistory = Nothing
 	| otherwise = Just $ 
 		History top $ S.fromList $ catMaybes $
-			map (skipOldHistory' knownhistory) (S.toList rest)
+			map (skipOldHistory knownhistory) (S.toList rest)
   where
 	sametodepth a b = a == truncateHistoryToDepth (historyDepth a) b