Hi Juliusz,
Here's a bundle of all the patches I've got at the moment in my refactoring
branch. I think this should be suitable for application to darcs-unstable.
David
Sat Jul 15 18:12:45 PDT 2006 David Roundy <[EMAIL PROTECTED]>
* refactor Repository to allow truly atomic updates.
Sat Jul 15 18:18:53 PDT 2006 David Roundy <[EMAIL PROTECTED]>
* refactor tag.
Sat Jul 15 18:51:50 PDT 2006 David Roundy <[EMAIL PROTECTED]>
* refactor Unrecord, adding tentativelyRemovePatches.
Sat Jul 15 19:02:47 PDT 2006 David Roundy <[EMAIL PROTECTED]>
* add TODO to refactor unrevert handling.
Sat Jul 15 19:10:03 PDT 2006 David Roundy <[EMAIL PROTECTED]>
* refactor amend-record.
Sat Jul 15 20:16:05 PDT 2006 David Roundy <[EMAIL PROTECTED]>
* partial refactoring of Get.
Sat Jul 15 20:29:34 PDT 2006 David Roundy <[EMAIL PROTECTED]>
* partially refactor Optimize.
Sat Jul 15 20:31:09 PDT 2006 David Roundy <[EMAIL PROTECTED]>
* I've now eliminated need to export DarcsRepo.write_patch.
Sat Jul 15 20:34:50 PDT 2006 David Roundy <[EMAIL PROTECTED]>
* don't use DarcsRepo in list_authors.
Sat Jul 15 20:43:19 PDT 2006 David Roundy <[EMAIL PROTECTED]>
* partial refactoring in annotate.
Sat Jul 15 20:43:39 PDT 2006 David Roundy <[EMAIL PROTECTED]>
* add TODO for refactoring get_markedup_file.
Sat Jul 15 20:48:37 PDT 2006 David Roundy <[EMAIL PROTECTED]>
* refactor Population.
Wed Jul 26 05:16:55 PDT 2006 David Roundy <[EMAIL PROTECTED]>
* fix bug in refactoring of get.
Wed Jul 26 05:17:37 PDT 2006 David Roundy <[EMAIL PROTECTED]>
* simplify code a tad in get.
Sun Jul 30 03:38:54 PDT 2006 David Roundy <[EMAIL PROTECTED]>
* make amend-record.pl test a bit pickier.
Sun Jul 30 04:14:09 PDT 2006 David Roundy <[EMAIL PROTECTED]>
* fix ordering of operations to call pull_first_middles properly.
Sun Jul 30 13:54:52 PDT 2006 David Roundy <[EMAIL PROTECTED]>
* add new test that triggers bug in refactoring.
Mon Jul 31 04:14:04 PDT 2006 David Roundy <[EMAIL PROTECTED]>
* fix bug in pristine handling when dealing with multiple patches.
New patches:
[refactor Repository to allow truly atomic updates.
David Roundy <[EMAIL PROTECTED]>**20060716011245] {
hunk ./Apply.lhs 46
- with_new_pending, sync_repo, read_repo, updateInventory,
- applyToPristine,
+ with_new_pending, sync_repo, read_repo,
+ tentativelyAddPatch, finalizeRepositoryChanges,
hunk ./Apply.lhs 63
-import Pull ( merge_with_us_and_pending, save_patches,
- check_unrecorded_conflicts )
+import Pull ( merge_with_us_and_pending, check_unrecorded_conflicts )
hunk ./Apply.lhs 179
- tokens <- save_patches repository opts $ unjoin_patches us_patch
+ mapM_ (tentativelyAddPatch repository opts) $ fromJust $ unjoin_patches us_patch
hunk ./Apply.lhs 183
- applyToPristine repository us_patch `catch` \e ->
- fail ("Error applying patch to recorded!\nRunning 'darcs repair' on the target repository may help.\n" ++ show e)
+ finalizeRepositoryChanges repository
hunk ./Apply.lhs 185
- updateInventory repository tokens
hunk ./DarcsRepo.lhs 54
- write_inventory, add_to_inventory, read_repo,
+ write_inventory,
+ add_to_inventory, add_to_tentative_inventory,
+ finalize_tentative_changes,
+ revert_tentative_changes,
+ read_repo,
hunk ./DarcsRepo.lhs 76
-import DarcsUtils ( withCurrentDirectory, bugDoc )
+import DarcsUtils ( withCurrentDirectory, bugDoc, clarify_errors )
hunk ./DarcsRepo.lhs 83
+ readFilePS, writeFilePS,
hunk ./DarcsRepo.lhs 97
- writePatch, gzWritePatch,
+ writePatch, gzWritePatch, showPatch,
hunk ./DarcsRepo.lhs 116
+ applyPristine,
hunk ./DarcsRepo.lhs 376
+
+add_to_tentative_inventory :: [DarcsFlag] -> Patch -> IO FilePath
+add_to_tentative_inventory opts p =
+ do appendDocBinFile ("_darcs/tentative_inventory") $ showPatchInfo pinf
+ appendDocBinFile ("_darcs/tentative_pristine") $ showPatch p -- FIXME: this is inefficient!
+ write_patch opts p
+ where pinf = fromJust $ patch2patchinfo p
+
+finalize_tentative_changes :: IO ()
+finalize_tentative_changes = withSignalsBlocked $
+ do ps <- read_patches "_darcs/tentative_pristine"
+ pris <- identifyPristine
+ repairable $ applyPristine pris $ join_patches ps
+ renameFile "_darcs/tentative_inventory" "_darcs/inventory"
+ where read_patches f = do ps <- readFilePS f
+ return $ rp ps
+ rp ps = case readPatch ps of
+ Just (p, rest) -> p : rp rest
+ Nothing -> []
+ repairable x = x `clarify_errors` unlines
+ ["Your repository is now in an inconsistent state.",
+ "This must be fixed by running darcs repair."]
+
+revert_tentative_changes :: IO ()
+revert_tentative_changes =
+ do readFilePS "_darcs/inventory" >>= writeFilePS "_darcs/tentative_inventory"
+ writeBinFile "_darcs/tentative_pristine" ""
hunk ./GitRepo.lhs 18
-module GitRepo ( read_repo, slurpHead, writePatch, updateInventory
+module GitRepo ( read_repo, slurpHead, writePatch, updateInventory,
+ set_tentative_tree, finalize_tentative_changes,
+ revert_tentative_changes,
hunk ./GitRepo.lhs 281
+set_tentative_tree :: String -> IO ()
+set_tentative_tree _ = fail "git needs fixing"
+
+revert_tentative_changes :: IO ()
+revert_tentative_changes = fail "git needs fixing"
+
+finalize_tentative_changes :: IO ()
+finalize_tentative_changes = fail "git needs fixing"
+
hunk ./Pull.lhs 18
-module Pull ( pull, merge_with_us_and_pending, save_patches,
+module Pull ( pull, merge_with_us_and_pending,
hunk ./Pull.lhs 39
-import Repository ( Repository, PatchToken, PatchSet, identifyRepository,
+import Repository ( PatchSet, identifyRepository,
hunk ./Pull.lhs 44
- applyToPristine, writePatch, updateInventory,
+ tentativelyAddPatch, finalizeRepositoryChanges,
hunk ./Pull.lhs 170
- patchTokens <- save_patches repository opts $ unjoin_patches pc
+ mapM_ (tentativelyAddPatch repository opts) $ fromJust $ unjoin_patches pc
hunk ./Pull.lhs 174
- repairable $ applyToPristine repository pc
- `catch` \e ->
- fail ("Error applying patch to recorded.\nRunning 'darcs repair' on the target repository may help.\n" ++ show e)
- updateInventory repository patchTokens
+ finalizeRepositoryChanges repository
hunk ./Pull.lhs 183
- repairable x = x `clarify_errors` unlines
- ["Your repository is now in an inconsistent state.",
- "This must be fixed by running darcs repair."]
hunk ./Pull.lhs 263
-\begin{code}
-save_patches :: Repository -> [DarcsFlag] -> Maybe [Patch] ->
- IO [(PatchInfo, PatchToken)]
-save_patches _ _ (Just []) = return []
-save_patches _ _ Nothing = return []
-save_patches repo opts (Just (p:ps)) =
- do p' <- (liftM ppt2pipt) (writePatch repo opts p)
- ps' <- save_patches repo opts $ Just ps
- return (p':ps')
- where ppt2pipt :: (Patch, PatchToken) -> (PatchInfo, PatchToken)
- ppt2pipt (patch, pt) = (fromJust (patch2patchinfo patch), pt)
-\end{code}
-
hunk ./Record.lhs 40
- slurp_recorded, updateInventory, writePatch,
- applyToPristine, patchTokenToPatchFile
+ slurp_recorded,
+ tentativelyAddPatch, finalizeRepositoryChanges,
hunk ./Record.lhs 46
- gzReadPatchFileLazily,
hunk ./Record.lhs 47
-import PatchInfo ( PatchInfo, patchinfo )
+import PatchInfo ( PatchInfo )
hunk ./Record.lhs 182
- myinfo = patchinfo date name my_author my_log
hunk ./Record.lhs 186
- (mypatch', token) <-
- writePatch repository opts $ adddeps mypatch deps
+ mypatch' <- tentativelyAddPatch repository opts $ adddeps mypatch deps
hunk ./Record.lhs 188
- when want_test $ do
- let mfp = patchTokenToPatchFile token
- let logmsg = "Logfile left in " ++ (fromJust logf) ++ "."
- case mfp of
- Just fp ->
- do testproblem <-
- (gzReadPatchFileLazily fp >>=
- (test_patch opts))
- when (testproblem /= ExitSuccess) $ do
- when (Verbose `elem` opts) $
- logMessage "Removing the patch file."
- removeFile fp
- when (isJust logf) $
- logMessage $ logmsg
- exitWith $ ExitFailure 1
- return ()
- Nothing -> return ()
- when (Verbose `elem` opts) $
- logMessage "Applying to current..."
+ when want_test $
+ do testproblem <- test_patch opts mypatch' -- FIXME MEMORY HOG
+ when (testproblem /= ExitSuccess) $ do
+ when (Verbose `elem` opts) $ logMessage "Removing the patch file."
+ when (isJust logf) $
+ logMessage $ "Logfile left in " ++ (fromJust logf) ++ "."
+ exitWith $ ExitFailure 1
+ when (Verbose `elem` opts) $ logMessage "Applying to current..."
hunk ./Record.lhs 197
- with_new_pending repository (join_patches skipped) $ do
- applyToPristine repository mypatch'
- updateInventory repository [(myinfo, token)]
+ with_new_pending repository (join_patches skipped) $
+ finalizeRepositoryChanges repository
hunk ./Repository.lhs 28
- PatchToken, patchTokenToPatchFile,
- writePatch, updateInventory, unrevertUrl,
+ tentativelyAddPatch, unrevertUrl,
+ finalizeRepositoryChanges,
hunk ./Repository.lhs 47
-import PatchInfo ( PatchInfo )
hunk ./Repository.lhs 51
-import Workaround ( getCurrentDirectory )
hunk ./Repository.lhs 242
--- writePatch returns an opaque token that should be passed to updateInventory.
+tentativelyAddPatch :: Repository -> [DarcsFlag] -> Patch -> IO Patch
+tentativelyAddPatch (Repo dir _ (DarcsRepository _)) opts patch =
+ withCurrentDirectory dir $ do
+ fp <- DarcsRepo.add_to_tentative_inventory opts patch
+ gzReadPatchFileLazily fp
+tentativelyAddPatch (Repo dir _ GitRepository) _ patch =
+ withCurrentDirectory dir $ do (patch', token) <- GitRepo.writePatch dir patch
+ GitRepo.set_tentative_tree token
+ return patch'
hunk ./Repository.lhs 252
-data PatchToken = DarcsPatchToken !String | GitPatchToken !String
+finalizeRepositoryChanges :: Repository -> IO ()
+finalizeRepositoryChanges (Repo dir _ (DarcsRepository _)) =
+ withCurrentDirectory dir $ DarcsRepo.finalize_tentative_changes
+finalizeRepositoryChanges (Repo dir _ GitRepository) =
+ withCurrentDirectory dir $ GitRepo.finalize_tentative_changes
hunk ./Repository.lhs 258
-writePatch :: Repository -> [DarcsFlag] -> Patch -> IO (Patch, PatchToken)
-writePatch (Repo dir _ (DarcsRepository _)) opts patch =
- withCurrentDirectory dir $
- do fp <- DarcsRepo.write_patch opts patch
- patch' <- gzReadPatchFileLazily fp
- return (patch', DarcsPatchToken fp)
-writePatch (Repo dir _ GitRepository) _ patch =
- withCurrentDirectory dir $
- do cd <- getCurrentDirectory
- (patch', token) <- GitRepo.writePatch cd patch
- return (patch', GitPatchToken token)
-
--- this should be called with signals blocked
-updateInventory :: Repository -> [(PatchInfo, PatchToken)] -> IO ()
-updateInventory (Repo dir _ (DarcsRepository _)) l =
- withCurrentDirectory dir $
- DarcsRepo.add_to_inventory "." (map fst l)
-updateInventory (Repo dir _ GitRepository) l =
- withCurrentDirectory dir $
- GitRepo.updateInventory (map (\(_,(GitPatchToken t)) -> t) l)
-
-patchTokenToPatchFile :: PatchToken -> Maybe String
-patchTokenToPatchFile (DarcsPatchToken fp) = Just fp
-patchTokenToPatchFile _ = Nothing
+revertRepositoryChanges :: Repository -> IO ()
+revertRepositoryChanges (Repo dir _ (DarcsRepository _)) =
+ withCurrentDirectory dir $ DarcsRepo.revert_tentative_changes
+revertRepositoryChanges (Repo dir _ GitRepository) =
+ withCurrentDirectory dir $ GitRepo.revert_tentative_changes
hunk ./Repository.lhs 276
- withLock name (job repository)
+ withLock name (revertRepositoryChanges repository >> job repository)
hunk ./Rollback.lhs 28
- applyToPristine, writePatch, updateInventory,
+ tentativelyAddPatch, finalizeRepositoryChanges,
hunk ./Rollback.lhs 88
- Just pinfo ->
- do (_, t) <- writePatch repository opts $ invert p
+ Just _ ->
+ do tentativelyAddPatch repository opts $ invert p
hunk ./Rollback.lhs 92
- do applyToPristine repository (invert p) `catch` \e ->
- fail ("Unable to apply inverse patch!\n" ++ show e)
- updateInventory repository [(pinfo, t)]
+ finalizeRepositoryChanges repository
}
[refactor tag.
David Roundy <[EMAIL PROTECTED]>**20060716011853] {
hunk ./Tag.lhs 19
-import Monad ( liftM, when )
+import Monad ( when )
hunk ./Tag.lhs 24
-import Repository ( withRepoLock )
-import DarcsRepo
+import Repository ( amInRepository, withRepoLock, read_repo,
+ tentativelyAddPatch, finalizeRepositoryChanges,
+ )
+import DarcsRepo ( write_recorded_checkpoint )
hunk ./Tag.lhs 62
- command_prereq = am_in_repo,
+ command_prereq = amInRepository,
hunk ./Tag.lhs 72
-tag_cmd opts args = withRepoLock $ \_ -> do
+tag_cmd opts args = withRepoLock $ \repository -> do
hunk ./Tag.lhs 75
- deps <- liftM get_tags_right $ read_repo "."
+ deps <- get_tags_right `fmap` read_repo repository
hunk ./Tag.lhs 82
- write_patch opts $ adddeps mypatch deps
- add_to_inventory "." [myinfo]
+ tentativelyAddPatch repository opts $ adddeps mypatch deps
+ finalizeRepositoryChanges repository
}
[refactor Unrecord, adding tentativelyRemovePatches.
David Roundy <[EMAIL PROTECTED]>**20060716015150] {
hunk ./DarcsRepo.lhs 55
- add_to_inventory, add_to_tentative_inventory,
+ add_to_inventory,
+ add_to_tentative_inventory, remove_from_tentative_inventory,
hunk ./DarcsRepo.lhs 112
-import Depends ( slightly_optimize_patchset,
+import Depends ( slightly_optimize_patchset, deep_optimize_patchset, commute_to_end,
hunk ./DarcsRepo.lhs 385
+remove_from_tentative_inventory :: [DarcsFlag] -> [Patch] -> IO ()
+remove_from_tentative_inventory opts to_remove =
+ do finalize_tentative_changes
+ allpatches <- read_repo "."
+ let (_, skipped) = commute_to_end to_remove allpatches
+ sequence_ $ map (write_patch opts) skipped
+ repo_patches <- read_repo "."
+ write_inventory "." $ foldl (flip rempatch) repo_patches (reverse to_remove)
+ pris <- identifyPristine
+ repairable $ applyPristine pris (invert $ join_patches to_remove)
+ revert_tentative_changes
+ where rempatch :: Patch -> PatchSet -> PatchSet
+ rempatch p (pps:ppss) =
+ case patch2patchinfo p of
+ Just pinfo -> if pinfo `elem` simple_infos
+ then (filter ((/= pinfo).fst) pps) : ppss
+ else deep_optimize_patchset $
+ map (filter ((/= pinfo).fst)) (pps:ppss)
+ where simple_infos = init $ map fst pps
+ Nothing -> impossible
+ rempatch _ [] = impossible
+
hunk ./DarcsRepo.lhs 418
- repairable x = x `clarify_errors` unlines
- ["Your repository is now in an inconsistent state.",
- "This must be fixed by running darcs repair."]
+
+repairable :: IO a -> IO a
+repairable x = x `clarify_errors` unlines
+ ["Your repository is now in an inconsistent state.",
+ "This must be fixed by running darcs repair."]
hunk ./Repository.lhs 28
- tentativelyAddPatch, unrevertUrl,
+ tentativelyAddPatch, tentativelyRemovePatches, unrevertUrl,
hunk ./Repository.lhs 252
+tentativelyRemovePatches :: Repository -> [DarcsFlag] -> [Patch] -> IO ()
+tentativelyRemovePatches (Repo dir _ (DarcsRepository _)) opts ps =
+ withCurrentDirectory dir $ DarcsRepo.remove_from_tentative_inventory opts ps
+tentativelyRemovePatches (Repo _ _ GitRepository) _ _ = error "unimplemented git"
+
hunk ./Unrecord.lhs 34
- get_unrecorded,
+ tentativelyRemovePatches, finalizeRepositoryChanges,
+ get_unrecorded, read_repo, amInRepository,
hunk ./Unrecord.lhs 38
-import DarcsRepo ( read_repo,
- write_inventory, write_patch,
- am_in_repo,
- )
-import Pristine ( identifyPristine, applyPristine )
hunk ./Unrecord.lhs 42
-import Depends ( deep_optimize_patchset, commute_to_end, get_common_and_uncommon )
+import Depends ( deep_optimize_patchset, get_common_and_uncommon )
hunk ./Unrecord.lhs 132
- command_prereq = am_in_repo,
+ command_prereq = amInRepository,
hunk ./Unrecord.lhs 148
- allpatches <- read_repo "."
+ allpatches <- read_repo repository
hunk ./Unrecord.lhs 162
- let (_, skipped) = commute_to_end to_unrecord allpatches
- sequence_ $ map (write_patch opts) skipped
- repo_patches <- read_repo "."
- when (Verbose `elem` opts) $
- logMessage "About to write inventory..."
- write_inventory "." $ foldl (flip rempatch) repo_patches (reverse to_unrecord)
- when (Verbose `elem` opts) $ logMessage "Updating pristine tree..."
- pris <- identifyPristine
- applyPristine pris (invert $ join_patches to_unrecord) `catch` \e ->
- fail ("Unable to apply inverse patch!\n" ++ show e)
+ tentativelyRemovePatches repository opts to_unrecord
hunk ./Unrecord.lhs 259
- command_prereq = am_in_repo,
+ command_prereq = amInRepository,
hunk ./Unrecord.lhs 331
- command_prereq = am_in_repo,
+ command_prereq = amInRepository,
hunk ./Unrecord.lhs 352
- allpatches <- read_repo "."
+ allpatches <- read_repo repository
hunk ./Unrecord.lhs 367
- let (_, skipped) = commute_to_end ps allpatches
- sequence_ $ map (write_patch opts) skipped
- repo_patches <- read_repo "."
- write_inventory "." $ foldl (flip rempatch) repo_patches (reverse ps)
- pris <- identifyPristine
- applyPristine pris (invert $ join_patches ps) `catch` \e ->
- fail ("Unable to apply inverse patch!\n" ++ show e)
+ tentativelyRemovePatches repository opts ps
+ finalizeRepositoryChanges repository
}
[add TODO to refactor unrevert handling.
David Roundy <[EMAIL PROTECTED]>**20060716020247] {
hunk ./Unrevert.lhs 19
+-- TODO: Move remove_from_unrevert_context and write_unrevert into
+-- Repository, with the former being private to Repository.
}
[refactor amend-record.
David Roundy <[EMAIL PROTECTED]>**20060716021003] {
hunk ./AmendRecord.lhs 24
-import Repository ( PatchSet,
- withRepoLock, get_unrecorded, slurp_recorded,
- with_new_pending, sync_repo,
+import Repository ( withRepoLock, get_unrecorded, slurp_recorded,
+ tentativelyRemovePatches, tentativelyAddPatch, finalizeRepositoryChanges,
+ with_new_pending, sync_repo, amInRepository,
hunk ./AmendRecord.lhs 28
-import DarcsRepo ( read_repo,
- add_to_inventory, write_patch,
- am_in_repo, write_inventory,
- )
-import Pristine ( identifyPristine, applyPristine )
-import Depends ( deep_optimize_patchset )
hunk ./AmendRecord.lhs 86
- command_prereq = am_in_repo,
+ command_prereq = amInRepository,
hunk ./AmendRecord.lhs 105
- with_selected_patch_from_repo "amend" opts True $ \ (oldp, skipped) -> do
+ with_selected_patch_from_repo "amend" opts True $ \ (oldp, _) -> do
hunk ./AmendRecord.lhs 124
- write_patch opts $ newp
hunk ./AmendRecord.lhs 127
- pris <- identifyPristine
- applyPristine pris (join_patches chs) `catch`
- \e -> fail ("Bizarre error in amend-recording:\n" ++ show e)
- sequence_ $ map (write_patch opts) skipped
- patches' <- read_repo "."
- write_inventory "." $ rempatch oldp patches'
- add_to_inventory "."
- [(fromJust $ patch2patchinfo newp)]
+ tentativelyRemovePatches repository opts [oldp]
+ tentativelyAddPatch repository opts newp
+ finalizeRepositoryChanges repository
hunk ./AmendRecord.lhs 158
-
-rempatch :: Patch -> PatchSet -> PatchSet
-rempatch p (pps:ppss) =
- case patch2patchinfo p of
- Nothing -> impossible
- Just pinfo -> if pinfo `elem` simple_infos
- then (filter ((/= pinfo).fst) pps) : ppss
- else deep_optimize_patchset $
- map (filter ((/= pinfo).fst)) (pps:ppss)
- where simple_infos = init $ map fst pps
-rempatch _ [] = impossible
}
[partial refactoring of Get.
David Roundy <[EMAIL PROTECTED]>**20060716031605] {
hunk ./Get.lhs 37
- copy_repo_patches, sync_repo,
+ copy_repo_patches,
hunk ./Get.lhs 40
- slurp_all_but_darcs, write_patch, read_repo
+ slurp_all_but_darcs,
hunk ./Get.lhs 45
-import Depends ( get_common_and_uncommon, get_patches_beyond_tag, commute_to_end )
+import Depends ( get_common_and_uncommon, get_patches_beyond_tag )
hunk ./Get.lhs 49
- createPristineFromWorking, flagsToPristine, applyPristine )
+ createPristineFromWorking, flagsToPristine, )
hunk ./Get.lhs 55
-import Unrecord ( rempatch )
-import Repository ( patchSetToPatches )
+import Repository ( Repository, patchSetToPatches, identifyRepository,
+ sync_repo,
+ tentativelyRemovePatches, finalizeRepositoryChanges,
+ )
hunk ./Get.lhs 187
- sync_repo pristine
+ identifyRepository "." >>= sync_repo
hunk ./Get.lhs 189
- go_to_chosen_version putVerbose putInfo opts
+ repository <- identifyRepository "."
+ go_to_chosen_version repository putVerbose putInfo opts
hunk ./Get.lhs 257
-go_to_chosen_version :: (Doc -> IO ()) -> (Doc -> IO ())
+go_to_chosen_version :: Repository -> (Doc -> IO ()) -> (Doc -> IO ())
hunk ./Get.lhs 259
-go_to_chosen_version putVerbose putInfo opts =
+go_to_chosen_version repository putVerbose putInfo opts =
hunk ./Get.lhs 270
- putInfo $ text $ "Unapplying " ++ (show $ length ps) ++ " " ++ (patch_or_patches $ length ps)
- let (_, skipped) = commute_to_end ps patches
- sequence_ $ map (write_patch opts) skipped
- repo_patches <- read_repo "."
- write_inventory "." $ foldl (flip rempatch) repo_patches (reverse ps)
- pris <- identifyPristine
- applyPristine pris (invert $ join_patches ps) `catch` \e ->
- fail ("Unable to apply inverse patch!\n" ++ show e)
+ putInfo $ text $ "Unapplying " ++ (show $ length ps) ++ " " ++
+ (patch_or_patches $ length ps)
+ tentativelyRemovePatches repository opts ps
+ finalizeRepositoryChanges repository
hunk ./Get.lhs 276
- sync_repo pris
+ sync_repo repository
}
[partially refactor Optimize.
David Roundy <[EMAIL PROTECTED]>**20060716032934] {
hunk ./Optimize.lhs 21
-import Control.Exception ( block )
hunk ./Optimize.lhs 24
+import SignalHandler ( withSignalsBlocked )
hunk ./Optimize.lhs 37
-import Repository ( PatchSet, withRepoLock )
+import Repository ( Repository, PatchSet, withRepoLock,
+ tentativelyRemovePatches, tentativelyAddPatch,
+ finalizeRepositoryChanges
+ )
hunk ./Optimize.lhs 42
- am_in_repo, write_patch,
+ am_in_repo,
hunk ./Optimize.lhs 97
-optimize_cmd opts _ = withRepoLock $ \_ -> do
- do_reorder opts
+optimize_cmd opts _ = withRepoLock $ \repository -> do
+ do_reorder repository opts
hunk ./Optimize.lhs 317
-do_reorder :: [DarcsFlag] -> IO ()
-do_reorder opts | not (Reorder `elem` opts) = return ()
-do_reorder opts = do
+do_reorder :: Repository -> [DarcsFlag] -> IO ()
+do_reorder _ opts | not (Reorder `elem` opts) = return ()
+do_reorder repository opts = do
hunk ./Optimize.lhs 322
- block $ do write_patchset opts psnew
- write_inventory "." psnew
+ withSignalsBlocked $ do let ps = reverse $ map (fromJust . snd) $ head psnew
+ tentativelyRemovePatches repository opts ps
+ mapM_ (tentativelyAddPatch repository opts) ps
+ finalizeRepositoryChanges repository
hunk ./Optimize.lhs 339
-
-write_patchset :: [DarcsFlag] -> PatchSet -> IO ()
-write_patchset opts ps = let wp Nothing = return ()
- wp (Just p) = do write_patch opts p
- return ()
- in mapM_ (wp . snd) $ concat ps
}
[I've now eliminated need to export DarcsRepo.write_patch.
David Roundy <[EMAIL PROTECTED]>**20060716033109] {
hunk ./DarcsRepo.lhs 63
- write_patch,
}
[don't use DarcsRepo in list_authors.
David Roundy <[EMAIL PROTECTED]>**20060716033450] {
hunk ./list_authors.hs 20
-import DarcsRepo ( read_repo )
+import Repository ( identifyRepository, read_repo )
hunk ./list_authors.hs 40
-main = do darcs_history <- read_repo "."
+main = do darcs_history <- identifyRepository "." >>= read_repo
}
[partial refactoring in annotate.
David Roundy <[EMAIL PROTECTED]>**20060716034319] {
hunk ./Annotate.lhs 34
-import Repository ( PatchSet )
-import DarcsRepo ( am_in_repo, read_repo, get_markedup_file )
+import Repository ( PatchSet, amInRepository, identifyRepository, read_repo )
+import DarcsRepo ( get_markedup_file )
hunk ./Annotate.lhs 83
- command_prereq = am_in_repo,
+ command_prereq = amInRepository,
hunk ./Annotate.lhs 115
- p <- match_patch opts `liftM` read_repo "."
+ p <- match_patch opts `liftM` (identifyRepository "." >>= read_repo)
hunk ./Annotate.lhs 151
- r <- read_repo "."
+ r <- identifyRepository "." >>= read_repo
hunk ./Annotate.lhs 301
- old_pis <- (dropWhile (/= pinfo).map fst.concat) `liftM` read_repo "."
+ old_pis <- (dropWhile (/= pinfo).map fst.concat) `liftM`
+ (identifyRepository "." >>= read_repo)
}
[add TODO for refactoring get_markedup_file.
David Roundy <[EMAIL PROTECTED]>**20060716034339] {
hunk ./DarcsRepo.lhs 629
+
+--TODO: Move get_markedup_file and friends over into Repository, since they
+--really don't have anything to do with the repo format.
+
}
[refactor Population.
David Roundy <[EMAIL PROTECTED]>**20060716034837] {
hunk ./Population.lhs 32
-import Monad ( liftM )
hunk ./Population.lhs 39
-import DarcsRepo ( read_repo )
+import Repository ( identifyRepository, read_repo )
hunk ./Population.lhs 223
- = do pinfo <- liftM (fst . head . concat) (read_repo repobasedir)
+ = do pinfo <- (fst . head . concat) `liftM`
+ (identifyRepository repobasedir >>= read_repo)
hunk ./Population.lhs 234
- = do pips <- concat `liftM` read_repo repobasedir
+ = do pips <- concat `liftM` (identifyRepository repobasedir >>= read_repo)
replace ./Population.lhs [A-Za-z_0-9] liftM fmap
}
[fix bug in refactoring of get.
David Roundy <[EMAIL PROTECTED]>**20060726121655] {
hunk ./Get.lhs 55
-import Repository ( Repository, patchSetToPatches, identifyRepository,
+import Repository ( Repository, patchSetToPatches, withRepoLock,
hunk ./Get.lhs 185
- putVerbose $ text "Syncing the repository..."
hunk ./Get.lhs 186
- identifyRepository "." >>= sync_repo
- putVerbose $ text "Repository synced, going to chosen version..."
- repository <- identifyRepository "."
- go_to_chosen_version repository putVerbose putInfo opts
+ withRepoLock $ \repository -> do putVerbose $ text "Syncing the repository..."
+ sync_repo repository
+ putVerbose $ text "Repository synced, going to chosen version..."
+ go_to_chosen_version repository putVerbose putInfo opts
}
[simplify code a tad in get.
David Roundy <[EMAIL PROTECTED]>**20060726121737] {
hunk ./Get.lhs 278
-patch_or_patches number
- | number == 1 = "patch."
- | otherwise = "patches."
-
+patch_or_patches 1 = "patch."
+patch_or_patches _ = "patches."
}
[make amend-record.pl test a bit pickier.
David Roundy <[EMAIL PROTECTED]>**20060730103854] {
hunk ./tests/amend-record.pl 18
+`echo ALL ignore-times >> _darcs/prefs/defaults`;
hunk ./tests/amend-record.pl 31
+{
+ my $changes = darcs("changes -v");
+ like( $changes, qr/another line/, 'change amended properly');
+}
+
}
[fix ordering of operations to call pull_first_middles properly.
David Roundy <[EMAIL PROTECTED]>**20060730111409] {
hunk ./AmendRecord.lhs 125
+ tentativelyRemovePatches repository opts [oldp]
+ tentativelyAddPatch repository opts newp
hunk ./AmendRecord.lhs 128
- with_new_pending repository (join_patches unrec) $ do
- tentativelyRemovePatches repository opts [oldp]
- tentativelyAddPatch repository opts newp
- finalizeRepositoryChanges repository
+ with_new_pending repository (join_patches unrec) $
+ finalizeRepositoryChanges repository
}
[add new test that triggers bug in refactoring.
David Roundy <[EMAIL PROTECTED]>**20060730205452] {
addfile ./tests/pull_conflict.sh
hunk ./tests/pull_conflict.sh 1
+#!/bin/sh
+
+set -ev
+
+rm -rf temp1 temp2
+
+mkdir temp1
+cd temp1
+echo foo > bar
+darcs initialize
+darcs add bar
+darcs record -a -m addbar
+
+cd ..
+darcs get temp1 temp2
+cd temp1
+date > bar
+darcs record -a -m datebar
+
+cd ../temp1
+echo aack >> bar
+darcs record -a -m aackbar
+
+cd ../temp2
+
+darcs pull -av
+darcs check
}
[fix bug in pristine handling when dealing with multiple patches.
David Roundy <[EMAIL PROTECTED]>**20060731111404] {
hunk ./DarcsRepo.lhs 107
-import Lock ( writeBinFile, writeDocBinFile, appendDocBinFile )
+import Lock ( writeBinFile, writeDocBinFile, appendDocBinFile, appendBinFile )
hunk ./DarcsRepo.lhs 381
+ appendBinFile ("_darcs/tentative_pristine") "\n"
}
Context:
[TAG 1.0.8
Tommy Pettersson <[EMAIL PROTECTED]>**20060616160213]
Patch bundle hash:
a9c9408f200cf314cf095096b1e8f412fa3dbe4e
_______________________________________________
darcs-devel mailing list
[email protected]
http://www.abridgegame.org/cgi-bin/mailman/listinfo/darcs-devel
