Foolish David has repeatedly been sending bad patches... this time I've
*really* been careful, and this patch should apply cleanly against
darcs-unstable. Thanks!
David
Sat Jul 15 22:10:03 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* refactor amend-record.
Sun Jul 30 07:14:09 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* fix ordering of operations to call pull_first_middles properly.
Sun Jul 30 06:38:54 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* make amend-record.pl test a bit pickier.
Wed Jul 26 08:17:37 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* simplify code a tad in get.
Sat Jul 15 23:16:05 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* partial refactoring of Get.
Wed Jul 26 08:16:55 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* fix bug in refactoring of get.
Sat Jul 15 23:48:37 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* refactor Population.
Sat Jul 15 22:02:47 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* add TODO to refactor unrevert handling.
Sat Jul 15 23:43:39 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* add TODO for refactoring get_markedup_file.
Sat Jul 15 23:43:19 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* partial refactoring in annotate.
Sat Jul 15 23:31:09 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* I've now eliminated need to export DarcsRepo.write_patch.
Thu Aug 3 09:30:26 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* refactor tag.
Thu Aug 3 09:32:30 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* partially refactor Optimize.
Thu Aug 3 09:33:20 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* don't use DarcsRepo in list_authors.
Thu Aug 3 10:03:42 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* refactor Repository to allow truly atomic updates.
Thu Aug 3 10:17:48 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* make get work with umask changes.
New patches:
[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 106
- with_selected_patch_from_repo "amend" opts True $ \ (oldp, skipped) -> do
+ with_selected_patch_from_repo "amend" opts True $ \ (oldp, _) -> do
hunk ./AmendRecord.lhs 125
- write_patch opts $ newp
hunk ./AmendRecord.lhs 128
- 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 159
-
-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
}
[fix ordering of operations to call pull_first_middles properly.
David Roundy <[EMAIL PROTECTED]>**20060730111409] {
hunk ./AmendRecord.lhs 126
+ tentativelyRemovePatches repository opts [oldp]
+ tentativelyAddPatch repository opts newp
hunk ./AmendRecord.lhs 129
- 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
}
[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');
+}
+
}
[simplify code a tad in get.
David Roundy <[EMAIL PROTECTED]>**20060726121737] {
hunk ./Get.lhs 280
-patch_or_patches number
- | number == 1 = "patch."
- | otherwise = "patches."
-
+patch_or_patches 1 = "patch."
+patch_or_patches _ = "patches."
}
[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
}
[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
}
[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
}
[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.
}
[add TODO for refactoring get_markedup_file.
David Roundy <[EMAIL PROTECTED]>**20060716034339] {
hunk ./DarcsRepo.lhs 572
+
+--TODO: Move get_markedup_file and friends over into Repository, since they
+--really don't have anything to do with the repo format.
+
}
[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)
}
[I've now eliminated need to export DarcsRepo.write_patch.
David Roundy <[EMAIL PROTECTED]>**20060716033109] {
hunk ./DarcsRepo.lhs 58
- write_patch,
}
[refactor tag.
David Roundy <[EMAIL PROTECTED]>**20060803133026] {
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 73
-tag_cmd opts args = withRepoLock opts $ \_ -> do
+tag_cmd opts args = withRepoLock opts $ \repository -> do
hunk ./Tag.lhs 76
- deps <- liftM get_tags_right $ read_repo "."
+ deps <- get_tags_right `fmap` read_repo repository
hunk ./Tag.lhs 83
- write_patch opts $ adddeps mypatch deps
- add_to_inventory "." [myinfo]
+ tentativelyAddPatch repository opts $ adddeps mypatch deps
+ finalizeRepositoryChanges repository
}
[partially refactor Optimize.
David Roundy <[EMAIL PROTECTED]>**20060803133230] {
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 98
-optimize_cmd opts _ = withRepoLock opts $ \_ -> do
- do_reorder opts
+optimize_cmd opts _ = withRepoLock opts $ \repository -> do
+ do_reorder repository opts
hunk ./Optimize.lhs 318
-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 323
- 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 340
-
-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
}
[don't use DarcsRepo in list_authors.
David Roundy <[EMAIL PROTECTED]>**20060803133320] {
hunk ./list_authors.hs 20
-import DarcsRepo ( read_repo )
+import Repository ( identifyRepository, read_repo )
hunk ./list_authors.hs 42
-main = do darcs_history <- read_repo "."
+main = do darcs_history <- identifyRepository "." >>= read_repo
}
[refactor Repository to allow truly atomic updates.
David Roundy <[EMAIL PROTECTED]>**20060803140342] {
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 180
- tokens <- save_patches repository opts $ unjoin_patches us_patch
+ mapM_ (tentativelyAddPatch repository opts) $ fromJust $ unjoin_patches us_patch
hunk ./Apply.lhs 184
- 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 186
- updateInventory repository tokens
hunk ./DarcsRepo.lhs 54
- write_inventory, add_to_inventory, read_repo,
+ write_inventory,
+ add_to_inventory,
+ add_to_tentative_inventory, remove_from_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 107
-import Lock ( writeBinFile, writeDocBinFile, appendDocBinFile )
+import Lock ( writeBinFile, writeDocBinFile, appendDocBinFile, appendBinFile )
hunk ./DarcsRepo.lhs 111
-import Depends ( slightly_optimize_patchset,
+import Depends ( slightly_optimize_patchset, deep_optimize_patchset, commute_to_end,
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!
+ appendBinFile ("_darcs/tentative_pristine") "\n"
+ write_patch opts p
+ where pinf = fromJust $ patch2patchinfo p
+
+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
+
+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 :: 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."]
+
+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 171
- patchTokens <- save_patches repository opts $ unjoin_patches pc
+ mapM_ (tentativelyAddPatch repository opts) $ fromJust $ unjoin_patches pc
hunk ./Pull.lhs 175
- 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 184
- 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 264
-\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 183
- myinfo = patchinfo date name my_author my_log
hunk ./Record.lhs 187
- (mypatch', token) <-
- writePatch repository opts $ adddeps mypatch deps
+ mypatch' <- tentativelyAddPatch repository opts $ adddeps mypatch deps
hunk ./Record.lhs 189
- 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 198
- 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, tentativelyRemovePatches, unrevertUrl,
+ finalizeRepositoryChanges,
hunk ./Repository.lhs 46
- WorkDir, UMask) )
-import PatchInfo ( PatchInfo )
+ WorkDir, UMask) )
hunk ./Repository.lhs 51
-import Workaround ( getCurrentDirectory )
-import DarcsUtils ( catchall, withCurrentDirectory, withUMask )
+import DarcsUtils ( catchall, withCurrentDirectory, withUMask )
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
+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"
+
+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 263
-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 272
-getUMask :: [DarcsFlag] -> Maybe String
-getUMask [] = Nothing
-getUMask ((UMask u):_) = Just u
-getUMask (_:l) = getUMask l
-
-withRepoLock :: [DarcsFlag] -> (Repository -> IO a) -> IO a
-withRepoLock opts job = do repository <- identifyRepository "."
- let (Repo _ rf rt) = repository
- case write_problem rf of
- Nothing -> return ()
- Just err -> fail err
- let name = case rt of
- DarcsRepository _ -> "./_darcs/lock"
- GitRepository -> "./.git/lock"
- wu = case (getUMask opts) of
- Nothing -> id
- Just u -> withUMask u
- wu (withLock name (job repository))
+getUMask :: [DarcsFlag] -> Maybe String
+getUMask [] = Nothing
+getUMask ((UMask u):_) = Just u
+getUMask (_:l) = getUMask l
+
+withRepoLock :: [DarcsFlag] -> (Repository -> IO a) -> IO a
+withRepoLock opts job = do repository <- identifyRepository "."
+ let (Repo _ rf rt) = repository
+ case write_problem rf of
+ Nothing -> return ()
+ Just err -> fail err
+ let name = case rt of
+ DarcsRepository _ -> "./_darcs/lock"
+ GitRepository -> "./.git/lock"
+ wu = case (getUMask opts) of
+ Nothing -> id
+ Just u -> withUMask u
+ wu (withLock name (revertRepositoryChanges repository >> job repository))
hunk ./Rollback.lhs 28
- applyToPristine, writePatch, updateInventory,
+ tentativelyAddPatch, finalizeRepositoryChanges,
hunk ./Rollback.lhs 89
- Just pinfo ->
- do (_, t) <- writePatch repository opts $ invert p
+ Just _ ->
+ do tentativelyAddPatch repository opts $ invert p
hunk ./Rollback.lhs 93
- do applyToPristine repository (invert p) `catch` \e ->
- fail ("Unable to apply inverse patch!\n" ++ show e)
- updateInventory repository [(pinfo, t)]
+ finalizeRepositoryChanges repository
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 149
- allpatches <- read_repo "."
+ allpatches <- read_repo repository
hunk ./Unrecord.lhs 163
- 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 260
- command_prereq = am_in_repo,
+ command_prereq = amInRepository,
hunk ./Unrecord.lhs 333
- command_prereq = am_in_repo,
+ command_prereq = amInRepository,
hunk ./Unrecord.lhs 355
- allpatches <- read_repo "."
+ allpatches <- read_repo repository
hunk ./Unrecord.lhs 370
- 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
}
[make get work with umask changes.
David Roundy <[EMAIL PROTECTED]>**20060803141748] {
hunk ./Get.lhs 186
- 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
+ withRepoLock opts $ \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
}
Context:
[Minor tweaks to list_authors.
Juliusz Chroboczek <[EMAIL PROTECTED]>**20060720180602]
[add some changelog entries
Tommy Pettersson <[EMAIL PROTECTED]>**20060718152611]
[add some changelog entries
Tommy Pettersson <[EMAIL PROTECTED]>**20060616150558]
[Added elc and pyc to binaries.
Juliusz Chroboczek <[EMAIL PROTECTED]>**20060713184214]
[Run ssh/scp/sftp quietly.
Eric Kow <[EMAIL PROTECTED]>**20060707025245
This is useful for silencing Putty, and could also be for OpenSSH should
we decide to stop redirecting to /dev/null.
]
[Refactor calls to ssh/scp/sftp.
Eric Kow <[EMAIL PROTECTED]>**20060706202509
]
[Added up links in web interface.
Peter Stuifzand <[EMAIL PROTECTED]>**20060610082238
Added a link to the 'projects' part of the cgi repository interface, so that
you go back to the project list.
]
[Merge makefile targets test_perl and test_shell into test_scripts.
Juliusz Chroboczek <[EMAIL PROTECTED]>**20060607223134
This should keep parallel make from breaking.
]
[bump version to 1.0.8pre1
Tommy Pettersson <[EMAIL PROTECTED]>**20060522122655]
[Add a test suite for calling external programs.
Eric Kow <[EMAIL PROTECTED]>**20060521045407
For now this only includes a test for ssh (issue171).
]
[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.
]
[Fail with a sensible message when there is no default repository to pull from.
[EMAIL PROTECTED]
[Extend test suite for patch matching.
Eric Kow <[EMAIL PROTECTED]>**20060513192501
]
[Implement help --match (issue91).
Eric Kow <[EMAIL PROTECTED]>**20060513185610
Also, refactor matching code in a way that encourages developers
to document for help --match any new matchers they create.
]
[Replace dateparser.sh with more general match.pl for testing --match.
Eric Kow <[EMAIL PROTECTED]>**20060513104942
]
[Add tests for pristine error and quiet mode when removing a directory.
Eric Kow <[EMAIL PROTECTED]>**20060513100021]
[Suppress non-empty dir warning if Quiet.
Eric Kow <[EMAIL PROTECTED]>**20060513053456]
[Replace test rmdir.sh with rmdir.pl.
Eric Kow <[EMAIL PROTECTED]>**20060513043823]
[TAG 1.0.7
Tommy Pettersson <[EMAIL PROTECTED]>**20060513171438]
[make 1.0.7 latest stable source on web page
Tommy Pettersson <[EMAIL PROTECTED]>**20060513000703]
[add some entries to the change log
Tommy Pettersson <[EMAIL PROTECTED]>**20060512235752]
[bump version to 1.0.7
Tommy Pettersson <[EMAIL PROTECTED]>**20060512235738]
[TAG 1.0.7rc1
Tommy Pettersson <[EMAIL PROTECTED]>**20060508101408]
[bump version to 1.0.7rc1
Tommy Pettersson <[EMAIL PROTECTED]>**20060508101349]
[fix error is is_pipe test in error reporting. (fixes Issue160)
David Roundy <[EMAIL PROTECTED]>**20060501142114
The trouble was that Ian (quite naturally) assumed that my C function
stdout_is_a_pipe returned nonzero for true, whereas for some very, very
backwards reason it returned zero for true, and its result was properly
interpreted. So I caused this bug by my (unexplained) backwards
programming, but it was introduced when Ian refactored the C code. :(
]
[Add forgotten file umask.h.
Juliusz Chroboczek <[EMAIL PROTECTED]>**20060423174844]
[Add --umask to all commands that write to the current repository.
Juliusz Chroboczek <[EMAIL PROTECTED]>**20060407195655]
[Add option --umask.
Juliusz Chroboczek <[EMAIL PROTECTED]>**20060407194552]
[Actually switch umasks in withRepoLock.
Juliusz Chroboczek <[EMAIL PROTECTED]>**20060407194202]
[Implement withUMask.
Juliusz Chroboczek <[EMAIL PROTECTED]>**20060407193312]
[Add umask.c.
Juliusz Chroboczek <[EMAIL PROTECTED]>**20060407193255]
[Propagate opts to withRepoLock.
Juliusz Chroboczek <[EMAIL PROTECTED]>**20060325190622]
[Test pull.pl, CREATE_DIR_ERROR: removed TODO now that directory name is printed in error message
Marnix Klooster <[EMAIL PROTECTED]>**20060304164033
Also removes a superfluous (and erroneous) chdir statement, which tried to
change to non-existing directory templ (last character was ell instead of one).
Also improves the description of this test.
]
[TAG 1.0.7pre1
Tommy Pettersson <[EMAIL PROTECTED]>**20060427095905]
Patch bundle hash:
bb7dfcd36227fc146f95b941c4e3d3ef5e346b2a
_______________________________________________
darcs-devel mailing list
[email protected]
http://www.abridgegame.org/cgi-bin/mailman/listinfo/darcs-devel
