don't empty historyCommitParents

This commit is contained in:
Joey Hess 2019-05-01 13:38:40 -04:00
parent 2bd0e07ed8
commit 4a8f02e939
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38

View file

@ -59,7 +59,7 @@ getHistoryToDepth n commit r = do
void $ waitForProcess pid void $ waitForProcess pid
return h return h
where where
build h [] = h build h [] = fmap (mapHistory fst) h
build _ (Nothing:_) = Nothing build _ (Nothing:_) = Nothing
build Nothing (Just v:rest) = build Nothing (Just v:rest) =
build (Just (History v S.empty)) rest build (Just (History v S.empty)) rest
@ -72,17 +72,16 @@ getHistoryToDepth n commit r = do
-- history. -- history.
if parentsfound h' then [] else rest if parentsfound h' then [] else rest
traverseadd hc (History hc' s) traverseadd v@(hc, _ps) (History v'@(hc', ps') s)
| historyCommit hc `elem` historyCommitParents hc' = | historyCommit hc `elem` ps' =
let otherps = filter (/= historyCommit hc) (historyCommitParents hc') let ps'' = filter (/= historyCommit hc) ps'
hc'' = hc' { historyCommitParents = otherps } in History (hc', ps'') (S.insert (History v S.empty) s)
in History hc'' (S.insert (History hc S.empty) s) | otherwise = History v' (S.map (traverseadd v) s)
| otherwise = History hc' (S.map (traverseadd hc) s)
parentsfound = parentsfound' 1 parentsfound = parentsfound' 1
parentsfound' depth (History hc s) parentsfound' depth (History (_hc, ps) s)
| not (null (historyCommitParents hc)) = False | not (null ps) = False
| null (historyCommitParents hc) && depth == n = True | null ps && depth == n = True
| depth >= n = True | depth >= n = True
| otherwise = all (parentsfound' (succ depth)) (S.toList s) | otherwise = all (parentsfound' (succ depth)) (S.toList s)
@ -95,9 +94,12 @@ getHistoryToDepth n commit r = do
] ]
parsehistorycommit l = case map extractSha (splitc ' ' l) of parsehistorycommit l = case map extractSha (splitc ' ' l) of
(Just t:Just c:ps) -> Just $ HistoryCommit (Just t:Just c:ps) -> Just $
{ historyCommit = c ( HistoryCommit
, historyCommitTree = t { historyCommit = c
, historyCommitParents = catMaybes ps , historyCommitTree = t
} , historyCommitParents = catMaybes ps
}
, catMaybes ps
)
_ -> Nothing _ -> Nothing