[darcs-users] darcs patch: Use index-based diffing in Record. (and 32 more)
Eric Kow
kowey at darcs.net
Wed Jul 22 10:01:12 UTC 2009
Hi Petr, Hi Dmitry,
On Mon, Jul 20, 2009 at 21:44:14 +0200, Petr Rockai wrote:
> I am sending out my darcs-hs patchbomb (I haven't done so for a while, but it
> doesn't seem this would be attracting much attention anyway... some interesting
> new bits have appeared since the last time though. I'll elaberate more in
> hopefully-tomorrow's progress report).
Petr: I'll wait on the update before looking at this some more.
Dmitry: any chance you'd be available to look at this bundle of many
small patches? It seems to be mostly flipping and nuking, so I expect
it to be fairly straightforward. But don't feel like you have to take
it all on. Just some help getting started would be great.
To review:
> * Use index-based diffing in Record.
> * Flip "darcs changes" to index-based diffing.
> * Flip "darcs mark-conflicts" over to index-based diffing.
> * Use index-based diffing in Remove.
> * Flip AmendRecord to index-based diffing, too.
> * Use index-based diffing in unrevert.
> * Make revert use index-based diffing.
> * Also use index-based diffing in unrecord/obliterate.
> * Use index-based diffing in "darcs wh -l".
> * Unexport get_unrecorded* from Repository, remove unused functions from Internal.
> * Move tentativelyMergePatches and friends to a new module, Repository.Merge.
> * Move add_to_pending to Repository, use unrecordedChanges.
> * Clean up unused bits from Repository.Internal.
> * Invalidate the index in add_to_pending, as it was getting rebuilt too soon.
> * Remove unused import from Gorsvet.
> * Clean up unused imports in WhatsNew.
> * Resolve conflict.
> * Provide readPending that also provides the "pending conflicts" check natively.
> * Proper implementation for mDoesFileExist/mDoesDirectoryExist in Gorsvet.
> * Optimize darcs show contents --match (avoid slurping pristine).
> * Port the replay (check/repair) functionality to hashed-storage.
> * Remove now-unused checkPristineAgainstSlurpy.
> * Re-implement make_remove_patch in remove command, replacing Slurps with Trees.
> * Obliterate all instances of sync_repo and friends, since they are useless now.
> * Obliterate timestamp manipulation in HashedIO.
> * Avoid removing in-use files on win32.
Already applied:
> * Remove the support for writing out new checkpoints.
> * Remove the --checkpoint option from the UI.
> * Roll back the getSymbolicLinkStatus workaround, since it constitutes a fd leak.
> * Use tee in pending_has_conflicts.sh for easier debugging.
> * Slightly refactor test machinery in Setup.lhs.
> * Slightly refactor the run function in ShellHarness.
> * Add support for skipping tests (exit 200).
Thanks!
Eric
Use index-based diffing in Record.
----------------------------------
> Petr Rockai <me at mornfall.net>**20090611223612
> Ignore-this: f4862b1ff2fe8e91ed088ac4f03c38b8
> ] hunk ./src/Darcs/Commands/Record.lhs 36
> import Darcs.Lock ( readBinFile, writeBinFile, world_readable_temp, appendToFile, removeFileMayNotExist )
> import Darcs.Hopefully ( info, n2pia )
> import Darcs.Repository ( Repository, amInRepository, withRepoLock, ($-),
> - get_unrecorded_in_files,
> - get_unrecorded_in_files_unsorted, withGutsOf,
> + withGutsOf,
> sync_repo, read_repo,
> slurp_recorded,
> tentativelyAddPatch, finalizeRepositoryChanges,
> hunk ./src/Darcs/Commands/Record.lhs 70
> import Darcs.ProgressPatches( progressFL)
> import IsoDate ( getIsoDateTime, cleanLocalDate )
> import Printer ( hPutDocLn, text, wrap_text, ($$), renderString )
> -import Darcs.Gorsvet( invalidateIndex )
> +import Darcs.Gorsvet( invalidateIndex, unrecordedChanges )
> #include "impossible.h"
>
> record_description :: String
> hunk ./src/Darcs/Commands/Record.lhs 150
> when (((not $ null non_existent_files) || (not $ null non_repo_files)) && null existing_files) $
> fail "None of the files you specified exist!"
> debugMessage "About to get the unrecorded changes."
> - let existing_fns = map sp2fn existing_files
> - changes <- if All `elem` opts then get_unrecorded_in_files_unsorted repository existing_fns
> - else get_unrecorded_in_files repository existing_fns
> + changes <- unrecordedChanges opts repository files
> debugMessage "I've gotten unrecorded."
> case allow_empty_with_askdeps changes of
> Nothing -> do when (Pipe `elem` opts) $ do get_date opts
Flip "darcs changes" to index-based diffing.
--------------------------------------------
> Petr Rockai <me at mornfall.net>**20090620201922
> Ignore-this: 56b93cec4eb2ade271687d8bb969c16c
> ] hunk ./src/Darcs/Commands/Changes.lhs 48
> import Darcs.RepoPath ( toFilePath, rootDirectory )
> import Darcs.Patch.FileName ( fp2fn, fn2fp, norm_path )
> import Darcs.Repository ( Repository, PatchSet, PatchInfoAnd,
> - get_unrecorded_in_files_unsorted,
> withRepositoryDirectory, ($-), findRepository,
> read_repo )
> import Darcs.Patch.Info ( to_xml, showPatchInfo )
> hunk ./src/Darcs/Commands/Changes.lhs 69
> import Progress ( setProgressMode, debugMessage )
> import Darcs.SelectChanges ( view_changes )
> import Darcs.Sealed ( unsafeUnseal )
> +import Darcs.Gorsvet( unrecordedChanges )
> #include "impossible.h"
>
> changes_description :: String
> hunk ./src/Darcs/Commands/Changes.lhs 114
> unless (Debug `elem` opts) $ setProgressMode False
> files <- sort `fmap` fixSubPaths opts args
> unrec <- if null files then return identity
> - else get_unrecorded_in_files_unsorted repository (map (fp2fn . toFilePath) files)
> + else unrecordedChanges opts repository files
> `catch` \_ -> return identity -- this is triggered when repository is remote
> let filez = map (fn2fp . norm_path . fp2fn) $ apply_to_filepaths (invert unrec) $ map toFilePath files
> filtered_changes p = maybe_reverse $ get_changes_info opts filez p
Flip "darcs mark-conflicts" over to index-based diffing.
--------------------------------------------------------
> Petr Rockai <me at mornfall.net>**20090621133730
> Ignore-this: d92ff953fb0b6a817065a7209ee08aa3
> ] hunk ./src/Darcs/Commands/MarkConflicts.lhs 32
> import Darcs.Arguments ( DarcsFlag, ignoretimes, working_repo_dir, umask_option )
> import Darcs.Repository ( withRepoLock, ($-), amInRepository, add_to_pending,
> applyToWorking,
> - read_repo, sync_repo, get_unrecorded_unsorted,
> + read_repo, sync_repo,
> )
> import Darcs.Patch ( invert )
> import Darcs.Ordered ( FL(..) )
> hunk ./src/Darcs/Commands/MarkConflicts.lhs 39
> import Darcs.Sealed ( Sealed(Sealed) )
> import Darcs.Resolution ( patchset_conflict_resolutions )
> import Darcs.Utils ( promptYorn )
> +import Darcs.Gorsvet ( unrecordedChanges )
> #include "impossible.h"
>
> markconflicts_description :: String
> hunk ./src/Darcs/Commands/MarkConflicts.lhs 82
>
> markconflicts_cmd :: [DarcsFlag] -> [String] -> IO ()
> markconflicts_cmd opts [] = withRepoLock opts $- \repository -> do
> - pend <- get_unrecorded_unsorted repository
> + pend <- unrecordedChanges opts repository []
> r <- read_repo repository
> Sealed res <- return $ patchset_conflict_resolutions r
> case res of NilFL -> do putStrLn "No conflicts to mark."
Use index-based diffing in Remove.
----------------------------------
> Petr Rockai <me at mornfall.net>**20090621133755
> Ignore-this: 39f154578a0ed352557157718f683785
> ] hunk ./src/Darcs/Commands/Remove.lhs 36
> import Darcs.RepoPath ( SubPath, toFilePath, sp2fn )
> import Darcs.Repository ( Repository, withRepoLock, ($-), amInRepository,
> slurp_pending, slurp_recorded,
> - get_unrecorded_in_files, add_to_pending )
> + add_to_pending )
> import Darcs.Patch ( RepoPatch, Prim, apply_to_slurpy, adddir, rmdir, addfile, rmfile )
> import Darcs.Ordered ( FL(..), (+>+) )
> import Darcs.SlurpDirectory ( slurp_removedir, slurp_removefile )
> hunk ./src/Darcs/Commands/Remove.lhs 42
> import Darcs.Repository.Prefs ( filetype_function )
> import Darcs.Diff ( unsafeDiff )
> -import Darcs.Gorsvet( invalidateIndex )
> +import Darcs.Gorsvet( invalidateIndex, unrecordedChanges )
> #include "impossible.h"
>
> remove_description :: String
> hunk ./src/Darcs/Commands/Remove.lhs 79
> args <- fixSubPaths opts relargs
> when (null args) $
> putStrLn "Nothing specified, nothing removed."
> - p <- make_remove_patch repository args
> + p <- make_remove_patch opts repository args
> invalidateIndex repository
> add_to_pending repository p
>
> hunk ./src/Darcs/Commands/Remove.lhs 83
> -make_remove_patch :: RepoPatch p => Repository p -> [SubPath] -> IO (FL Prim)
> -make_remove_patch repository files =
> +make_remove_patch :: RepoPatch p => [DarcsFlag] -> Repository p
> + -> [SubPath] -> IO (FL Prim)
> +make_remove_patch opts repository files =
> do s <- slurp_pending repository
> srecorded <- slurp_recorded repository
> hunk ./src/Darcs/Commands/Remove.lhs 88
> - pend <- get_unrecorded_in_files repository (map sp2fn files)
> + pend <- unrecordedChanges opts repository files
> let sunrec = fromJust $ apply_to_slurpy pend srecorded
> wt <- filetype_function
> mrp wt s sunrec files
Flip AmendRecord to index-based diffing, too.
---------------------------------------------
> Petr Rockai <me at mornfall.net>**20090621133832
> Ignore-this: 7c64b91e9a2894433c3f8b78097949b8
> ] hunk ./src/Darcs/Commands/AmendRecord.lhs 29
> import Darcs.Flags ( DarcsFlag(Author, LogFile, PatchName,
> EditLongComment, PromptLongComment) )
> import Darcs.Lock ( world_readable_temp )
> -import Darcs.RepoPath ( toFilePath, sp2fn )
> +import Darcs.RepoPath ( toFilePath )
> import Darcs.Hopefully ( PatchInfoAnd, n2pia, hopefully, info )
> import Darcs.Repository ( withRepoLock, ($-), withGutsOf,
> hunk ./src/Darcs/Commands/AmendRecord.lhs 32
> - get_unrecorded_in_files, get_unrecorded_in_files_unsorted,
> tentativelyRemovePatches, tentativelyAddPatch, finalizeRepositoryChanges,
> sync_repo, amInRepository,
> )
> hunk ./src/Darcs/Commands/AmendRecord.lhs 60
> )
> import Darcs.Utils ( askUser )
> import Printer ( putDocLn )
> -import Darcs.Gorsvet( invalidateIndex )
> +import Darcs.Gorsvet( invalidateIndex, unrecordedChanges )
>
> amendrecord_description :: String
> amendrecord_description =
> hunk ./src/Darcs/Commands/AmendRecord.lhs 129
> when (areFileArgs files) $
> putStrLn $ "Amending changes in "++unwords (map show files)++":\n"
> with_selected_patch_from_repo "amend" repository opts $ \ (_ :> oldp) -> do
> - ch <- if All `elem` opts
> - then get_unrecorded_in_files_unsorted repository (map sp2fn files)
> - else get_unrecorded_in_files repository (map sp2fn files)
> + ch <- unrecordedChanges opts repository files
> case ch of
> NilFL | not edit_metadata -> putStrLn "No changes!"
> _ -> do
Use index-based diffing in unrevert.
------------------------------------
> Petr Rockai <me at mornfall.net>**20090621133900
> Ignore-this: 4624459642538a8c01a8eff93a865be6
> ] hunk ./src/Darcs/Commands/Unrevert.lhs 36
> import Darcs.Repository ( SealedPatchSet, Repository, withRepoLock, ($-),
> unrevertUrl, considerMergeToWorking,
> tentativelyAddToPending, finalizeRepositoryChanges,
> - sync_repo, get_unrecorded,
> + sync_repo,
> read_repo, amInRepository,
> slurp_recorded,
> applyToWorking )
> hunk ./src/Darcs/Commands/Unrevert.lhs 54
> import Darcs.SignalHandler ( withSignalsBlocked )
> import Progress ( debugMessage )
> import Darcs.Sealed ( Sealed(Sealed) )
> +import Darcs.Gorsvet( unrecordedChanges )
> #include "impossible.h"
>
> unrevert_description :: String
> hunk ./src/Darcs/Commands/Unrevert.lhs 91
> us <- read_repo repository
> Sealed them <- unrevert_patch_bundle repository
> rec <- slurp_recorded repository
> - unrec <- get_unrecorded repository
> + unrec <- unrecordedChanges opts repository []
> case get_common_and_uncommon (us, them) of
> (_, (h_us:<:NilRL) :\/: (h_them:<:NilRL)) -> do
> Sealed pw <- considerMergeToWorking repository "pull" (MarkConflicts:opts)
Make revert use index-based diffing.
------------------------------------
> Petr Rockai <me at mornfall.net>**20090621133923
> Ignore-this: 58455b357380c3c2759d49edd119a16d
> ] hunk ./src/Darcs/Commands/Revert.lhs 36
> import Darcs.Utils ( askUser )
> import Darcs.RepoPath ( toFilePath, sp2fn )
> import Darcs.Repository ( withRepoLock, ($-), withGutsOf,
> - get_unrecorded_in_files,
> - get_unrecorded_in_files_unsorted,
> add_to_pending, sync_repo,
> applyToWorking,
> amInRepository, slurp_recorded,
> hunk ./src/Darcs/Commands/Revert.lhs 46
> import Darcs.Patch.TouchesFiles ( choose_touching )
> import Darcs.Commands.Unrevert ( write_unrevert )
> import Darcs.Sealed ( unsafeUnseal )
> -import Darcs.Gorsvet( invalidateIndex )
> +import Darcs.Gorsvet( invalidateIndex, unrecordedChanges )
>
> revert_description :: String
> revert_description = "Discard unrecorded changes."
> hunk ./src/Darcs/Commands/Revert.lhs 82
> revert_cmd :: [DarcsFlag] -> [String] -> IO ()
> revert_cmd opts args = withRepoLock opts $- \repository -> do
> files <- sort `fmap` fixSubPaths opts args
> - let files_fn = map sp2fn files
> when (areFileArgs files) $
> putStrLn $ "Reverting changes in "++unwords (map show files)++"..\n"
> hunk ./src/Darcs/Commands/Revert.lhs 84
> - changes <- if All `elem` opts
> - then get_unrecorded_in_files_unsorted repository files_fn
> - else get_unrecorded_in_files repository files_fn
> + changes <- unrecordedChanges opts repository files
> let pre_changed_files = apply_to_filepaths (invert changes) (map toFilePath files)
> rec <- slurp_recorded repository
> case unsafeUnseal $ choose_touching pre_changed_files changes of
Also use index-based diffing in unrecord/obliterate.
----------------------------------------------------
> Petr Rockai <me at mornfall.net>**20090621133956
> Ignore-this: 92a5a543663f0be15bb7f6f29980fa
> ] hunk ./src/Darcs/Commands/Unrecord.lhs 42
> tentativelyRemovePatches, finalizeRepositoryChanges,
> tentativelyAddToPending,
> applyToWorking,
> - get_unrecorded, read_repo, amInRepository,
> + read_repo, amInRepository,
> sync_repo,
> )
> import Darcs.Patch ( Patchy, RepoPatch, invert, commutex, effect )
> hunk ./src/Darcs/Commands/Unrecord.lhs 53
> import Darcs.SelectChanges ( with_selected_last_changes_reversed )
> import Progress ( debugMessage )
> import Darcs.Sealed ( Sealed(..), FlippedSeal(..), mapFlipped )
> -import Darcs.Gorsvet( invalidateIndex )
> +import Darcs.Gorsvet( invalidateIndex, unrecordedChanges )
> #include "gadts.h"
>
> unrecord_description :: String
> hunk ./src/Darcs/Commands/Unrecord.lhs 289
> -> IO ()
> generic_obliterate_cmd cmdname opts _ = withRepoLock opts $- \repository -> do
> let (logMessage,_,_) = loggers opts
> - pend <- get_unrecorded repository
> + pend <- unrecordedChanges opts repository []
> allpatches <- read_repo repository
> FlippedSeal patches <- return $ if first_match opts
> then get_last_patches opts allpatches
Use index-based diffing in "darcs wh -l".
-----------------------------------------
> Petr Rockai <me at mornfall.net>**20090621134141
> Ignore-this: 2c8442430fdae83bcdff14f2af3db2a0
> ] hunk ./src/Darcs/Commands/WhatsNew.lhs 27
>
> module Darcs.Commands.WhatsNew ( whatsnew ) where
> import System.Exit ( ExitCode(..), exitWith )
> -import Data.List ( sort )
> +import Data.List ( sort, (\\) )
> import Control.Monad ( when )
>
> import Darcs.Commands ( DarcsCommand(..), nodefaults )
> hunk ./src/Darcs/Commands/WhatsNew.lhs 40
> import Darcs.RepoPath ( SubPath, sp2fn )
>
> import Darcs.Repository ( Repository, withRepository, ($-), slurp_recorded,
> - get_unrecorded_no_look_for_adds,
> - get_unrecorded_in_files, amInRepository )
> + amInRepository )
> import Darcs.Repository.Prefs ( filetype_function )
> import Darcs.Diff ( unsafeDiff )
> import Darcs.Patch ( RepoPatch, Prim, summarize, apply_to_slurpy, is_hunk )
> hunk ./src/Darcs/Commands/WhatsNew.lhs 50
> import Darcs.PrintPatch ( printPatch, contextualPrintPatch )
> import Darcs.Ordered ( FL(..), mapFL_FL, reverseRL, reverseFL, (:>)(..), nullFL )
>
> -import Darcs.Gorsvet( unrecordedChanges, restrictBoring, readRecordedAndPending )
> +import Darcs.Gorsvet( unrecordedChanges, restrictBoring, readRecordedAndPending
> + , readRecorded, treeDiff, applyToTree )
> import Storage.Hashed.Monad( virtualTreeIO, exists )
> import Storage.Hashed( readPlainTree )
> import Storage.Hashed( floatPath )
> hunk ./src/Darcs/Commands/WhatsNew.lhs 122
> withRepository (Summary:opts') $- \repository -> do
> files <- fixSubPaths opts' args
> announce_files repository files
> - all_changes <- get_unrecorded_in_files repository (map sp2fn files)
> - chold <- get_unrecorded_no_look_for_adds repository (map sp2fn files)
> - s <- slurp_recorded repository
> + all_changes <- unrecordedChanges opts' repository files
> + chold <- unrecordedChanges (opts' \\ [LookForAdds]) repository files
> + pristine <- readRecorded repository
> ftf <- filetype_function
> cho_adds :> _ <- return $ partitionRL is_hunk $ reverseFL chold
> cha :> _ <- return $ partitionRL is_hunk $ reverseFL all_changes
> hunk ./src/Darcs/Commands/WhatsNew.lhs 128
> - let chn = unsafeDiff [LookForAdds,Summary] ftf
> - (fromJust $ apply_to_slurpy (reverseRL cho_adds) s)
> - (fromJust $ apply_to_slurpy (reverseRL cha) s)
> +
> + cho_adds_t <- applyToTree (reverseRL cho_adds) pristine
> + cha_t <- applyToTree (reverseRL cha) pristine
> + chn <- treeDiff ftf cho_adds_t cha_t
> +
> exitOnNoChanges (chn, chold)
> putDocLn $ summarize chold
> printSummary chn
Unexport get_unrecorded* from Repository, remove unused functions from Internal.
--------------------------------------------------------------------------------
> Petr Rockai <me at mornfall.net>**20090621134230
> Ignore-this: 51384d4c19da07ea40cab0837effded8
> ] hunk ./src/Darcs/Repository.hs 33
> slurp_pending, replacePristineFromSlurpy,
> slurp_recorded, slurp_recorded_and_unrecorded,
> withRecorded,
> - get_unrecorded, get_unrecorded_unsorted, get_unrecorded_no_look_for_adds,
> - get_unrecorded_in_files, get_unrecorded_in_files_unsorted,
> read_repo, sync_repo,
> prefsUrl,
> add_to_pending,
> hunk ./src/Darcs/Repository.hs 63
> slurp_pending, replacePristineFromSlurpy,
> slurp_recorded, slurp_recorded_and_unrecorded,
> withRecorded,
> - get_unrecorded, get_unrecorded_unsorted, get_unrecorded_no_look_for_adds,
> - get_unrecorded_in_files, get_unrecorded_in_files_unsorted,
> read_repo, sync_repo,
> prefsUrl, checkPristineAgainstSlurpy,
> add_to_pending,
> hunk ./src/Darcs/Repository/Internal.hs 33
> check_unrecorded_conflicts,
> withRecorded,
> checkPristineAgainstSlurpy,
> - get_unrecorded, get_unrecorded_unsorted, get_unrecorded_no_look_for_adds,
> - get_unrecorded_in_files, get_unrecorded_in_files_unsorted,
> read_repo, sync_repo,
> prefsUrl, makePatchLazy,
> add_to_pending,
> hunk ./src/Darcs/Repository/Internal.hs 393
> Left _ -> sfp (p:>:sofar) ps
> sfp sofar (p:<:ps) = sfp (p:>:sofar) ps
>
> -get_unrecorded_no_look_for_adds :: RepoPatch p => Repository p C(r u t) -> [FileName] -> IO (FL Prim C(r y))
> -get_unrecorded_no_look_for_adds r paths = get_unrecorded_private (filter (/= LookForAdds)) r paths
> -
> get_unrecorded_unsorted :: RepoPatch p => Repository p C(r u t) -> IO (FL Prim C(r u))
> get_unrecorded_unsorted r = get_unrecorded_in_files_unsorted r []
>
> hunk ./src/Darcs/Repository/Internal.hs 404
> get_unrecorded_in_files_unsorted :: RepoPatch p => Repository p C(r u t) -> [FileName] -> IO (FL Prim C(r u))
> get_unrecorded_in_files_unsorted = get_unrecorded_private (AnyOrder:)
>
> --- | Gets the unrecorded changes in the given paths in the current repository.
> -get_unrecorded_in_files :: RepoPatch p => Repository p C(r u t) -> [FileName] -> IO (FL Prim C(r u))
> -get_unrecorded_in_files = get_unrecorded_private id
> -
> -- | The /unrecorded/ includes the pending and the working directory changes.
> -- The third argument is a list of paths: if this list is [], it will diff
> -- the whole repo, but if there are elements in it, the function will return
Move tentativelyMergePatches and friends to a new module, Repository.Merge.
---------------------------------------------------------------------------
> Petr Rockai <me at mornfall.net>**20090621141923
> Ignore-this: 6348929868d146f5877e5e6529754521
>
> This allows tentativelyMergePatches to use unrecordedChanges from Gorsvet
> without forming import cycles.
> ] hunk ./darcs.cabal 251
> Darcs.Repository.HashedIO
> Darcs.Repository.HashedRepo
> Darcs.Repository.Internal
> + Darcs.Repository.Merge
> Darcs.Repository.InternalTypes
> Darcs.Repository.Motd
> Darcs.Repository.Prefs
> conflictor [
> hunk ./src/Darcs/Gorsvet.hs 36
> -import Darcs.External ( backupByCopying )
> ]
> :
> hunk ./src/Darcs/Gorsvet.hs 34
> -import Darcs.Repository ( Repository, slurp_pending )
> -import Darcs.Repository.Internal ( read_pending )
> +import Darcs.Repository.Internal ( Repository, slurp_pending, read_pending )
> hunk ./src/Darcs/Gorsvet.hs 55
> import Data.Maybe
> import Data.List( union )
>
> -import Darcs.Arguments ( DarcsFlag( LookForAdds, IgnoreTimes ) )
> +import Darcs.Flags ( DarcsFlag( LookForAdds, IgnoreTimes ) )
> import Darcs.RepoPath ( SubPath, sp2fn )
>
> import Text.Regex( matchRegex )
> hunk ./src/Darcs/Repository.hs 69
> withRepoLock, withRepoReadLock, withRepository, withRepositoryDirectory, withGutsOf,
> tentativelyAddPatch, tentativelyRemovePatches, tentativelyAddToPending,
> tentativelyReplacePatches,
> - tentativelyMergePatches, considerMergeToWorking,
> revertRepositoryChanges, finalizeRepositoryChanges,
> unrevertUrl,
> applyToWorking, patchSetToPatches,
> hunk ./src/Darcs/Repository.hs 78
> setScriptsExecutable,
> testTentative, testRecorded
> )
> +import Darcs.Repository.Merge( tentativelyMergePatches, considerMergeToWorking )
> import Darcs.Repository.Cache ( unionCaches, fetchFileUsingCache, HashedDir(..) )
> import Darcs.Patch.Set ( PatchSet, SealedPatchSet )
>
> hunk ./src/Darcs/Repository.hs 299
> Right h -> fetchFileUsingCache c HashedPatchesDir h >> return ()
> sequence_ $ mapRL peekaboo $ progressRLShowTags "Copying patches" $ concatRL r
> where putInfo = when (not $ Quiet `elem` opts) . putStrLn
> +
> hunk ./src/Darcs/Repository/Internal.hs 39
> withRepoLock, withRepoReadLock,
> withRepository, withRepositoryDirectory, withGutsOf,
> tentativelyAddPatch, tentativelyRemovePatches, tentativelyAddToPending,
> + tentativelyAddPatch_,
> tentativelyReplacePatches,
> hunk ./src/Darcs/Repository/Internal.hs 41
> - tentativelyMergePatches, considerMergeToWorking,
> finalizeRepositoryChanges,
> unrevertUrl,
> applyToWorking, patchSetToPatches,
> hunk ./src/Darcs/Repository/Internal.hs 51
> PatchSet, SealedPatchSet,
> setScriptsExecutable,
> getRepository, rIO,
> - testTentative, testRecorded
> + testTentative, testRecorded,
> + UpdatePristine(..), MakeChanges(..), applyToTentativePristine
> ) where
>
> import Printer ( putDocLn, (<+>), text, ($$) )
> hunk ./src/Darcs/Repository/Internal.hs 534
> | format_has HashedInventory rf = h
> | otherwise = o
>
> -
> -tentativelyMergePatches :: RepoPatch p
> - => Repository p C(r u t) -> String -> [DarcsFlag]
> - -> FL (PatchInfoAnd p) C(x r) -> FL (PatchInfoAnd p) C(x y)
> - -> IO (Sealed (FL Prim C(u)))
> -tentativelyMergePatches = tentativelyMergePatches_ MakeChanges
> -
> -considerMergeToWorking :: RepoPatch p
> - => Repository p C(r u t) -> String -> [DarcsFlag]
> - -> FL (PatchInfoAnd p) C(x r) -> FL (PatchInfoAnd p) C(x y)
> - -> IO (Sealed (FL Prim C(u)))
> -considerMergeToWorking = tentativelyMergePatches_ DontMakeChanges
> -
> data MakeChanges = MakeChanges | DontMakeChanges deriving ( Eq )
>
> hunk ./src/Darcs/Repository/Internal.hs 536
> -tentativelyMergePatches_ :: forall p C(r u t y x). RepoPatch p
> - => MakeChanges
> - -> Repository p C(r u t) -> String -> [DarcsFlag]
> - -> FL (PatchInfoAnd p) C(x r) -> FL (PatchInfoAnd p) C(x y)
> - -> IO (Sealed (FL Prim C(u)))
> -tentativelyMergePatches_ mc r cmd opts usi themi =
> - do let us = mapFL_FL hopefully usi
> - them = mapFL_FL hopefully themi
> - _ :/\: pc <- return $ merge (progressFL "Merging them" them :\/: progressFL "Merging us" us)
> - pend <- get_unrecorded_unsorted r -- we don't care if it looks pretty...
> - anonpend <- anonymous (fromPrims pend)
> - pend' :/\: pw <- return $ merge (pc :\/: anonpend :>: NilFL)
> - let pwprim = joinPatches $ progressFL "Examining patches for conflicts" $ mapFL_FL patchcontents pw
> - Sealed standard_resolved_pw <- return $ standard_resolution pwprim
> - debugMessage "Checking for conflicts..."
> - mapM_ backupByCopying $ list_touched_files standard_resolved_pw
> - debugMessage "Announcing conflicts..."
> - have_conflicts <- announce_merge_conflicts cmd opts standard_resolved_pw
> - debugMessage "Checking for unrecorded conflicts..."
> - have_unrecorded_conflicts <- check_unrecorded_conflicts opts pc
> - debugMessage "Reading working directory..."
> - (_, working) <- slurp_recorded_and_unrecorded r
> - debugMessage "Working out conflicts in actual working directory..."
> - Sealed pw_resolution <-
> - case (want_external_merge opts, have_conflicts || have_unrecorded_conflicts) of
> - (Nothing,_) -> return $ if AllowConflicts `elem` opts
> - then seal NilFL
> - else seal standard_resolved_pw
> - (_,False) -> return $ seal standard_resolved_pw
> - (Just c, True) -> external_resolution working c
> - (effect us +>+ pend)
> - (effect them) pwprim
> - debugMessage "Applying patches to the local directories..."
> - when (mc == MakeChanges) $
> - do let doChanges :: FL (PatchInfoAnd p) C(x r) -> IO ()
> - doChanges NilFL = applyps r themi
> - doChanges _ = applyps r (mapFL_FL n2pia pc)
> - doChanges usi
> - setTentativePending r (effect pend' +>+ pw_resolution)
> - return $ seal (effect pwprim +>+ pw_resolution)
> - where mapAdd :: Repository p C(i l m) -> FL (PatchInfoAnd p) C(i j) -> [IO ()]
> - mapAdd _ NilFL = []
> - mapAdd r'@(Repo dir df rf dr) (a:>:as) =
> - -- we construct a new Repository object on the recursive case so that the
> - -- recordedstate of the repository can match the fact that we just wrote a patch
> - tentativelyAddPatch_ DontUpdatePristine r' opts a : mapAdd (Repo dir df rf dr) as
> - applyps :: Repository p C(i l m) -> FL (PatchInfoAnd p) C(i j) -> IO ()
> - applyps repo ps = do debugMessage "Adding patches to inventory..."
> - sequence_ $ mapAdd repo ps
> - debugMessage "Applying patches to pristine..."
> - applyToTentativePristine repo ps
> -
> announce_merge_conflicts :: String -> [DarcsFlag] -> FL Prim C(x y) -> IO Bool
> announce_merge_conflicts cmd opts resolved_pw =
> case nubsort $ list_touched_files $ resolved_pw of
> addfile ./src/Darcs/Repository/Merge.hs
> hunk ./src/Darcs/Repository/Merge.hs 1
> +-- Copyright (C) 2002-2004,2007-2008 David Roundy
> +-- Copyright (C) 2005 Juliusz Chroboczek
> +-- Copyright (C) 2009 Petr Rockai
> +--
> +-- This program is free software; you can redistribute it and/or modify
> +-- it under the terms of the GNU General Public License as published by
> +-- the Free Software Foundation; either version 2, or (at your option)
> +-- any later version.
> +--
> +-- This program is distributed in the hope that it will be useful,
> +-- but WITHOUT ANY WARRANTY; without even the implied warranty of
> +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> +-- GNU General Public License for more details.
> +--
> +-- You should have received a copy of the GNU General Public License
> +-- along with this program; see the file COPYING. If not, write to
> +-- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
> +-- Boston, MA 02110-1301, USA.
> +
> +#include "gadts.h"
> +
> +module Darcs.Repository.Merge where
> +
> +import Darcs.Resolution ( standard_resolution, external_resolution )
> +import Darcs.External ( backupByCopying )
> +import Control.Monad ( when )
> +
> +import Darcs.Patch ( Effect )
> +import Darcs.Hopefully ( PatchInfoAnd, n2pia, hopefully )
> +import Darcs.Flags
> + ( DarcsFlag( AllowConflicts ), want_external_merge )
> +import Darcs.Ordered
> + ( FL(..), (:\/:)(..), (:/\:)(..), (+>+), mapFL_FL )
> +import Darcs.Patch
> + ( RepoPatch, Prim, merge, joinPatches, list_touched_files
> + , patchcontents, anonymous, fromPrims, effect )
> +import Progress( debugMessage )
> +import Darcs.ProgressPatches( progressFL )
> +import Darcs.Sealed( Sealed(Sealed), seal )
> +import Darcs.Repository.InternalTypes( Repository(..) )
> +
> +import Darcs.Gorsvet( unrecordedChanges )
> +
> +import Darcs.Repository.Internal
> + ( announce_merge_conflicts, check_unrecorded_conflicts
> + , slurp_recorded_and_unrecorded, MakeChanges(..), setTentativePending
> + , tentativelyAddPatch_, applyToTentativePristine, UpdatePristine(..) )
> +
> +tentativelyMergePatches_ :: forall p C(r u t y x). RepoPatch p
> + => MakeChanges
> + -> Repository p C(r u t) -> String -> [DarcsFlag]
> + -> FL (PatchInfoAnd p) C(x r) -> FL (PatchInfoAnd p) C(x y)
> + -> IO (Sealed (FL Prim C(u)))
> +tentativelyMergePatches_ mc r cmd opts usi themi =
> + do let us = mapFL_FL hopefully usi
> + them = mapFL_FL hopefully themi
> + _ :/\: pc <- return $ merge (progressFL "Merging them" them :\/: progressFL "Merging us" us)
> + pend <- unrecordedChanges opts r []
> + anonpend <- anonymous (fromPrims pend)
> + pend' :/\: pw <- return $ merge (pc :\/: anonpend :>: NilFL)
> + let pwprim = joinPatches $ progressFL "Examining patches for conflicts" $ mapFL_FL patchcontents pw
> + Sealed standard_resolved_pw <- return $ standard_resolution pwprim
> + debugMessage "Checking for conflicts..."
> + mapM_ backupByCopying $ list_touched_files standard_resolved_pw
> + debugMessage "Announcing conflicts..."
> + have_conflicts <- announce_merge_conflicts cmd opts standard_resolved_pw
> + debugMessage "Checking for unrecorded conflicts..."
> + have_unrecorded_conflicts <- check_unrecorded_conflicts opts pc
> + debugMessage "Reading working directory..."
> + (_, working) <- slurp_recorded_and_unrecorded r
> + debugMessage "Working out conflicts in actual working directory..."
> + Sealed pw_resolution <-
> + case (want_external_merge opts, have_conflicts || have_unrecorded_conflicts) of
> + (Nothing,_) -> return $ if AllowConflicts `elem` opts
> + then seal NilFL
> + else seal standard_resolved_pw
> + (_,False) -> return $ seal standard_resolved_pw
> + (Just c, True) -> external_resolution working c
> + (effect us +>+ pend)
> + (effect them) pwprim
> + debugMessage "Applying patches to the local directories..."
> + when (mc == MakeChanges) $
> + do let doChanges :: FL (PatchInfoAnd p) C(x r) -> IO ()
> + doChanges NilFL = applyps r themi
> + doChanges _ = applyps r (mapFL_FL n2pia pc)
> + doChanges usi
> + setTentativePending r (effect pend' +>+ pw_resolution)
> + return $ seal (effect pwprim +>+ pw_resolution)
> + where mapAdd :: Repository p C(i l m) -> FL (PatchInfoAnd p) C(i j) -> [IO ()]
> + mapAdd _ NilFL = []
> + mapAdd r'@(Repo dir df rf dr) (a:>:as) =
> + -- we construct a new Repository object on the recursive case so that the
> + -- recordedstate of the repository can match the fact that we just wrote a patch
> + tentativelyAddPatch_ DontUpdatePristine r' opts a : mapAdd (Repo dir df rf dr) as
> + applyps :: Repository p C(i l m) -> FL (PatchInfoAnd p) C(i j) -> IO ()
> + applyps repo ps = do debugMessage "Adding patches to inventory..."
> + sequence_ $ mapAdd repo ps
> + debugMessage "Applying patches to pristine..."
> + applyToTentativePristine repo ps
> +
> +tentativelyMergePatches :: RepoPatch p
> + => Repository p C(r u t) -> String -> [DarcsFlag]
> + -> FL (PatchInfoAnd p) C(x r) -> FL (PatchInfoAnd p) C(x y)
> + -> IO (Sealed (FL Prim C(u)))
> +tentativelyMergePatches = tentativelyMergePatches_ MakeChanges
> +
> +
> +considerMergeToWorking :: RepoPatch p
> + => Repository p C(r u t) -> String -> [DarcsFlag]
> + -> FL (PatchInfoAnd p) C(x r) -> FL (PatchInfoAnd p) C(x y)
> + -> IO (Sealed (FL Prim C(u)))
> +considerMergeToWorking = tentativelyMergePatches_ DontMakeChanges
> +
Move add_to_pending to Repository, use unrecordedChanges.
---------------------------------------------------------
> Petr Rockai <me at mornfall.net>**20090621142531
> Ignore-this: b35e0e7848c766dfc37cf570f254c48a
> ] hunk ./src/Darcs/Repository.hs 65
> withRecorded,
> read_repo, sync_repo,
> prefsUrl, checkPristineAgainstSlurpy,
> - add_to_pending,
> withRepoLock, withRepoReadLock, withRepository, withRepositoryDirectory, withGutsOf,
> tentativelyAddPatch, tentativelyRemovePatches, tentativelyAddToPending,
> tentativelyReplacePatches,
> hunk ./src/Darcs/Repository.hs 75
> optimizeInventory, cleanRepository,
> getMarkedupFile,
> setScriptsExecutable,
> - testTentative, testRecorded
> + testTentative, testRecorded,
> + make_new_pending
> )
> import Darcs.Repository.Merge( tentativelyMergePatches, considerMergeToWorking )
> import Darcs.Repository.Cache ( unionCaches, fetchFileUsingCache, HashedDir(..) )
> hunk ./src/Darcs/Repository.hs 94
> import Darcs.Repository.Checkpoint ( identify_checkpoint, write_checkpoint_patch, get_checkpoint )
> import Darcs.Repository.ApplyPatches ( apply_patches )
> import Darcs.Repository.HashedRepo ( apply_to_tentative_pristine )
> -import Darcs.Patch ( RepoPatch, Named, Patch, patch2patchinfo, apply )
> -import Darcs.Ordered ( RL(..), bunchFL, mapFL, mapRL, mapRL_RL, concatFL, reverseRL,
> - concatRL, lengthRL, isShorterThanRL )
> +import Darcs.Patch ( RepoPatch, Named, Prim, Patch, patch2patchinfo, apply )
> +import Darcs.Ordered ( FL(..), RL(..), bunchFL, mapFL, mapRL, mapRL_RL, concatFL
> + , reverseRL ,concatRL, lengthRL, isShorterThanRL, (+>+) )
> import Darcs.Patch.Info ( PatchInfo )
> import Darcs.Repository.Format ( RepoProperty ( HashedInventory ),
> create_repo_format, format_has, writeRepoFormat )
> hunk ./src/Darcs/Repository.hs 113
> import Darcs.Sealed ( Sealed(..), FlippedSeal(..), flipSeal, mapFlipped )
>
> import Darcs.Flags ( DarcsFlag( Quiet, Partial, Lazy, Ephemeral,
> - AllowUnrelatedRepos
> - ),
> - compression )
> + AllowUnrelatedRepos, NoUpdateWorking )
> + , compression )
> import Darcs.Global ( darcsdir )
> hunk ./src/Darcs/Repository.hs 116
> +import Darcs.Gorsvet ( unrecordedChanges )
> +
> #include "impossible.h"
>
> createRepository :: [DarcsFlag] -> IO ()
> hunk ./src/Darcs/Repository.hs 301
> sequence_ $ mapRL peekaboo $ progressRLShowTags "Copying patches" $ concatRL r
> where putInfo = when (not $ Quiet `elem` opts) . putStrLn
>
> +add_to_pending :: RepoPatch p => Repository p C(r u t) -> FL Prim C(u y) -> IO ()
> +add_to_pending (Repo _ opts _ _) _ | NoUpdateWorking `elem` opts = return ()
> +add_to_pending repo@(Repo _ opts _ _) p =
> + do pend <- unrecordedChanges opts repo []
> + make_new_pending repo (pend +>+ p)
> +
> hunk ./src/Darcs/Repository/Internal.hs 35
> checkPristineAgainstSlurpy,
> read_repo, sync_repo,
> prefsUrl, makePatchLazy,
> - add_to_pending,
> withRepoLock, withRepoReadLock,
> withRepository, withRepositoryDirectory, withGutsOf,
> tentativelyAddPatch, tentativelyRemovePatches, tentativelyAddToPending,
> hunk ./src/Darcs/Repository/Internal.hs 51
> setScriptsExecutable,
> getRepository, rIO,
> testTentative, testRecorded,
> - UpdatePristine(..), MakeChanges(..), applyToTentativePristine
> + UpdatePristine(..), MakeChanges(..), applyToTentativePristine,
> + make_new_pending
> ) where
>
> import Printer ( putDocLn, (<+>), text, ($$) )
> hunk ./src/Darcs/Repository/Internal.hs 337
> read_pending (Repo r _ _ tp) =
> withCurrentDirectory r (read_pendingfile (pendingName tp))
>
> -add_to_pending :: RepoPatch p => Repository p C(r u t) -> FL Prim C(u y) -> IO ()
> -add_to_pending (Repo _ opts _ _) _ | NoUpdateWorking `elem` opts = return ()
> -add_to_pending repo p =
> - do pend <- get_unrecorded repo
> - make_new_pending repo (pend +>+ p)
> -
> readPrims :: B.ByteString -> Sealed (FL Prim C(x))
> readPrims s = case readPatch s :: Maybe (Sealed (Patch C(x )), B.ByteString) of
> Nothing -> Sealed NilFL
Clean up unused bits from Repository.Internal.
----------------------------------------------
> Petr Rockai <me at mornfall.net>**20090621143025
> Ignore-this: 5686ee1be7112b52217ab50a1c37d310
> ] hunk ./src/Darcs/Repository/Internal.hs 59
>
> import Data.Maybe ( isJust, isNothing )
> import Darcs.Repository.Prefs ( get_prefval )
> -import Darcs.Resolution ( standard_resolution, external_resolution )
> import System.Exit ( ExitCode(..), exitWith )
> import System.Cmd ( system )
> hunk ./src/Darcs/Repository/Internal.hs 61
> -import Darcs.External ( backupByCopying, clonePartialsTree )
> +import Darcs.External ( clonePartialsTree )
> import Darcs.IO ( runTolerantly, runSilently )
> import Darcs.Repository.Pristine ( identifyPristine, nopristine,
> easyCreatePristineDirectoryTree, slurpPristine, syncPristine,
> hunk ./src/Darcs/Repository/Internal.hs 85
>
> import Darcs.Patch ( Patch, RealPatch, Effect, is_hunk, is_binary, description,
>
> - try_to_shrink, commuteFL, commute, apply_to_filepaths )
> + try_to_shrink, commuteFL, commute )
> import Darcs.Patch.Prim ( try_shrinking_inverse, Conflict )
> import Darcs.Patch.Bundle ( scan_bundle, make_bundle )
> hunk ./src/Darcs/Repository/Internal.hs 88
> -import Darcs.Patch.FileName ( FileName, fn2fp )
> -import Darcs.Patch.TouchesFiles ( choose_touching )
> -import Darcs.SlurpDirectory ( Slurpy, slurp_unboring, mmap_slurp, co_slurp,
> - slurp_has, list_slurpy_files )
> +import Darcs.SlurpDirectory ( Slurpy, mmap_slurp, co_slurp, list_slurpy_files )
> import Darcs.Hopefully ( PatchInfoAnd, info, n2pia,
> hopefully, hopefullyM )
> import Darcs.Repository.ApplyPatches ( apply_patches )
> hunk ./src/Darcs/Repository/Internal.hs 103
> replacePristineFromSlurpy,
> slurp_all_but_darcs )
> import qualified Darcs.Repository.DarcsRepo as DarcsRepo
> -import Darcs.Flags ( DarcsFlag(AnyOrder, Boring, LookForAdds, Verbose, Quiet,
> +import Darcs.Flags ( DarcsFlag(LookForAdds, Verbose, Quiet,
> MarkConflicts, AllowConflicts, NoUpdateWorking,
> WorkRepoUrl, WorkRepoDir, UMask, Test, LeaveTestDir,
> hunk ./src/Darcs/Repository/Internal.hs 106
> - SetScriptsExecutable, DryRun, IgnoreTimes,
> - Summary, NoSummary),
> + SetScriptsExecutable, DryRun, IgnoreTimes),
> want_external_merge, compression )
> import Darcs.Ordered ( FL(..), RL(..), EqCheck(..), unsafeCoerceP,
> (:\/:)(..), (:/\:)(..), (:>)(..),
> hunk ./src/Darcs/Repository/Internal.hs 115
> reverseRL, reverseFL, concatRL, mapFL,
> mapFL_FL, concatFL )
> import Darcs.Patch ( RepoPatch, Patchy, Prim, merge,
> - joinPatches, sort_coalesceFL,
> + joinPatches,
> list_conflicted_files, list_touched_files,
> hunk ./src/Darcs/Repository/Internal.hs 117
> - Named, patchcontents, anonymous,
> + Named, patchcontents,
> commuteRL, fromPrims,
> patch2patchinfo, readPatch,
> writePatch, effect, invert,
> hunk ./src/Darcs/Repository/Internal.hs 132
> import Darcs.Patch.Set ( PatchSet, SealedPatchSet )
> import Darcs.Patch.Apply ( markup_file, LineMark(None) )
> import Darcs.Patch.Depends ( get_common_and_uncommon, deep_optimize_patchset )
> -import Darcs.Diff ( unsafeDiffAtPaths, unsafeDiff )
> +import Darcs.Diff ( unsafeDiff )
> import Darcs.RepoPath ( FilePathLike, AbsolutePath, toFilePath,
> ioAbsoluteOrRemote, toPath )
> import Darcs.Utils ( promptYorn, catchall, withCurrentDirectory, withUMask, nubsort )
> hunk ./src/Darcs/Repository/Internal.hs 139
> import Progress ( debugMessage )
> import Darcs.ProgressPatches (progressFL)
> import Darcs.URL ( is_file )
> -import Darcs.Repository.Prefs ( darcsdir_filter, boring_file_filter, filetype_function,
> - getCaches )
> +import Darcs.Repository.Prefs ( filetype_function, getCaches )
> import Darcs.Lock ( withLock, writeDocBinFile, withDelayedDir, removeFileMayNotExist,
> withTempDir, withPermDir )
> import Darcs.Sealed ( Sealed(Sealed), seal, FlippedSeal(FlippedSeal), flipSeal )
> hunk ./src/Darcs/Repository/Internal.hs 382
> Left _ -> sfp (p:>:sofar) ps
> sfp sofar (p:<:ps) = sfp (p:>:sofar) ps
>
> -get_unrecorded_unsorted :: RepoPatch p => Repository p C(r u t) -> IO (FL Prim C(r u))
> -get_unrecorded_unsorted r = get_unrecorded_in_files_unsorted r []
> -
> -get_unrecorded :: RepoPatch p => Repository p C(r u t) -> IO (FL Prim C(r u))
> -get_unrecorded r = get_unrecorded_private id r []
> -
> --- | Gets the unrecorded changes in the given paths in the current repository,
> --- without sorting them for presentation to the user
> -get_unrecorded_in_files_unsorted :: RepoPatch p => Repository p C(r u t) -> [FileName] -> IO (FL Prim C(r u))
> -get_unrecorded_in_files_unsorted = get_unrecorded_private (AnyOrder:)
> -
> --- | The /unrecorded/ includes the pending and the working directory changes.
> --- The third argument is a list of paths: if this list is [], it will diff
> --- the whole repo, but if there are elements in it, the function will return
> --- only changes to files under those paths. The paths must be fixed paths
> --- starting with ".", but need not yet be unique.
> -get_unrecorded_private :: RepoPatch p => ([DarcsFlag]->[DarcsFlag]) -> Repository p C(r u t) -> [FileName] -> IO (FL Prim C(r y))
> -get_unrecorded_private _ (Repo _ opts _ _) _
> - | NoUpdateWorking `elem` opts = return $ unsafeCoerceP NilFL
> -get_unrecorded_private modopts repository@(Repo r oldopts _ _) files =
> - withCurrentDirectory r (do
> - debugMessage "Looking for unrecorded changes..."
> - cur <- slurp_pending repository
> - work <- if LookForAdds `elem` opts
> - then do nboring <- if Boring `elem` opts
> - then return $ darcsdir_filter
> - else boring_file_filter
> - slurp_unboring (myfilt cur nboring) "."
> - else co_slurp cur "."
> - ftf <- filetype_function
> - Sealed pend <- read_pending repository
> - let changed_files = apply_to_filepaths pend filesFP
> - pre_changed_files = apply_to_filepaths (invert pend) filesFP
> - Sealed relevantPend <- return $ if null files
> - then seal pend
> - else choose_touching pre_changed_files pend
> - debugMessage "diffing dir..."
> - let diffs = if null files
> - then unsafeDiff opts ftf cur work
> - else unsafeDiffAtPaths (ignoreTimes, lookForAdds, summary) ftf cur work changed_files
> - dif = if AnyOrder `elem` opts
> - then relevantPend +>+ diffs
> - else sort_coalesceFL $ relevantPend +>+ diffs
> - seq dif $ debugMessage "Found unrecorded changes."
> - return dif)
> - where myfilt s nboring f = slurp_has f s || nboring [f] /= []
> - opts = modopts oldopts
> - -- NoSummary/Summary both present gives False
> - -- Just Summary gives True
> - -- Just NoSummary gives False
> - -- Neither gives False
> - summary = Summary `elem` opts && NoSummary `notElem` opts
> - lookForAdds = LookForAdds `elem` opts
> - ignoreTimes = IgnoreTimes `elem` opts
> - filesFP = map fn2fp files
> -
> -- @todo: we should not have to open the result of HashedRepo and
> -- seal it. Instead, update this function to work with type witnesses
> -- by fixing DarcsRepo to match HashedRepo in the handling of
Invalidate the index in add_to_pending, as it was getting rebuilt too soon.
---------------------------------------------------------------------------
> Petr Rockai <me at mornfall.net>**20090622113239
> Ignore-this: 103f6b53d3bdc663b60cfa5d7e15d6af
> ] hunk ./src/Darcs/Commands/Add.lhs 51
> import System.FilePath.Posix ( takeDirectory, (</>) )
> import System.IO ( hPutStrLn, stderr )
> import qualified System.FilePath.Windows as WindowsFilePath
> -import Darcs.Gorsvet( invalidateIndex )
>
> add_description :: String
> add_description = "Add one or more new files or directories."
> hunk ./src/Darcs/Commands/Add.lhs 117
> mapM_ (putInfoLn . ((msg_skipping msgs ++ " boring file ")++)) $
> flist \\ nboring flist
> date <- getIsoDateTime
> - invalidateIndex repository
> ps <- addp msgs opts date cur $ nboring flist
> when (nullFL ps && not (null args)) $
> fail "No files were added"
> hunk ./src/Darcs/Commands/Move.lhs 49
> import Darcs.Patch.FileName ( fp2fn, fn2fp, super_name )
> import qualified System.FilePath.Windows as WindowsFilePath
>
> -import Darcs.Gorsvet( invalidateIndex )
> #include "impossible.h"
>
> move_description :: String
> hunk ./src/Darcs/Commands/Move.lhs 100
> else do
> cur <- slurp_pending repository
> addpatch <- check_new_and_old_filenames opts cur work (old_fp,new_fp)
> - invalidateIndex repository
> withSignalsBlocked $ do
> case addpatch of
> Nothing -> add_to_pending repository (Darcs.Patch.move old_fp new_fp :>: NilFL)
> hunk ./src/Darcs/Commands/Move.lhs 122
> cur <- slurp_pending repository
> work <- slurp "."
> addpatches <- mapM (check_new_and_old_filenames opts cur work) $ zip moved movetargets
> - invalidateIndex repository
> withSignalsBlocked $ do
> add_to_pending repository $ unsafeFL $ catMaybes addpatches ++ movepatches
> zipWithM_ (move_file_or_dir work) moved movetargets
> hunk ./src/Darcs/Commands/Remove.lhs 42
> import Darcs.SlurpDirectory ( slurp_removedir, slurp_removefile )
> import Darcs.Repository.Prefs ( filetype_function )
> import Darcs.Diff ( unsafeDiff )
> -import Darcs.Gorsvet( invalidateIndex, unrecordedChanges )
> +import Darcs.Gorsvet( unrecordedChanges )
> #include "impossible.h"
>
> remove_description :: String
> hunk ./src/Darcs/Commands/Remove.lhs 80
> when (null args) $
> putStrLn "Nothing specified, nothing removed."
> p <- make_remove_patch opts repository args
> - invalidateIndex repository
> add_to_pending repository p
>
> make_remove_patch :: RepoPatch p => [DarcsFlag] -> Repository p
> hunk ./src/Darcs/Repository.hs 116
> AllowUnrelatedRepos, NoUpdateWorking )
> , compression )
> import Darcs.Global ( darcsdir )
> -import Darcs.Gorsvet ( unrecordedChanges )
> +import Darcs.Gorsvet ( unrecordedChanges, invalidateIndex )
>
> #include "impossible.h"
>
> hunk ./src/Darcs/Repository.hs 305
> add_to_pending (Repo _ opts _ _) _ | NoUpdateWorking `elem` opts = return ()
> add_to_pending repo@(Repo _ opts _ _) p =
> do pend <- unrecordedChanges opts repo []
> + invalidateIndex repo
> make_new_pending repo (pend +>+ p)
>
Remove unused import from Gorsvet.
----------------------------------
> Petr Rockai <me at mornfall.net>**20090622113432
> Ignore-this: 224d5e137d60f17031d61f7537c6ba16
> ] conflictor {{
> :
> hunk ./src/Darcs/Gorsvet.hs 36
> -import Darcs.External ( backupByCopying )
> :
> hunk ./src/Darcs/Gorsvet.hs 34
> -import Darcs.Repository ( Repository, slurp_pending )
> -import Darcs.Repository.Internal ( read_pending )
> +import Darcs.Repository.Internal ( Repository, slurp_pending, read_pending )
> }} []
> hunk ./src/Darcs/Gorsvet.hs 34
> -import Darcs.Repository ( Repository, slurp_pending )
> -import Darcs.Repository.Internal ( read_pending )
> +import Darcs.Repository.Internal ( Repository, slurp_pending, read_pending )
> :
> hunk ./src/Darcs/Gorsvet.hs 35
> -import Darcs.External ( backupByCopying )
Clean up unused imports in WhatsNew.
------------------------------------
> Petr Rockai <me at mornfall.net>**20090628203201
> Ignore-this: 13a58bf3241a684b1484aac1859848b0
> ] hunk ./src/Darcs/Commands/WhatsNew.lhs 42
> import Darcs.Repository ( Repository, withRepository, ($-), slurp_recorded,
> amInRepository )
> import Darcs.Repository.Prefs ( filetype_function )
> -import Darcs.Diff ( unsafeDiff )
> -import Darcs.Patch ( RepoPatch, Prim, summarize, apply_to_slurpy, is_hunk )
> +import Darcs.Patch ( RepoPatch, Prim, summarize, is_hunk )
> import Darcs.Patch.Permutations ( partitionRL )
> import Darcs.Patch.Real ( RealPatch, prim2real )
> import Darcs.Patch.FileName ( fn2fp )
> hunk ./src/Darcs/Commands/WhatsNew.lhs 56
> import Storage.Hashed( floatPath )
>
> import Printer ( putDocLn, renderString, vcat, text )
> -#include "impossible.h"
>
> whatsnew_description :: String
> whatsnew_description = "List unrecorded changes in the working tree."
Resolve conflict.
-----------------
> Petr Rockai <me at mornfall.net>**20090710141253
> Ignore-this: 3a7c406f2f5460925b938f7ee5d6780e
> ] hunk ./src/Darcs/Gorsvet.hs 34
>
> -- darcs stuff
> import ByteStringUtils( is_funky )
> -import Darcs.Repository ( Repository, slurp_pending )
> -import Darcs.Repository.Internal ( read_pending )
> -import Darcs.External ( backupByCopying )
> +import Darcs.Repository.Internal ( Repository, slurp_pending, read_pending )
> import Darcs.Patch ( RepoPatch, Prim, hunk, canonize, binary, apply
> , sort_coalesceFL, addfile, rmfile, adddir, rmdir, invert)
> import Darcs.Ordered ( FL(..), (+>+) )
Provide readPending that also provides the "pending conflicts" check natively.
------------------------------------------------------------------------------
> Petr Rockai <me at mornfall.net>**20090716082347
> Ignore-this: a7d148120c8be0844d05ba9a983bc6a7
> ] hunk ./src/Darcs/Gorsvet.hs 34
>
> -- darcs stuff
> import ByteStringUtils( is_funky )
> -import Darcs.Repository.Internal ( Repository, slurp_pending, read_pending )
> +import Darcs.Repository.Internal ( Repository, read_pending )
> import Darcs.Patch ( RepoPatch, Prim, hunk, canonize, binary, apply
> , sort_coalesceFL, addfile, rmfile, adddir, rmdir, invert)
> import Darcs.Ordered ( FL(..), (+>+) )
> hunk ./src/Darcs/Gorsvet.hs 49
> import qualified Data.ByteString.Lazy.Char8 as BL
> import qualified Data.ByteString.Char8 as BS
> import Control.Monad.State.Strict
> -import System.Directory( removeFile, doesFileExist )
> +import System.Directory( removeFile, doesFileExist, renameFile )
> import Data.Maybe
> import Data.List( union )
>
> hunk ./src/Darcs/Gorsvet.hs 152
> Sealed pending <- pendingChanges repo []
> applyToTree pending pristine
>
> +readPending repo =
> + do Sealed pending <- read_pending repo
> + pristine <- readDarcsPristine "."
> + catch ((\t -> (t, pending)) `fmap` applyToTree pending pristine) $ \ err -> do
> + putStrLn $ "Yikes, pending has conflicts! " ++ show err
> + putStrLn $ "Stashing the buggy pending as _darcs/patches/pending_buggy"
> + renameFile "_darcs/patches/pending"
> + "_darcs/patches/pending_buggy"
> + return (pristine, NilFL)
> +
> pendingChanges :: (RepoPatch p) => Repository p C(r u t)
> -> [SubPath] -> IO (Sealed (FL Prim C(r)))
> pendingChanges repo paths = do
> hunk ./src/Darcs/Gorsvet.hs 165
> - slurp_pending repo -- XXX: only here to get us the "pending conflicts" check
> - -- that I don't know yet how to implement properly
> - Sealed pending <- read_pending repo
> + pending <- snd `fmap` readPending repo
> let files = map (fn2fp . sp2fn) paths
> pre_files = apply_to_filepaths (invert pending) files
> relevant = case paths of
> hunk ./src/Darcs/Gorsvet.hs 179
> unrecordedChanges :: (RepoPatch p) => [DarcsFlag] -> Repository p C(r u t)
> -> [SubPath] -> IO (FL Prim C(r y))
> unrecordedChanges opts repo paths = do
> - pristine <- readDarcsPristine "."
> - Sealed pending <- pendingChanges repo paths
> - (_, current') <- virtualTreeIO (apply [] pending) pristine
> + (all_current, pending) <- readPending repo
> +
> relevant <- restrictSubpaths repo paths
> nonboring <- restrictBoring
>
> hunk ./src/Darcs/Gorsvet.hs 184
> - let current = relevant current'
> + let current = relevant all_current
> working <- case (LookForAdds `elem` opts, IgnoreTimes `elem` opts) of
> (False, False) -> do
> all <- readIndex repo
Proper implementation for mDoesFileExist/mDoesDirectoryExist in Gorsvet.
------------------------------------------------------------------------
> Petr Rockai <me at mornfall.net>**20090716082525
> Ignore-this: 90dc8dbab055b3a78e05ff26e1605f6f
> ] hunk ./src/Darcs/Gorsvet.hs 68
> ( virtualTreeIO, hashedTreeIO, plainTreeIO
> , unlink, rename, createDirectory, writeFile
> , readFile -- ratify readFile: haskell_policy je natvrdl??
> - , cwd, tree, TreeIO )
> + , fileExists, directoryExists, cwd, TreeIO )
> import Storage.Hashed
>
> floatFn :: FileName -> AnchoredPath
> hunk ./src/Darcs/Gorsvet.hs 75
> floatFn = floatPath . fn2fp
>
> instance ReadableDirectory TreeIO where
> - mDoesDirectoryExist d = gets (\x -> isJust $ findTree (tree x) (floatFn d))
> - mDoesFileExist f = gets (\x -> isJust $ findFile (tree x) (floatFn f))
> + mDoesDirectoryExist d = directoryExists (floatFn d)
> + mDoesFileExist f = fileExists (floatFn f)
> mInCurrentDirectory d action = do -- TODO bracket?
> wd <- gets cwd
> modify (\x -> x { cwd = floatFn d })
Optimize darcs show contents --match (avoid slurping pristine).
---------------------------------------------------------------
> Petr Rockai <me at mornfall.net>**20090716083218
> Ignore-this: c611f7eff91b80fe2bdf598b68bea454
> ] hunk ./src/Darcs/Commands/ShowContents.lhs 22
> \begin{code}
> module Darcs.Commands.ShowContents ( show_contents ) where
>
> -import Control.Monad ( filterM )
> +import Control.Monad ( filterM, forM_, unless )
> +import Control.Monad.Trans( liftIO )
> import System.IO ( stdout )
> hunk ./src/Darcs/Commands/ShowContents.lhs 25
> -import System.FilePath.Posix ( takeFileName )
> +import Data.Maybe( fromJust )
>
> import qualified Data.ByteString as B
> hunk ./src/Darcs/Commands/ShowContents.lhs 28
> -import Workaround ( getCurrentDirectory )
>
> import Darcs.Commands ( DarcsCommand(..), nodefaults )
> import Darcs.Arguments ( DarcsFlag, match_one,
> hunk ./src/Darcs/Commands/ShowContents.lhs 32
> working_repo_dir, fixSubPaths )
> -import Darcs.RepoPath ( toFilePath, sp2fn )
> +import Darcs.RepoPath ( sp2fn )
> import Darcs.IO ( mReadFilePS, mDoesFileExist )
> hunk ./src/Darcs/Commands/ShowContents.lhs 34
> -import Darcs.Match ( get_partial_nonrange_match, have_nonrange_match )
> -import Darcs.Repository ( withRepository, ($-), findRepository,
> - createPartialsPristineDirectoryTree )
> -import Darcs.Lock ( withTempDir )
> +import Darcs.Patch.Match( Matcher )
> +import Darcs.Match ( have_nonrange_match, apply_inv_to_matcher, nonrange_matcher
> + , InclusiveOrExclusive(..), match_exists )
> +import Darcs.Repository ( withRepository, ($-), findRepository, read_repo )
> +import Darcs.Patch( RepoPatch )
> +import Storage.Hashed.Monad( virtualTreeIO )
> +import Darcs.Gorsvet( readRecorded )
>
> show_contents_description :: String
> show_contents_description = "Outputs a specific version of a file."
> hunk ./src/Darcs/Commands/ShowContents.lhs 65
> command_advanced_options = [],
> command_basic_options = [match_one, working_repo_dir]}
>
> +get_matcher :: (RepoPatch p) => [DarcsFlag] -> Matcher p
> +get_matcher = fromJust . nonrange_matcher
> +
> show_contents_cmd :: [DarcsFlag] -> [String] -> IO ()
> show_contents_cmd opts args = withRepository opts $- \repository -> do
> hunk ./src/Darcs/Commands/ShowContents.lhs 70
> - formerdir <- getCurrentDirectory
> path_list <- map sp2fn `fmap` fixSubPaths opts args
> hunk ./src/Darcs/Commands/ShowContents.lhs 71
> - thename <- return $ takeFileName formerdir
> - withTempDir thename $ \dir -> do
> - if have_nonrange_match opts
> - then get_partial_nonrange_match repository opts path_list
> - else createPartialsPristineDirectoryTree repository path_list (toFilePath dir)
> - filterM mDoesFileExist path_list >>= mapM_ (\f -> mReadFilePS f >>= B.hPut stdout)
> + pristine <- readRecorded repository
> + let matcher = get_matcher opts
> + unapply_to_match = apply_inv_to_matcher Exclusive matcher
> + matched <- if (have_nonrange_match opts)
> + then do patchset <- read_repo repository
> + unless (match_exists matcher patchset) $
> + fail $ "Couldn't match pattern " ++ show matcher
> + snd `fmap` virtualTreeIO (unapply_to_match patchset) pristine
> + else return pristine
> + let dump = do okpaths <- filterM mDoesFileExist path_list
> + forM_ okpaths $ \f -> do content <- mReadFilePS f
> + liftIO (B.hPut stdout content)
> + virtualTreeIO dump matched
> + return ()
> \end{code}
> hunk ./src/Darcs/Match.lhs 32
> get_partial_nonrange_match,
> first_match, second_match, have_nonrange_match,
> have_patchset_match, get_one_patchset,
> - checkMatchSyntax,
> + checkMatchSyntax, apply_inv_to_matcher, nonrange_matcher,
> + InclusiveOrExclusive(..), match_exists
> ) where
>
> import Text.Regex ( mkRegex, matchRegex )
> hunk ./tests/show_contents.sh 2
> #!/usr/bin/env bash
> -set -ev
> +. lib
>
> rm -rf temp1
> mkdir temp1
> hunk ./tests/show_contents.sh 26
> darcs show contents foo --tag t1 | grep second
> cd ..
>
> +not darcs show contents foo --match "hash bla" 2>&1 | tee out
> +grep "Couldn't match pattern" out
> +
> rm -rf temp1
Port the replay (check/repair) functionality to hashed-storage.
---------------------------------------------------------------
> Petr Rockai <me at mornfall.net>**20090720072018
> Ignore-this: a1e2c32ac633e72a8b20e830232cef5
>
> This removes a few unsafeDiff users. It also simplifies the replay code by not
> threading the Slurpy all over the place (instead placing applyAndFix in the
> TreeIO monad). There is a slight risk of regressions (and a moderate risk of
> space leaks).
> ] hunk ./src/Darcs/Commands/Check.lhs 31
> )
> import Darcs.Repository.Repair( replayRepository,
> RepositoryConsistency(..) )
> -import Darcs.Repository ( Repository, amInRepository, withRepository, slurp_recorded,
> +import Darcs.Repository ( Repository, amInRepository, withRepository,
> testRecorded )
> import Darcs.Patch ( RepoPatch, showPatch )
> import Darcs.Ordered ( FL(..) )
> hunk ./src/Darcs/Commands/Check.lhs 35
> -import Darcs.Diff ( unsafeDiff )
> import Darcs.Repository.Prefs ( filetype_function )
> hunk ./src/Darcs/Commands/Check.lhs 36
> +import Darcs.Gorsvet( treeDiff, readRecorded )
> import Printer ( putDocLn, text, ($$), (<+>) )
>
> hunk ./src/Darcs/Commands/Check.lhs 39
> +
> check_description :: String
> check_description = "Check the repository for consistency."
>
> hunk ./src/Darcs/Commands/Check.lhs 93
> brokenPristine newpris
> putInfo $ text "Found broken patches."
> exitWith $ ExitFailure 1
> - where
> + where
> brokenPristine newpris = do
> putInfo $ text "Looks like we have a difference..."
> hunk ./src/Darcs/Commands/Check.lhs 96
> - mc <- slurp_recorded repository
> + mc <- readRecorded repository
> ftf <- filetype_function
> hunk ./src/Darcs/Commands/Check.lhs 98
> - putInfo $ case unsafeDiff opts ftf newpris mc of
> + diff <- treeDiff ftf newpris mc
> + putInfo $ case diff of
> NilFL -> text "Nothing"
> patch -> text "Difference: " <+> showPatch patch
> putInfo $ text ""
> hunk ./src/Darcs/Commands/Repair.lhs 28
> working_repo_dir, umask_option,
> )
> import Darcs.Repository ( withRepoLock, ($-), amInRepository,
> - replacePristineFromSlurpy, writePatchSet )
> + replacePristine, writePatchSet )
> import Darcs.Repository.Repair( replayRepository,
> RepositoryConsistency(..) )
>
> hunk ./src/Darcs/Commands/Repair.lhs 60
> case state of
> RepositoryConsistent ->
> putStrLn "The repository is already consistent, no changes made."
> - BrokenPristine s -> do
> + BrokenPristine tree -> do
> putStrLn "Fixing pristine tree..."
> hunk ./src/Darcs/Commands/Repair.lhs 62
> - replacePristineFromSlurpy repository s
> - BrokenPatches s newps -> do
> + replacePristine repository tree
> + BrokenPatches tree newps -> do
> putStrLn "Writing out repaired patches..."
> writePatchSet newps opts
> putStrLn "Fixing pristine tree..."
> hunk ./src/Darcs/Commands/Repair.lhs 67
> - replacePristineFromSlurpy repository s
> + replacePristine repository tree
> return ()
>
> \end{code}
> hunk ./src/Darcs/Repository.hs 30
> withRepository, withRepositoryDirectory, withGutsOf,
> makePatchLazy, writePatchSet,
> findRepository, amInRepository, amNotInRepository,
> - slurp_pending, replacePristineFromSlurpy,
> + slurp_pending, replacePristine,
> slurp_recorded, slurp_recorded_and_unrecorded,
> withRecorded,
> read_repo, sync_repo,
> hunk ./src/Darcs/Repository.hs 84
>
> import Control.Monad ( unless, when )
> import Data.Either(Either(..))
> -import System.Directory ( createDirectory )
> +import System.Directory ( createDirectory, renameDirectory )
> import System.IO.Error ( isAlreadyExistsError )
>
> import qualified Darcs.Repository.DarcsRepo as DarcsRepo
> hunk ./src/Darcs/Repository.hs 94
> import Darcs.Repository.Checkpoint ( identify_checkpoint, write_checkpoint_patch, get_checkpoint )
> import Darcs.Repository.ApplyPatches ( apply_patches )
> import Darcs.Repository.HashedRepo ( apply_to_tentative_pristine )
> +import Darcs.Repository.InternalTypes ( Pristine(..) )
> import Darcs.Patch ( RepoPatch, Named, Prim, Patch, patch2patchinfo, apply )
> import Darcs.Ordered ( FL(..), RL(..), bunchFL, mapFL, mapRL, mapRL_RL, concatFL
> , reverseRL ,concatRL, lengthRL, isShorterThanRL, (+>+) )
> hunk ./src/Darcs/Repository.hs 110
> import Progress ( debugMessage, tediousSize,
> beginTedious, endTedious, progress )
> import Darcs.ProgressPatches (progressRLShowTags, progressFL)
> -import Darcs.Lock ( writeBinFile )
> +import Darcs.Lock ( writeBinFile, writeDocBinFile, rm_recursive )
> import Darcs.Sealed ( Sealed(..), FlippedSeal(..), flipSeal, mapFlipped )
>
> import Darcs.Flags ( DarcsFlag( Quiet, Partial, Lazy, Ephemeral,
> hunk ./src/Darcs/Repository.hs 119
> import Darcs.Global ( darcsdir )
> import Darcs.Gorsvet ( unrecordedChanges, invalidateIndex )
>
> +import Storage.Hashed.Tree( Tree, treeHash )
> +import Storage.Hashed.Darcs( darcsFormatHash )
> +import Storage.Hashed( writePlainTree )
> +import ByteStringUtils( gzReadFilePS )
> +import System.FilePath( (</>) )
> +
> +import qualified Data.ByteString.Char8 as BS (unpack)
> +
> #include "impossible.h"
>
> createRepository :: [DarcsFlag] -> IO ()
> hunk ./src/Darcs/Repository.hs 317
> invalidateIndex repo
> make_new_pending repo (pend +>+ p)
>
> +
> +-- | FIXME. This is incorrect in the hashed case: it relies on the Tree being
> +-- already written out in the pristine.hashed and will just update pristine |
> +-- pointer!
> +replacePristine :: Repository p C(r u t) -> Tree -> IO ()
> +replacePristine (Repo r opts rf (DarcsRepository pris c)) tree =
> + withCurrentDirectory r $ replace pris
> + where replace HashedPristine =
> + do let t = darcsdir++"/hashed_inventory"
> + i <- gzReadFilePS t
> + let hash = (darcsFormatHash $ fromJust $ treeHash tree)
> + inv = HashedRepo.pris2inv (BS.unpack hash) i
> + writeDocBinFile t inv
> + replace (PlainPristine n) =
> + do rm_recursive nold `catchall` return ()
> + writePlainTree tree ntmp
> + renameDirectory n nold
> + renameDirectory ntmp n
> + return ()
> + replace (NoPristine _) = return ()
> + nold = darcsdir </> "pristine-old"
> + ntmp = darcsdir </> "pristine-tmp"
> +
> hunk ./src/Darcs/Repository/HashedRepo.hs 30
> add_to_tentative_inventory, remove_from_tentative_inventory,
> read_repo, read_tentative_repo, write_and_read_patch,
> write_tentative_inventory, copy_repo, slurp_all_but_darcs,
> - readHashedPristineRoot
> + readHashedPristineRoot, pris2inv
> ) where
>
> import System.Directory ( doesFileExist, createDirectoryIfMissing )
> hunk ./src/Darcs/Repository/Repair.hs 9
> where
>
> import Control.Monad ( when, unless )
> +import Control.Monad.Trans ( liftIO )
> import Control.Exception ( finally )
> import Data.Maybe ( catMaybes )
> import Data.List ( sort )
> hunk ./src/Darcs/Repository/Repair.hs 15
> import System.Directory ( createDirectoryIfMissing )
>
> -import Darcs.SlurpDirectory ( empty_slurpy, withSlurpy, Slurpy, SlurpMonad, syncSlurpy )
> import Darcs.Lock( rm_recursive )
> import Darcs.Hopefully ( PatchInfoAnd, info )
>
> hunk ./src/Darcs/Repository/Repair.hs 28
>
> import Darcs.Repository.Format ( identifyRepoFormat,
> RepoProperty ( HashedInventory ), format_has )
> -import Darcs.Repository.Cache ( Cache, HashedDir( HashedPristineDir ) )
> -import Darcs.Repository.HashedIO ( slurpHashedPristine, writeHashedPristine,
> - clean_hashdir )
> +import Darcs.Repository.Cache ( HashedDir( HashedPristineDir ) )
> +import Darcs.Repository.HashedIO ( clean_hashdir )
> import Darcs.Repository.HashedRepo ( readHashedPristineRoot )
> import Darcs.Repository.Checkpoint ( get_checkpoint_by_default )
> import Darcs.Repository.InternalTypes ( extractCache )
> hunk ./src/Darcs/Repository/Repair.hs 33
> -import Darcs.Repository ( Repository, read_repo,
> - checkPristineAgainstSlurpy,
> - makePatchLazy )
> +import Darcs.Repository.Prefs ( filetype_function )
> +import Darcs.Repository ( Repository, read_repo, makePatchLazy )
>
> import Darcs.Sealed ( Sealed(..), unsafeUnflippedseal )
> import Progress ( debugMessage, beginTedious, endTedious, tediousSize, finishedOneIO )
> hunk ./src/Darcs/Repository/Repair.hs 40
> import Darcs.Utils ( catchall )
> import Darcs.Global ( darcsdir )
> -import Darcs.Flags ( compression )
> import Printer ( Doc, putDocLn, text )
> import Darcs.Arguments ( DarcsFlag( Verbose, Quiet ) )
> hunk ./src/Darcs/Repository/Repair.hs 42
> +
> +import Darcs.Gorsvet( treeDiff, readRecorded )
> +import Storage.Hashed.Monad( hashedTreeIO, TreeIO )
> +import Storage.Hashed.Tree( Tree, emptyTree )
> +
> #include "impossible.h"
>
> hunk ./src/Darcs/Repository/Repair.hs 49
> -run_slurpy :: Slurpy -> SlurpMonad a -> IO (Slurpy, a)
> -run_slurpy s f =
> - case withSlurpy s f of
> - Left err -> fail err
> - Right x -> return x
> -
> -update_slurpy :: Repository p -> Cache -> [DarcsFlag] -> Slurpy -> IO Slurpy
> -update_slurpy r c opts s = do
> - current <- readHashedPristineRoot r
> - h <- writeHashedPristine c (compression opts) s
> - s' <- slurpHashedPristine c (compression opts) h
> - clean_hashdir c HashedPristineDir $ catMaybes [Just h, current]
> - return s'
> -
> replaceInFL :: FL (PatchInfoAnd a)
> -> [(PatchInfo, PatchInfoAnd a)]
> -> FL (PatchInfoAnd a)
> hunk ./src/Darcs/Repository/Repair.hs 58
> | info o == o' = c:>:replaceInFL orig ch_rest
> | otherwise = o:>:replaceInFL orig ch
>
> -applyAndFix :: RepoPatch p => Cache -> [DarcsFlag] -> Slurpy -> Repository p -> FL (PatchInfoAnd p) -> IO (FL (PatchInfoAnd p), Slurpy, Bool)
> -applyAndFix _ _ s _ NilFL = return (NilFL, s, True)
> -applyAndFix c opts s_ r psin =
> - do beginTedious k
> - tediousSize k $ lengthFL psin
> - (repaired, slurpy, ok) <- aaf s_ psin
> - endTedious k
> - orig <- (reverseRL . concatRL) `fmap` read_repo r
> - return (replaceInFL orig repaired, slurpy, ok)
> +applyAndFix :: forall p. RepoPatch p => Repository p -> FL (PatchInfoAnd p) -> TreeIO (FL (PatchInfoAnd p), Bool)
> +applyAndFix _ NilFL = return (NilFL, True)
> +applyAndFix r psin =
> + do liftIO $ beginTedious k
> + liftIO $ tediousSize k $ lengthFL psin
> + (repaired, ok) <- aaf psin
> + liftIO $ endTedious k
> + orig <- liftIO $ (reverseRL . concatRL) `fmap` read_repo r
> + return (replaceInFL orig repaired, ok)
> where k = "Replaying patch"
> hunk ./src/Darcs/Repository/Repair.hs 68
> - aaf s NilFL = return ([], s, True)
> - aaf s (p:>:ps) = do
> - (s', mp') <- run_slurpy s $ applyAndTryToFix p
> + aaf :: FL (PatchInfoAnd p) -> TreeIO ([(PatchInfo, PatchInfoAnd p)], Bool)
> + aaf NilFL = return ([], True)
> + aaf (p:>:ps) = do
> + mp' <- applyAndTryToFix p
> let !infp = info p -- assure that 'p' can be garbage collected.
> hunk ./src/Darcs/Repository/Repair.hs 73
> - finishedOneIO k $ show $ human_friendly $ infp
> - s'' <- syncSlurpy (update_slurpy r c opts) s'
> - (ps', s''', restok) <- aaf s'' ps
> + liftIO $ finishedOneIO k $ show $ human_friendly $ infp
> + (ps', restok) <- aaf ps
> case mp' of
> hunk ./src/Darcs/Repository/Repair.hs 76
> - Nothing -> return (ps', s''', restok)
> - Just (e,pp) -> do putStrLn e
> - p' <- makePatchLazy r pp
> - return ((infp, p'):ps', s''', False)
> + Nothing -> return (ps', restok)
> + Just (e,pp) -> do liftIO $ putStrLn e
> + p' <- liftIO $ makePatchLazy r pp
> + return ((infp, p'):ps', False)
>
> data RepositoryConsistency p =
> RepositoryConsistent
> hunk ./src/Darcs/Repository/Repair.hs 83
> - | BrokenPristine Slurpy
> - | BrokenPatches Slurpy (PatchSet p)
> + | BrokenPristine Tree
> + | BrokenPatches Tree (PatchSet p)
>
> check_uniqueness :: RepoPatch p => (Doc -> IO ()) -> (Doc -> IO ()) -> Repository p -> IO ()
> check_uniqueness putVerbose putInfo repository =
> hunk ./src/Darcs/Repository/Repair.hs 110
> maybe_chk <- get_checkpoint_by_default repo
> let c = extractCache repo
> createDirectoryIfMissing False $ darcsdir ++ "/pristine.hashed"
> - rooth <- writeHashedPristine c (compression opts) empty_slurpy
> - s <- slurpHashedPristine c (compression opts) rooth
> + pris <- readRecorded repo
> putVerbose $ text "Applying patches..."
> patches <- read_repo repo
> hunk ./src/Darcs/Repository/Repair.hs 113
> - (s', newpatches, patches_ok) <- case maybe_chk of
> + (newpris, newpatches, patches_ok) <- case maybe_chk of
> Just (Sealed chk) ->
> do let chtg = patch2patchinfo chk
> hunk ./src/Darcs/Repository/Repair.hs 116
> + repair_checkpoint =
> + do applyAndTryToFix chk
> + applyAndFix repo
> + (reverseRL $ concatRL $ unsafeUnflippedseal $
> + get_patches_beyond_tag chtg patches)
> putVerbose $ text "I am repairing from a checkpoint."
> hunk ./src/Darcs/Repository/Repair.hs 122
> - (s'', _) <- run_slurpy s $ applyAndTryToFix chk
> - (_, s_, ok) <- applyAndFix c opts s'' repo
> - (reverseRL $ concatRL $ unsafeUnflippedseal $ get_patches_beyond_tag chtg patches)
> - return (s_, patches, ok)
> + ((_, ok), tree) <- hashedTreeIO repair_checkpoint emptyTree "_darcs/pristine.hashed"
> + return (tree, patches, ok)
> Nothing -> do debugMessage "Fixing any broken patches..."
> let psin = reverseRL $ concatRL patches
> hunk ./src/Darcs/Repository/Repair.hs 126
> - (ps, s_, ok) <- applyAndFix c opts s repo psin
> + repair = applyAndFix repo psin
> + ((ps, ok), tree) <- hashedTreeIO repair emptyTree "_darcs/pristine.hashed"
> debugMessage "Done fixing broken patches..."
> hunk ./src/Darcs/Repository/Repair.hs 129
> - return (s_, (reverseFL ps :<: NilRL), ok)
> + return (tree, (reverseFL ps :<: NilRL), ok)
> debugMessage "Checking pristine against slurpy"
> hunk ./src/Darcs/Repository/Repair.hs 131
> - is_same <- checkPristineAgainstSlurpy repo s' `catchall` return False
> + ftf <- filetype_function
> + is_same <- do diff <- treeDiff ftf pris newpris
> + return $ case diff of
> + NilFL -> True
> + _ -> False
> + `catchall` return False
> -- TODO is the latter condition needed? Does a broken patch imply pristine
> -- difference? Why, or why not?
> return (if is_same && patches_ok
> hunk ./src/Darcs/Repository/Repair.hs 142
> then RepositoryConsistent
> else if patches_ok
> - then BrokenPristine s'
> - else BrokenPatches s' newpatches)
> + then BrokenPristine newpris
> + else BrokenPatches newpris newpatches)
>
> cleanupRepositoryReplay :: Repository p -> IO ()
> cleanupRepositoryReplay r = do
Remove the support for writing out new checkpoints.
---------------------------------------------------
Makes sense to me. We no longer care about creating repositories for
use with darcs get --partial. They should be upgrading to hashed
repositories instead.
Remove the --checkpoint option from the UI.
-------------------------------------------
> hunk ./tests/checkpoint.sh 5
>
> # A test for unrecording checkpoint tags, inspired by issue517
>
> +exit 200 # checkpoint creation is not supported by current darcs
> + # we would need a testdata tarball for this test
> +
So this is just a temporary skip until we have such a tarball?
Sensible approach.
Remove now-unused checkPristineAgainstSlurpy.
---------------------------------------------
> Petr Rockai <me at mornfall.net>**20090720093843
> Ignore-this: b41cc7ee14e954f7d4711df66f6f5537
> ] hunk ./src/Darcs/Repository.hs 46
> applyToWorking, patchSetToPatches,
> createPristineDirectoryTree, createPartialsPristineDirectoryTree,
> optimizeInventory, cleanRepository,
> - checkPristineAgainstSlurpy, getMarkedupFile,
> + getMarkedupFile,
> PatchSet, SealedPatchSet, PatchInfoAnd,
> setScriptsExecutable,
> checkUnrelatedRepos,
> hunk ./src/Darcs/Repository.hs 64
> slurp_recorded, slurp_recorded_and_unrecorded,
> withRecorded,
> read_repo, sync_repo,
> - prefsUrl, checkPristineAgainstSlurpy,
> + prefsUrl,
> withRepoLock, withRepoReadLock, withRepository, withRepositoryDirectory, withGutsOf,
> tentativelyAddPatch, tentativelyRemovePatches, tentativelyAddToPending,
> tentativelyReplacePatches,
> hunk ./src/Darcs/Repository/Internal.hs 32
> read_pending, announce_merge_conflicts, setTentativePending,
> check_unrecorded_conflicts,
> withRecorded,
> - checkPristineAgainstSlurpy,
> read_repo, sync_repo,
> prefsUrl, makePatchLazy,
> withRepoLock, withRepoReadLock,
> hunk ./src/Darcs/Repository/Internal.hs 131
> import Darcs.Patch.Set ( PatchSet, SealedPatchSet )
> import Darcs.Patch.Apply ( markup_file, LineMark(None) )
> import Darcs.Patch.Depends ( get_common_and_uncommon, deep_optimize_patchset )
> -import Darcs.Diff ( unsafeDiff )
> import Darcs.RepoPath ( FilePathLike, AbsolutePath, toFilePath,
> ioAbsoluteOrRemote, toPath )
> import Darcs.Utils ( promptYorn, catchall, withCurrentDirectory, withUMask, nubsort )
> hunk ./src/Darcs/Repository/Internal.hs 860
> = mk_dir $ \d -> do createPristineDirectoryTree repository (toFilePath d)
> f d
>
> -checkPristineAgainstSlurpy :: RepoPatch p => Repository p C(r u t) -> Slurpy -> IO Bool
> -checkPristineAgainstSlurpy repository@(Repo _ opts _ _) s2 =
> - do s1 <- slurp_recorded repository
> - ftf <- filetype_function
> - -- The @$!@ is necessary because some code called from this function uses
> - -- unsafeInterleaveIO around functions that throw exceptions. If one used
> - -- @$@ instead of @$!@ here, those exceptions might not be caught by code
> - -- that runs this function inside a @catch at .
> - return $! nullFL $ unsafeDiff (LookForAdds:IgnoreTimes:opts) ftf s1 s2
> -
> withTentative :: forall p a C(r u t). RepoPatch p =>
> Repository p C(r u t) -> ((AbsolutePath -> IO a) -> IO a)
> -> (AbsolutePath -> IO a) -> IO a
Roll back the getSymbolicLinkStatus workaround, since it constitutes a fd leak.
-------------------------------------------------------------------------------
> - -- size <- fileSize `fmap` getSymbolicLinkStatus f
> - -- GHC 6.8.2 returns garbage, workaround:
> - size <- hFileSize =<< openBinaryFile f ReadMode
> + size <- fileSize `fmap` getSymbolicLinkStatus f
I've applied this.
Does this mean dropping GHC 6.8 support for the next Darcs release?
Use tee in pending_has_conflicts.sh for easier debugging.
---------------------------------------------------------
Applied, no comment.
Slightly refactor test machinery in Setup.lhs.
Slightly refactor the run function in ShellHarness.
---------------------------------------------------
Applied from previous bundle.
Add support for skipping tests (exit 200).
------------------------------------------
Nice.
David's darcs uses a mechanism in which we have special comments
to parse. The one you propose looks like it does the same thing,
and could be simpler too.
> +data Status = Success | Failed | Skipped
This looks like will play nice with the new 'failing-foo'
stuff from David's branch.
No comment, but I'll highlight the interesting bits for anybody
who's following this
> - if success then do putStrLn " passed."
> - cleanup_dirs
> - run_helper shell ts fails env
> - else do putStrLn " failed."
> - putStrLn $ "Probable reason :" ++ output
> - cleanup_dirs
> - run_helper shell ts (fails++[test]) env
> + (output,result) <- backtick shell test env
> + cleanup_dirs
> + case result of
> + Skipped -> do putStrLn " skipped."
> + run_helper shell ts fails env
> + Success -> do putStrLn " passed."
> + run_helper shell ts fails env
> + Failed -> do putStrLn " failed."
> + putStrLn $ "Probable reason :" ++ output
> + run_helper shell ts (fails++[test]) env
> -backtick :: String -> String -> [(String, String)]-> IO (String,Bool)
> +backtick :: String -> String -> [(String, String)]-> IO (String,Status)
> backtick cmd args env = do
> (exitcode,res) <- backtick_helper cmd args env
> case exitcode of
> hunk ./Distribution/ShellHarness.hs 102
> - ExitSuccess -> return (res, True)
> - ExitFailure _ -> return (res, False)
> + ExitSuccess -> return (res, Success)
> + ExitFailure 200 -> return (res, Skipped)
> + ExitFailure _ -> return (res, Failed)
Avoid removing in-use files on win32.
-------------------------------------
> Petr Rockai <me at mornfall.net>**20090720105654
> Ignore-this: 4951404baa3b6226f53629f97a1b7dc4
> ] hunk ./src/Darcs/Gorsvet.hs 252
> format_valid <- if exist
> then I.indexFormatValid "_darcs/index"
> else return True
> - when (exist && not format_valid) $ removeFile "_darcs/index"
> + when (exist && not format_valid) $
> +#if mingw32_HOST_OS
> + renameFile "_darcs/index" "_darcs/index.old"
> +#else
> + removeFile "_darcs/index"
> +#endif
> if (not exist || invalid || not format_valid)
> then do pris <- readRecordedAndPending repo
> idx <- I.updateIndexFrom "_darcs/index" darcsTreeHash pris
Re-implement make_remove_patch in remove command, replacing Slurps with Trees.
------------------------------------------------------------------------------
> Petr Rockai <me at mornfall.net>**20090720164717
> Ignore-this: fe98fa6720e6d129de3e6f364fc7ba91
> ] hunk ./src/Darcs/Commands/Remove.lhs 33
> list_registered_files,
> working_repo_dir, umask_option
> )
> -import Darcs.RepoPath ( SubPath, toFilePath, sp2fn )
> +import Darcs.RepoPath ( SubPath, sp2fn )
> import Darcs.Repository ( Repository, withRepoLock, ($-), amInRepository,
> hunk ./src/Darcs/Commands/Remove.lhs 35
> - slurp_pending, slurp_recorded,
> add_to_pending )
> hunk ./src/Darcs/Commands/Remove.lhs 36
> -import Darcs.Patch ( RepoPatch, Prim, apply_to_slurpy, adddir, rmdir, addfile, rmfile )
> +import Darcs.Patch ( RepoPatch, Prim, adddir, rmdir, addfile, rmfile )
> +import Darcs.Patch.FileName( fn2fp )
> import Darcs.Ordered ( FL(..), (+>+) )
> hunk ./src/Darcs/Commands/Remove.lhs 39
> -import Darcs.SlurpDirectory ( slurp_removedir, slurp_removefile )
> import Darcs.Repository.Prefs ( filetype_function )
> hunk ./src/Darcs/Commands/Remove.lhs 40
> -import Darcs.Diff ( unsafeDiff )
> -import Darcs.Gorsvet( unrecordedChanges )
> -#include "impossible.h"
> +import Darcs.Gorsvet( readRecordedAndPending, readUnrecorded, treeDiff )
> +import Storage.Hashed.Tree( TreeItem(..), find, modifyTree, expand )
> +import Storage.Hashed.AnchoredPath( anchorPath )
> +import Storage.Hashed( floatPath )
>
> remove_description :: String
> remove_description = "Remove files from version control."
> hunk ./src/Darcs/Commands/Remove.lhs 84
>
> make_remove_patch :: RepoPatch p => [DarcsFlag] -> Repository p
> -> [SubPath] -> IO (FL Prim)
> -make_remove_patch opts repository files =
> - do s <- slurp_pending repository
> - srecorded <- slurp_recorded repository
> - pend <- unrecordedChanges opts repository files
> - let sunrec = fromJust $ apply_to_slurpy pend srecorded
> - wt <- filetype_function
> - mrp wt s sunrec files
> - where mrp wt s sunrec (f:fs) =
> - case slurp_removedir fn s of
> - Just s' ->
> - case slurp_removedir fn sunrec of
> - Just sunrec' -> do rest <- mrp wt s' sunrec' fs
> - return $ rmdir f_fp :>: rest
> - Nothing -> do rest <- mrp wt s' sunrec fs
> - return $ adddir f_fp :>: rmdir f_fp :>: rest
> - Nothing ->
> - case slurp_removefile fn s of
> - Nothing -> fail $ "Can't remove "++f_fp
> - Just s' ->
> - case slurp_removefile fn sunrec of
> - Nothing -> do rest <- mrp wt s' sunrec fs
> - return $ addfile f_fp :>: rmfile f_fp :>: rest
> - Just sunrec' -> do rest <- mrp wt s' sunrec' fs
> - let newp = unsafeDiff [] wt sunrec sunrec'
> - return $ newp +>+ rest
> - where fn = sp2fn f
> - f_fp = toFilePath f
> +make_remove_patch _ repository files =
> + do recorded <- expand =<< readRecordedAndPending repository
> + unrecorded <- readUnrecorded repository
> + ftf <- filetype_function
> + mrp ftf recorded unrecorded $ map (floatPath . fn2fp . sp2fn) files
> + where mrp ftf recorded unrecorded (f:fs) = do
> + let recorded' = modifyTree recorded f Nothing
> + unrecorded' = modifyTree unrecorded f Nothing
> + rest <- mrp ftf recorded' unrecorded' fs
> + let f_fp = anchorPath "" f
> +
> + case (find recorded f, find unrecorded f) of
> + (Just (SubTree _), Just (SubTree _)) ->
> + return $ rmdir f_fp :>: rest
> + (Just (File _), Just (File _)) ->
> + do diff <- treeDiff ftf unrecorded unrecorded'
> + return $ diff +>+ rest
> + (Just (File _), _) ->
> + return $ addfile f_fp :>: rmfile f_fp :>: rest
> + (Just (SubTree _), _) ->
> + return $ adddir f_fp :>: rmdir f_fp :>: rest
> + (_, _) -> fail $ "Can't remove " ++ f_fp
> +
> mrp _ _ _ [] = return NilFL
>
> rm_description :: String
> hunk ./src/Darcs/Gorsvet.hs 146
> readRecorded :: (RepoPatch p) => Repository p C(r u t) -> IO Tree
> readRecorded _ = readDarcsPristine "."
>
> +readUnrecorded :: (RepoPatch p) => Repository p C(r u t) -> IO Tree
> +readUnrecorded repo = expand =<< readIndex repo
> +
> readRecordedAndPending :: (RepoPatch p) => Repository p C(r u t) -> IO Tree
> readRecordedAndPending repo = do
> pristine <- readRecorded repo
Obliterate all instances of sync_repo and friends, since they are useless now.
------------------------------------------------------------------------------
> Petr Rockai <me at mornfall.net>**20090720165700
> Ignore-this: 9225b11cb51cd0a35a3db1df25548304
> ] hunk ./src/Darcs/Commands/AmendRecord.lhs 33
> import Darcs.Hopefully ( PatchInfoAnd, n2pia, hopefully, info )
> import Darcs.Repository ( withRepoLock, ($-), withGutsOf,
> tentativelyRemovePatches, tentativelyAddPatch, finalizeRepositoryChanges,
> - sync_repo, amInRepository,
> + amInRepository,
> )
> import Darcs.Patch ( RepoPatch, description, Prim, fromPrims,
> infopatch, getdeps, adddeps, effect,
> hunk ./src/Darcs/Commands/AmendRecord.lhs 167
> tentativelyRemovePatches repository opts (hopefully oldp :>: NilFL)
> tentativelyAddPatch repository opts newp
> finalizeRepositoryChanges repository
> - sync_repo repository
> putStrLn "Finished amending patch:"
> putDocLn $ description newp
>
> hunk ./src/Darcs/Commands/Apply.lhs 52
> import Darcs.RepoPath ( toFilePath, useAbsoluteOrStd )
> import Darcs.Repository ( SealedPatchSet, withRepoLock, ($-), amInRepository,
> tentativelyMergePatches,
> - sync_repo, read_repo,
> + read_repo,
> finalizeRepositoryChanges,
> applyToWorking,
> )
> hunk ./src/Darcs/Commands/Apply.lhs 161
> wait_a_moment -- so work will be more recent than rec
> applyToWorking repository opts pw `catch` \e ->
> fail ("Error applying patch to working dir:\n" ++ show e)
> - sync_repo repository
> putStrLn "Finished applying..."
> where fixed_opts = if Interactive `elem` opts
> then opts
> hunk ./src/Darcs/Commands/Convert.lhs 48
> slurp_recorded, optimizeInventory,
> tentativelyMergePatches, patchSetToPatches,
> createPristineDirectoryTree,
> - revertRepositoryChanges, finalizeRepositoryChanges, sync_repo )
> + revertRepositoryChanges, finalizeRepositoryChanges )
> import Darcs.Global ( darcsdir )
> import Darcs.Patch ( RealPatch, Patch, Named, showPatch, patch2patchinfo, fromPrims, infopatch,
> modernize_patch,
> hunk ./src/Darcs/Commands/Convert.lhs 211
> putVerbose $ text ("Making executable: " ++ f)
> setExecutable f True
> mapM_ setExecutableIfScript c
> - sync_repo repository
> optimizeInventory repository
> putInfo $ text "Finished converting."
> where am_verbose = Verbose `elem` orig_opts
> hunk ./src/Darcs/Commands/Get.lhs 43
> createPristineDirectoryTree,
> tentativelyRemovePatches, patchSetToPatches, patchSetToRepository,
> copyRepository, tentativelyAddToPending,
> - finalizeRepositoryChanges, sync_repo, setScriptsExecutable )
> + finalizeRepositoryChanges, setScriptsExecutable )
> import Darcs.Repository.Format ( identifyRepoFormat, RepoFormat,
> RepoProperty ( Darcs2, HashedInventory ), format_has )
> import Darcs.Repository.DarcsRepo ( write_inventory )
> hunk ./src/Darcs/Commands/Get.lhs 286
> finalizeRepositoryChanges repository
> apply opts (invert $ effect ps) `catch` \e ->
> fail ("Couldn't undo patch in working dir.\n" ++ show e)
> - sync_repo repository
>
>
> get_help_partial :: String
> hunk ./src/Darcs/Commands/Get.lhs 342
> pristine <- identifyPristine
> createPristineFromWorking pristine
> setCurrentDirectory myname
> - debugMessage "Syncing the repository..."
> - sync_repo repository
> - debugMessage "Repository synced."
>
> \end{code}
> hunk ./src/Darcs/Commands/MarkConflicts.lhs 32
> import Darcs.Arguments ( DarcsFlag, ignoretimes, working_repo_dir, umask_option )
> import Darcs.Repository ( withRepoLock, ($-), amInRepository, add_to_pending,
> applyToWorking,
> - read_repo, sync_repo,
> + read_repo,
> )
> import Darcs.Patch ( invert )
> import Darcs.Ordered ( FL(..) )
> hunk ./src/Darcs/Commands/MarkConflicts.lhs 96
> when (yorn /= 'y') $ exitWith ExitSuccess
> applyToWorking repository opts (invert pend) `catch` \e ->
> bug ("Can't undo pending changes!" ++ show e)
> - sync_repo repository
> withSignalsBlocked $
> do add_to_pending repository res
> applyToWorking repository opts res `catch` \e ->
> hunk ./src/Darcs/Commands/Pull.lhs 45
> )
> import Darcs.Repository ( Repository, SealedPatchSet, identifyRepositoryFor, withGutsOf,
> amInRepository, withRepoLock, ($-), tentativelyMergePatches,
> - sync_repo, finalizeRepositoryChanges, applyToWorking,
> + finalizeRepositoryChanges, applyToWorking,
> read_repo, checkUnrelatedRepos )
> import Darcs.Hopefully ( info )
> import Darcs.Patch ( RepoPatch, description )
> hunk ./src/Darcs/Commands/Pull.lhs 162
> -- so work will be more recent than rec:
> revertable $ do wait_a_moment
> applyToWorking repository opts pw
> - sync_repo repository
> putInfo $ text "Finished pulling and applying."
> where revertable x = x `clarify_errors` unlines
> ["Error applying patch to the working directory.","",
> hunk ./src/Darcs/Commands/Record.lhs 37
> import Darcs.Hopefully ( info, n2pia )
> import Darcs.Repository ( Repository, amInRepository, withRepoLock, ($-),
> withGutsOf,
> - sync_repo, read_repo,
> + read_repo,
> slurp_recorded,
> tentativelyAddPatch, finalizeRepositoryChanges,
> )
> hunk ./src/Darcs/Commands/Record.lhs 228
> withGutsOf repository (finalizeRepositoryChanges repository)
> `clarify_errors` failuremessage
> debugMessage "Syncing timestamps..."
> - sync_repo repository
> when (isJust logf) $ removeFile (fromJust logf)
> logMessage $ "Finished recording patch '"++name++"'"
> where (logMessage,_,_) = loggers opts
> hunk ./src/Darcs/Commands/Revert.lhs 36
> import Darcs.Utils ( askUser )
> import Darcs.RepoPath ( toFilePath, sp2fn )
> import Darcs.Repository ( withRepoLock, ($-), withGutsOf,
> - add_to_pending, sync_repo,
> + add_to_pending,
> applyToWorking,
> amInRepository, slurp_recorded,
> )
> hunk ./src/Darcs/Commands/Revert.lhs 111
> when (Debug `elem` opts) $ putStrLn "About to apply to the working directory."
> applyToWorking repository opts (invert p) `catch` \e ->
> fail ("Unable to apply inverse patch!" ++ show e)
> - sync_repo repository
> putStrLn "Finished reverting."
> \end{code}
>
> hunk ./src/Darcs/Commands/Rollback.lhs 43
> import Darcs.Repository ( amInRepository, withRepoLock, ($-), applyToWorking,
> read_repo, slurp_recorded,
> tentativelyMergePatches, withGutsOf,
> - finalizeRepositoryChanges, sync_repo )
> + finalizeRepositoryChanges )
> import Darcs.Patch ( summary, invert, namepatch, effect, fromPrims,
> sort_coalesceFL, canonize )
> import Darcs.Ordered
> hunk ./src/Darcs/Commands/Rollback.lhs 151
> revertable $ do wait_a_moment
> applyToWorking repository opts pw
> when (isJust logf) $ removeFile (fromJust logf)
> - sync_repo repository
> logMessage $ "Finished rolling back."
> where revertable x = x `clarify_errors` unlines
> ["Error applying patch to the working directory.","",
> hunk ./src/Darcs/Commands/Unrecord.lhs 43
> tentativelyAddToPending,
> applyToWorking,
> read_repo, amInRepository,
> - sync_repo,
> )
> import Darcs.Patch ( Patchy, RepoPatch, invert, commutex, effect )
> import Darcs.Ordered ( RL(..), (:<)(..), (:>)(..), (:\/:)(..), (+<+),
> hunk ./src/Darcs/Commands/Unrecord.lhs 170
> withGutsOf repository $ do tentativelyRemovePatches repository opts $
> mapFL_FL hopefully to_unrecord
> finalizeRepositoryChanges repository
> - sync_repo repository
> logMessage "Finished unrecording."
>
> get_last_patches :: RepoPatch p => [DarcsFlag] -> PatchSet p C(r)
> hunk ./src/Darcs/Commands/Unrecord.lhs 312
> debugMessage "Applying patches to working directory..."
> applyToWorking repository opts (invert p_after_pending) `catch` \e ->
> fail ("Couldn't undo patch in working dir.\n" ++ show e)
> - sync_repo repository
> logMessage $ "Finished " ++ present_participle cmdname ++ "."
>
> matchingHead :: Patchy p => [DarcsFlag] -> PatchSet p C(r) -> FlippedSeal (RL (PatchInfoAnd p)) C(r)
> hunk ./src/Darcs/Commands/Unrevert.lhs 36
> import Darcs.Repository ( SealedPatchSet, Repository, withRepoLock, ($-),
> unrevertUrl, considerMergeToWorking,
> tentativelyAddToPending, finalizeRepositoryChanges,
> - sync_repo,
> read_repo, amInRepository,
> slurp_recorded,
> applyToWorking )
> hunk ./src/Darcs/Commands/Unrevert.lhs 105
> ++ show e)
> debugMessage "I'm about to write_unrevert."
> write_unrevert repository skipped rec (unrec+>+p)
> - sync_repo repository
> debugMessage "Finished unreverting."
> _ -> impossible
> unrevert_cmd _ _ = impossible
> hunk ./src/Darcs/Repository.hs 33
> slurp_pending, replacePristine,
> slurp_recorded, slurp_recorded_and_unrecorded,
> withRecorded,
> - read_repo, sync_repo,
> + read_repo,
> prefsUrl,
> add_to_pending,
> tentativelyAddPatch, tentativelyRemovePatches, tentativelyAddToPending,
> hunk ./src/Darcs/Repository.hs 63
> slurp_pending, replacePristineFromSlurpy,
> slurp_recorded, slurp_recorded_and_unrecorded,
> withRecorded,
> - read_repo, sync_repo,
> + read_repo,
> prefsUrl,
> withRepoLock, withRepoReadLock, withRepository, withRepositoryDirectory, withGutsOf,
> tentativelyAddPatch, tentativelyRemovePatches, tentativelyAddToPending,
> hunk ./src/Darcs/Repository/HashedIO.hs 23
> #include "gadts.h"
>
> module Darcs.Repository.HashedIO ( HashedIO, applyHashed,
> - copyHashed, syncHashedPristine, copyPartialsHashed, listHashedContents,
> + copyHashed, copyPartialsHashed, listHashedContents,
> slurpHashedPristine, writeHashedPristine,
> clean_hashdir ) where
>
> hunk ./src/Darcs/Repository/HashedIO.hs 334
> grab _ (Slurpy _ (SlurpFile _ _)) = Nothing
> grab fn (Slurpy _ (SlurpDir _ ss)) = fmap (Slurpy fn) $ Map.lookup fn ss
>
> --- | Update timestamps on pristine files to match those in the working directory
> --- (which is passed to this function in form of a Slurpy). It needed for the
> --- mtime-based unsafeDiff optimisation to work efficiently.
> -syncHashedPristine :: Cache -> Slurpy -> String -> IO ()
> -syncHashedPristine c s r = do runStateT sh $ HashDir { permissions=RW, cache=c,
> - compress=compression [], rootHash=r }
> - return ()
> - where sh = do cc <- readroot
> - lift $ tediousSize k (length cc)
> - mapM_ sh' cc
> - sh' (D,n,h) = case progress k $ grab n s of
> - Just s' -> lift $ syncHashedPristine c s' h
> - Nothing -> return ()
> - sh' (F,n,h) = case progress k $ grab n s of
> - Just (Slurpy _ (SlurpFile (_,t',l) x)) ->
> - do t <- lift $ findFileMtimeUsingCache c HashedPristineDir h
> - when (t' /= undefined_time && t' /= t) $
> - do ps <- readhash h
> - when (B.length ps == fromIntegral l && ps == x) $
> - lift $ setFileMtimeUsingCache c HashedPristineDir h t'
> - _ -> return ()
> - k = "Synchronizing pristine"
> -
> copyHashed :: String -> Cache -> Compression -> String -> IO ()
> copyHashed k c compr z = do runStateT cph $ HashDir { permissions = RO, cache = c,
> compress = compr, rootHash = z }
> hunk ./src/Darcs/Repository/HashedRepo.hs 23
> #include "gadts.h"
>
> module Darcs.Repository.HashedRepo ( revert_tentative_changes, finalize_tentative_changes,
> - slurp_pristine, sync_repo, clean_pristine,
> + slurp_pristine, clean_pristine,
> copy_pristine, copy_partials_pristine, pristine_from_working,
> apply_to_tentative_pristine,
> replacePristineFromSlurpy,
> hunk ./src/Darcs/Repository/HashedRepo.hs 48
> unionCaches, repo2cache, okayHash, takeHash,
> HashedDir(..), hashedDir )
> import Darcs.Repository.HashedIO ( applyHashed, slurpHashedPristine,
> - copyHashed, syncHashedPristine, copyPartialsHashed,
> + copyHashed, copyPartialsHashed,
> writeHashedPristine, clean_hashdir )
> import Darcs.Repository.InternalTypes ( Repository(..), extractCache )
> import Darcs.Hopefully ( PatchInfoAnd, patchInfoAndPatch, n2pia, info,
> hunk ./src/Darcs/Repository/HashedRepo.hs 362
> copyHashed k c compr $ inv2pris i
> endTedious k
>
> -sync_repo :: Cache -> IO ()
> -sync_repo c = do i <- B.readFile $ darcsdir++"/hashed_inventory"
> - s <- slurp_all_but_darcs "."
> - beginTedious "Synchronizing pristine"
> - syncHashedPristine c s $ inv2pris i
> -
> -
> copy_partials_pristine :: FilePathLike fp =>
> Cache -> Compression -> String -> String -> [fp] -> IO ()
> copy_partials_pristine c compr d iname fps =
> hunk ./src/Darcs/Repository/Internal.hs 32
> read_pending, announce_merge_conflicts, setTentativePending,
> check_unrecorded_conflicts,
> withRecorded,
> - read_repo, sync_repo,
> + read_repo,
> prefsUrl, makePatchLazy,
> withRepoLock, withRepoReadLock,
> withRepository, withRepositoryDirectory, withGutsOf,
> hunk ./src/Darcs/Repository/Internal.hs 93
> import Darcs.Repository.ApplyPatches ( apply_patches )
> import qualified Darcs.Repository.HashedRepo as HashedRepo
> ( revert_tentative_changes, finalize_tentative_changes,
> - remove_from_tentative_inventory, sync_repo,
> + remove_from_tentative_inventory,
> copy_pristine, copy_partials_pristine, slurp_pristine,
> apply_to_tentative_pristine, pristine_from_working,
> write_tentative_inventory, write_and_read_patch,
> hunk ./src/Darcs/Repository/Internal.hs 403
> | format_has HashedInventory rf = withCurrentDirectory r $ HashedRepo.write_and_read_patch c (compression opts) p
> | otherwise = withCurrentDirectory r $ DarcsRepo.write_and_read_patch opts p
>
> -sync_repo :: Repository p C(r u t) -> IO ()
> -sync_repo (Repo r _ rf (DarcsRepository _ c))
> - | format_has HashedInventory rf = withCurrentDirectory r $ HashedRepo.sync_repo c
> -sync_repo (Repo r _ _ (DarcsRepository p _)) = withCurrentDirectory r $ syncPristine p
> -
> prefsUrl :: Repository p C(r u t) -> String
> prefsUrl (Repo r _ _ (DarcsRepository _ _)) = r ++ "/"++darcsdir++"/prefs"
>
Obliterate timestamp manipulation in HashedIO.
----------------------------------------------
> Petr Rockai <me at mornfall.net>**20090720165836
> Ignore-this: b98311e3ec5ca2d88d251ff2afe67b31
> ] hunk ./src/Darcs/Repository/Cache.hs 12
> HashedDir(..), hashedDir,
> unionCaches, cleanCaches, cleanCachesWithHint,
> fetchFileUsingCache, speculateFileUsingCache, writeFileUsingCache,
> - findFileMtimeUsingCache, setFileMtimeUsingCache, peekInCache,
> + peekInCache,
> repo2cache,
> writable, isthisrepo, hashedFilePath, allHashedDirs
> ) where
> hunk ./src/Darcs/Repository/Cache.hs 101
> | otherwise = False
>
>
> -findFileMtimeUsingCache :: Cache -> HashedDir -> String -> IO EpochTime
> -findFileMtimeUsingCache (Ca cache) subdir f = mt cache
> - where mt [] = return undefined_time
> - mt (Cache Repo Writable r:_) = (modificationTime `fmap`
> - getSymbolicLinkStatus (r++"/"++darcsdir++"/"++(hashedDir subdir)++"/"++f))
> - `catchall` return undefined_time
> - mt (_:cs) = mt cs
> -
> -setFileMtimeUsingCache :: Cache -> HashedDir -> String -> EpochTime -> IO ()
> -setFileMtimeUsingCache (Ca cache) subdir f t = st cache
> - where st [] = return ()
> - st (Cache Repo Writable r:_) = setFileTimes (r++"/"++darcsdir++"/"++(hashedDir subdir)++"/"++f) t t
> - `catchall` return ()
> - st (_:cs) = st cs
> -
> fetchFileUsingCache :: Cache -> HashedDir -> String -> IO (String, B.ByteString)
> fetchFileUsingCache = fetchFileUsingCachePrivate Anywhere
>
> hunk ./src/Darcs/Repository/HashedIO.hs 41
> import Darcs.SlurpDirectory ( withSlurpy, undefined_time, undefined_size )
> import Darcs.Repository.Cache ( Cache, fetchFileUsingCache, writeFileUsingCache,
> peekInCache, speculateFileUsingCache,
> - findFileMtimeUsingCache, setFileMtimeUsingCache,
> okayHash, cleanCachesWithHint, HashedDir(..), hashedDir )
> import Darcs.Patch ( Patchy, apply )
> import Darcs.RepoPath ( FilePathLike, toFilePath )
> hunk ./src/Darcs/Repository/HashedIO.hs 193
> readTediousHash k h = do lift $ finishedOneIO k h
> readhash h
>
> -gethashmtime :: String -> HashedIO r p EpochTime
> -gethashmtime h = do HashDir _ c _ _ <- get
> - lift $ unsafeInterleaveIO $ findFileMtimeUsingCache c HashedPristineDir h
> -
> withh :: String -> HashedIO RW p a -> HashedIO RW p (String,a)
> withh h j = do hd <- get
> put $ hd { rootHash = h }
> hunk ./src/Darcs/Repository/HashedIO.hs 284
> lift $ beginTedious k
> safeInterleave $ (Slurpy rootdir . SlurpDir (Just hroot) . slurpies_to_map) `fmap` mapM sl c
> where sl (F,n,h) = do ps <- safeInterleave $ readTediousHash k h
> - t <- gethashmtime h
> let len = if length h == 75 then read (take 10 h)
> else undefined_size
> hunk ./src/Darcs/Repository/HashedIO.hs 286
> - return $ Slurpy n $ SlurpFile (Just h, t, len) ps
> + return $ Slurpy n $ SlurpFile (Just h, 0, len) ps
> sl (D,n,h) = inh h $ do c <- readroot
> lift $ tediousSize k (length c)
> lift $ finishedOneIO k h
>
--
Eric Kow <http://www.nltg.brighton.ac.uk/home/Eric.Kow>
PGP Key ID: 08AC04F9
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 197 bytes
Desc: Digital signature
URL: <http://lists.osuosl.org/pipermail/darcs-users/attachments/20090722/dfa9a5ed/attachment-0001.pgp>
More information about the darcs-users
mailing list