(The following mail was delayed by a problem with the mail
configuration on my laptop...)
Hi all,
This is some refactoring preparatory to implementing hashed inventories,
preparatory to implementing the new conflicts stuff. Right now I'm just
trying to move the repo-changing logic into calls to Repository functions
(which are format-agnostic), and in the process make calls like optimize
--reorder and unpull more atomic. They can't be atomic with the current
format, but we can at least set up an infrastructure where atomic updates
are natural.
I did this stuff while travelling yesterday, and now I'm at my sister's
where there's a new baby and lots of work to be done, so I'll be pretty out
of touch for a while. I'll try to read the lists when I can, but won't
promise anything.
There are a couple of FIXMEs below for things that were not quite necesary
but would be nice to improve. If anyone wants to join in on this
refactoring, I'll have more time for reviewing refactoring code than for
writing it myself, at least until Wednesday. And review of my could would
also be very much appreciated. I'd like to be able to handle pristine
better than I do, but suspect that just adding a
appendPatch :: Handle -> Patch -> IO ()
would be enough to make the pristine handling adequately efficient.
Basically the idea is to introduce some "tentative" functions to write
modifications to disk without activating them until
"finalizeRepositoryChanges" is called. But with the current format we
can't tentatively remove out-of-order functions... but that's not a
decrease in atomicity.
More thoughts on semantics are welcome, but I think we're close enough (and
I realize we've got enough rewriting and refactoring to do that I'll be
focussing primarily on reworking the infrastructure and rewriting the
repository primitives with which the high level commands are written.
Baby is waking up...
David
Sat Jul 15 21:12:45 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* refactor Repository to allow truly atomic updates.
Sat Jul 15 21:18:53 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* refactor tag.
Sat Jul 15 21:51:50 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* refactor Unrecord, adding tentativelyRemovePatches.
Sat Jul 15 22:02:47 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* add TODO to refactor unrevert handling.
Sat Jul 15 22:10:03 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* refactor amend-record.
Sat Jul 15 23:16:05 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* partial refactoring of Get.
Sat Jul 15 23:29:34 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* partially refactor Optimize.
Sat Jul 15 23:31:09 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* I've now eliminated need to export DarcsRepo.write_patch.
Sat Jul 15 23:34:50 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* don't use DarcsRepo in list_authors.
Sat Jul 15 23:43:19 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* partial refactoring in annotate.
Sat Jul 15 23:43:39 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* add TODO for refactoring get_markedup_file.
Sat Jul 15 23:48:37 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* refactor Population.
--
David Roundy
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
}
Context:
[Merge makefile targets test_perl and test_shell into test_scripts.
Juliusz Chroboczek <[EMAIL PROTECTED]>**20060607223134
This should keep parallel make from breaking.
]
[Add warning to Eric's SSHControlMaster rework.
Juliusz Chroboczek <[EMAIL PROTECTED]>**20060528194136]
[Only launch SSH control master on demand (fixes issue171)
Eric Kow <[EMAIL PROTECTED]>**20060528093000
A secondary benefit is that this encapsulates the use of the control
master functionality and consequently simplifies calling ssh. There is
no need to deal with the details of launching or exiting the control
master.
]
[bump version to 1.0.8pre1
Tommy Pettersson <[EMAIL PROTECTED]>**20060522122655]
[Fail with a sensible message when there is no default repository to pull from.
[EMAIL PROTECTED]
[TAG 1.0.7
Tommy Pettersson <[EMAIL PROTECTED]>**20060513171438]
Patch bundle hash:
d01aeff9e45923b36746dba6278ce4f1e32e5ebf
_______________________________________________
darcs-devel mailing list
[email protected]
http://www.abridgegame.org/cgi-bin/mailman/listinfo/darcs-devel
