The main reason for this change is the amend-record.pl patch, which for
some reason depends on the other...
Sat Jul 15 17:43:58 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* carry RepoFormat around a bit more.
Sun Jul 30 06:38:54 EDT 2006 David Roundy <[EMAIL PROTECTED]>
* make amend-record.pl test a bit pickier.
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
New patches:
[carry RepoFormat around a bit more.
David Roundy <[EMAIL PROTECTED]>**20060715214358]
<
> {
hunk ./AmendRecord.lhs 24
import Monad ( when, liftM )
import SignalHandler ( withSignalsBlocked )
- -import Repository ( PatchSet,
+import Repository ( PatchSet, read_repo,
withRepoLock, get_unrecorded, slurp_recorded,
with_new_pending, sync_repo,
)
hunk ./AmendRecord.lhs 28
- -import DarcsRepo ( read_repo,
- - add_to_inventory, write_patch,
+import DarcsRepo ( add_to_inventory, write_patch,
am_in_repo, write_inventory,
)
import Pristine ( identifyPristine, applyPristine )
hunk ./AmendRecord.lhs 137
applyPristine pris (join_patches chs) `catch`
\e -> fail ("Bizarre error in amend-recording:\n" ++ show e)
sequence_ $ map (write_patch opts) skipped
- - patches' <- read_repo "."
+ patches' <- read_repo repository
write_inventory "." $ rempatch oldp patches'
add_to_inventory "."
[(fromJust $ patch2patchinfo newp)]
hunk ./Annotate.lhs 34
match_one,
)
import SlurpDirectory ( slurp )
- -import Repository ( PatchSet )
- -import DarcsRepo ( am_in_repo, read_repo, get_markedup_file )
+import Repository ( PatchSet, identifyRepository, read_repo )
+import RepoFormat ( RepoFormat, identifyRepoFormat )
+import DarcsRepo ( am_in_repo, get_markedup_file )
import Patch ( LineMark(..), patch2patchinfo,
patch_summary, xml_summary,
)
hunk ./Annotate.lhs 116
when (not $ have_nonrange_match opts) $
fail $ "Annotate requires either a patch pattern or a " ++
"file or directory argument."
- - p <- match_patch opts `liftM` read_repo "."
+ p <- match_patch opts `liftM` (identifyRepository "." >>= read_repo)
repodir <- getCurrentDirectory
if Summary `elem` opts
then do putDocLn $ showpi $ fromJust $ patch2patchinfo p
hunk ./Annotate.lhs 152
details of the patches involved in the specified tagged version will be output.
\begin{code}
annotate_cmd opts [EMAIL PROTECTED] = do
- - r <- read_repo "."
+ r <- identifyRepository "." >>= read_repo
(rel_file_or_directory:_) <- fix_filepaths_wrt "." opts args
let file_or_directory = fn2fp $ norm_path $ fp2fn rel_file_or_directory
pinfo <- if have_nonrange_match opts
hunk ./Annotate.lhs 181
errorDoc $ text ("The file '" ++ rel_file_or_directory ++
"' was removed by")
$$ human_friendly (modifiedByI i)
- - | otherwise -> annotate_file opts pinfo file_or_directory pt
+ | otherwise -> do rf <- identifyRepoFormat "."
+ annotate_file rf opts pinfo file_or_directory pt
\end{code}
\begin{code}
hunk ./Annotate.lhs 294
with markup indicating patch details when each line was last (and perhaps next) modified.
\begin{code}
- -annotate_file :: [DarcsFlag] -> PatchInfo -> FilePath -> PopTree -> IO ()
- -annotate_file opts pinfo f (PopFile info) = do
+annotate_file :: RepoFormat -> [DarcsFlag] -> PatchInfo -> FilePath -> PopTree -> IO ()
+annotate_file rf opts pinfo f (PopFile info) = do
if XMLOutput `elem` opts
then putDocLn $ p2xml_open pinfo (PopFile info)
else if createdByI info /= Nothing
hunk ./Annotate.lhs 302
then putAnn $ text ("File "++f++" created by ")
<> showPatchInfo ci <> text (" as " ++ createdname)
else putAnn $ text $ "File "++f
- - mk <- get_markedup_file ci createdname
- - old_pis <- (dropWhile (/= pinfo).map fst.concat) `liftM` read_repo "."
+ mk <- get_markedup_file rf ci createdname
+ old_pis <- (dropWhile (/= pinfo).map fst.concat) `liftM`
+ (identifyRepository "." >>= read_repo)
sequence_ $ map (annotate_markedup opts pinfo old_pis) mk
when (XMLOutput `elem` opts) $ putDocLn $ p2xml_close pinfo (PopFile info)
where ci = fromJust $ createdByI info
hunk ./Annotate.lhs 309
createdname = unpackPS $ fromJust $ creationNameI info
- -annotate_file _ _ _ _ = impossible
+annotate_file _ _ _ _ _ = impossible
annotate_markedup :: [DarcsFlag] -> PatchInfo -> [PatchInfo]
-> (PackedString, LineMark) -> IO ()
hunk ./Check.lhs 31
partial_check, any_verbosity, notest,
leave_test_dir, working_repo_dir,
)
- -import DarcsRepo ( am_in_repo, read_repo, get_checkpoint_by_default,
+import Repository ( identifyRepository, read_repo )
+import RepoFormat ( identifyRepoFormat )
+import DarcsRepo ( am_in_repo, get_checkpoint_by_default,
apply_patches_with_feedback, lazily_read_repo,
simple_feedback
)
hunk ./Check.lhs 102
let putVerbose s = when (Verbose `elem` opts) $ putDocLn s
putInfo s = when (not $ Quiet `elem` opts) $ putDocLn s
in do
+ rf <- identifyRepoFormat "."
check_uniqueness putVerbose putInfo
hunk ./Check.lhs 104
- - patches <- lazily_read_repo "."
+ patches <- lazily_read_repo rf "."
maybe_chk <- get_checkpoint_by_default opts "."
ftf <- filetype_function
cwd <- getCurrentDirectory
hunk ./Check.lhs 159
check_uniqueness :: (Doc -> IO ()) -> (Doc -> IO ()) -> IO ()
check_uniqueness putVerbose putInfo =
do putVerbose $ text "Checking that patch names are unique..."
- - r <- read_repo "."
+ r <- identifyRepository "." >>= read_repo
case has_duplicate $ map fst $ concat r of
Nothing -> return ()
Just pinf -> do putInfo $ text "Error! Duplicate patch name:"
hunk ./DarcsRepo.lhs 69
seekRepo, youNeedToBeInRepo
) where
+import RepoFormat ( RepoFormat )
import Directory ( setCurrentDirectory, doesFileExist,
doesDirectoryExist )
import Workaround ( getCurrentDirectory, renameFile, createDirectoryIfMissing )
hunk ./DarcsRepo.lhs 253
\end{code}
\begin{code}
- -createPristineDirectoryTree :: Pristine -> FilePath -> IO ()
- -createPristineDirectoryTree pris fp
+createPristineDirectoryTree :: RepoFormat -> Pristine -> FilePath -> IO ()
+createPristineDirectoryTree rf pris fp
= do done <- easyCreatePristineDirectoryTree pris fp
unless done $ do
hunk ./DarcsRepo.lhs 257
- - patches <- get_whole_repo_patches
+ patches <- get_whole_repo_patches rf
createDirectoryIfMissing True fp
withCurrentDirectory fp $
apply_patches [] False noPut noPut patches
hunk ./DarcsRepo.lhs 263
where noPut _ = return ()
- -createPartialsPristineDirectoryTree :: [FilePath] -> Pristine -> FilePath
+createPartialsPristineDirectoryTree :: RepoFormat -> [FilePath] -> Pristine -> FilePath
-> IO ()
hunk ./DarcsRepo.lhs 265
- -createPartialsPristineDirectoryTree prefs pris fp
+createPartialsPristineDirectoryTree rf prefs pris fp
= do done <- easyCreatePartialsPristineDirectoryTree prefs pris fp
hunk ./DarcsRepo.lhs 267
- - unless done $ withRecorded (withTempDir "recorded") $ \_ -> do
+ unless done $ withRecorded rf (withTempDir "recorded") $ \_ -> do
clonePartialsTree "." fp prefs
hunk ./DarcsRepo.lhs 270
- -withRecorded :: ((FilePath -> IO a) -> IO a) -> (FilePath -> IO a) -> IO a
- -withRecorded mk_dir f
+withRecorded :: RepoFormat -> ((FilePath -> IO a) -> IO a) -> (FilePath -> IO a) -> IO a
+withRecorded rf mk_dir f
= do dir <- getCurrentDirectory
mk_dir $ \d -> do
withCurrentDirectory dir $ do
hunk ./DarcsRepo.lhs 276
pris <- identifyPristine
- - createPristineDirectoryTree pris d
+ createPristineDirectoryTree rf pris d
f d
hunk ./DarcsRepo.lhs 279
- -get_whole_repo_patches :: IO [(PatchInfo, Maybe Patch)]
- -get_whole_repo_patches = do
- - patches <- read_repo "."
+get_whole_repo_patches :: RepoFormat -> IO [(PatchInfo, Maybe Patch)]
+get_whole_repo_patches rf = do
+ patches <- read_repo rf "."
maybe_chk <- get_checkpoint_by_default [] "."
return $ case maybe_chk of
Just chk ->
hunk ./DarcsRepo.lhs 290
in (chtg, Just chk):reverse rest
Nothing -> reverse $ concat patches
- -surely_slurp_Pristine :: Pristine -> IO Slurpy
- -surely_slurp_Pristine pristine = do
+surely_slurp_Pristine :: RepoFormat -> Pristine -> IO Slurpy
+surely_slurp_Pristine rf pristine = do
mc <- slurpPristine pristine
case mc of
(Just slurpy) -> return slurpy
hunk ./DarcsRepo.lhs 296
Nothing -> do
- - patches <- get_whole_repo_patches
+ patches <- get_whole_repo_patches rf
withDelayedDir "pristine.temp" $ \cd -> do
apply_patches [] False noPut noPut patches
mmap_slurp cd
hunk ./DarcsRepo.lhs 305
sync_repo :: Pristine -> IO ()
sync_repo cur = syncPristine cur
- -slurp_recorded :: FilePath -> IO Slurpy
- -slurp_recorded d = withCurrentDirectory d $
- - identifyPristine >>= surely_slurp_Pristine
+slurp_recorded :: RepoFormat -> FilePath -> IO Slurpy
+slurp_recorded rf d = withCurrentDirectory d $
+ identifyPristine >>= surely_slurp_Pristine rf
slurp_all_but_darcs :: FilePath -> IO Slurpy
slurp_all_but_darcs d = do s <- slurp d
hunk ./DarcsRepo.lhs 320
\end{comment}
\begin{code}
- -slurp_recorded_and_unrecorded :: FilePath -> IO (Slurpy, Slurpy)
- -slurp_recorded_and_unrecorded d = withCurrentDirectory d $ do
- - cur <- identifyPristine >>= surely_slurp_Pristine
+slurp_recorded_and_unrecorded :: RepoFormat -> FilePath -> IO (Slurpy, Slurpy)
+slurp_recorded_and_unrecorded rf d = withCurrentDirectory d $ do
+ cur <- identifyPristine >>= surely_slurp_Pristine rf
mbpend <- read_pending "_darcs/patches/pending"
case mbpend of
Just pend ->
hunk ./DarcsRepo.lhs 374
\end{code}
\begin{code}
- -copy_repo_patches :: [DarcsFlag] -> FilePath -> FilePath -> IO ()
- -copy_repo_patches opts dir out = do
+copy_repo_patches :: RepoFormat -> [DarcsFlag] -> FilePath -> FilePath -> IO ()
+copy_repo_patches rf opts dir out = do
realdir <- absolute_dir dir
hunk ./DarcsRepo.lhs 377
- - patches <- read_repo "."
+ patches <- read_repo rf "."
mpi <- if Partial `elem` opts
then do cps <- read_checkpoints realdir
case cps of
hunk ./DarcsRepo.lhs 400
| otherwise = (pinfo, mp) : since_checkpoint (Just ch) ps
since_checkpoint _ [] = []
- -read_repo :: String -> IO PatchSet
- -read_repo d = do
+read_repo :: RepoFormat -> String -> IO PatchSet
+read_repo _ d = do
realdir <- absolute_dir d
read_repo_private False realdir "inventory" `catch`
(\e -> do hPutStrLn stderr ("Invalid repository: " ++ realdir)
hunk ./DarcsRepo.lhs 407
ioError e)
- -lazily_read_repo :: String -> IO PatchSet
- -lazily_read_repo d = do
+lazily_read_repo :: RepoFormat -> String -> IO PatchSet
+lazily_read_repo _ d = do
realdir <- absolute_dir d
read_repo_private True realdir "inventory" `catch`
(\e -> do hPutStrLn stderr ("Invalid repository: " ++ realdir)
hunk ./DarcsRepo.lhs 513
format_inv (pinfo:ps) = showPatchInfo pinfo
$$ format_inv ps
- -write_recorded_checkpoint :: PatchInfo -> IO ()
- -write_recorded_checkpoint pinfo = do
- - ps <- (map (fromJust.snd).reverse.concat) `liftM` read_repo "."
+write_recorded_checkpoint :: RepoFormat -> PatchInfo -> IO ()
+write_recorded_checkpoint rf pinfo = do
+ ps <- (map (fromJust.snd).reverse.concat) `liftM` read_repo rf "."
ftf <- filetype_function
hunk ./DarcsRepo.lhs 517
- - s <- slurp_recorded "."
+ s <- slurp_recorded rf "."
write_checkpoint_patch $ infopatch pinfo $ join_patches $ changepps ps ++
maybeToList (smart_diff [LookForAdds] ftf empty_slurpy s)
where changeps p = filter is_setpref $ flatten_to_primitives p
hunk ./DarcsRepo.lhs 523
changepps ps = concat $ map changeps $ ps
- -write_checkpoint :: PatchInfo -> IO ()
- -write_checkpoint pinfo = do
+write_checkpoint :: RepoFormat -> PatchInfo -> IO ()
+write_checkpoint rf pinfo = do
repodir <- getCurrentDirectory
ps <- (reverse.map (fromJust.snd).concat.get_patches_in_tag pinfo)
hunk ./DarcsRepo.lhs 527
- - `liftM` read_repo "."
+ `liftM` read_repo rf "."
ftf <- filetype_function
hunk ./DarcsRepo.lhs 529
- - with_tag pinfo $ do
+ with_tag rf pinfo $ do
s <- mmap_slurp "."
setCurrentDirectory repodir
write_checkpoint_patch $ infopatch pinfo $ join_patches $ changepps ps ++
hunk ./DarcsRepo.lhs 548
$ format_inv $ reverse $ pinfo:cpi
Nothing -> bug "bad patch in write_checkpoint_patch"
- -with_tag :: PatchInfo -> (IO ()) -> IO ()
- -with_tag pinfo job = do
- - ps <- read_repo "."
+with_tag :: RepoFormat -> PatchInfo -> (IO ()) -> IO ()
+with_tag rf pinfo job = do
+ ps <- read_repo rf "."
case get_patches_beyond_tag pinfo ps of
hunk ./DarcsRepo.lhs 552
- - [extras] -> withRecorded (withTempDir "checkpoint") $ \_ -> do
+ [extras] -> withRecorded rf (withTempDir "checkpoint") $ \_ -> do
apply_patches [] False noPut noPut $ map invert_it extras
job
_ -> bug "with_tag"
hunk ./DarcsRepo.lhs 573
revisions ever made on a given file.
\begin{code}
- -get_markedup_file :: PatchInfo -> FilePath -> IO MarkedUpFile
- -get_markedup_file pinfo f = do
+get_markedup_file :: RepoFormat -> PatchInfo -> FilePath -> IO MarkedUpFile
+get_markedup_file rf pinfo f = do
patches <- liftM (dropWhile (\ (pi',_)-> pi' /= pinfo)
hunk ./DarcsRepo.lhs 576
- - . reverse . concat) $ read_repo "."
+ . reverse . concat) $ read_repo rf "."
return $ snd $ do_mark_all patches (f, empty_markedup_file)
do_mark_all :: [(PatchInfo, Maybe Patch)]
-> (FilePath, MarkedUpFile) -> (FilePath, MarkedUpFile)
hunk ./DiffCommand.lhs 38
match_first_patchset, match_second_patchset,
)
import Repository ( PatchSet )
+import RepoFormat ( identifyRepoFormat )
import DarcsRepo ( read_repo, am_in_repo,
createPartialsPristineDirectoryTree,
slurp_recorded_and_unrecorded
hunk ./DiffCommand.lhs 173
diff_cmd :: [DarcsFlag] -> [String] -> IO ()
diff_cmd opts args = do
formerdir <- getCurrentDirectory
+ rf <- identifyRepoFormat "."
thename <- return $ just_dir formerdir
withTempDir ("old-"++thename) $ \odir -> do
setCurrentDirectory formerdir
hunk ./DiffCommand.lhs 182
then withCurrentDirectory odir $ get_first_match formerdir opts
else withCurrentDirectory formerdir $
do pris <- identifyPristine
- - createPartialsPristineDirectoryTree path_list pris odir
+ createPartialsPristineDirectoryTree rf path_list pris odir
if second_match opts
then withCurrentDirectory ndir $ get_second_match formerdir opts
hunk ./DiffCommand.lhs 185
- - else do (_, s) <- slurp_recorded_and_unrecorded formerdir
+ else do (_, s) <- slurp_recorded_and_unrecorded rf formerdir
let ps = concatMap (get_path_list s) path_list
clonePaths formerdir ndir ps
thediff <- withCurrentDirectory (odir ++ "/..") $
hunk ./DiffCommand.lhs 194
fs -> vcat `liftM` mapM (\f -> rundiff
(just_dir odir ++ "/" ++ f)
(just_dir ndir ++ "/" ++ f)) fs
- - morepatches <- read_repo formerdir
+ morepatches <- read_repo rf formerdir
putDocLn $ changelog (get_diff_info opts morepatches)
$$ thediff
where just_dir d = reverse $ takeWhile (/='/') $ reverse d
hunk ./Dist.lhs 27
import DarcsCommands
import DarcsArguments
import Repository ( amInRepository, withRepoLock )
+import RepoFormat ( identifyRepoFormat )
import DarcsRepo
import RepoPrefs ( get_prefval )
import Lock ( withTemp, withTempDir, readBinFile )
hunk ./Dist.lhs 87
verb <- return $ Verbose `elem` opts
predist <- get_prefval "predist"
formerdir <- getCurrentDirectory
+ rf <- identifyRepoFormat "."
withTemp $ \tarfile ->
withTempDir "darcsdist" $ \tempdir -> do
setCurrentDirectory (formerdir)
hunk ./Dist.lhs 91
- - withRecorded (withTempDir (tempdir++"/"++dn)) $ \ddir -> do
+ withRecorded rf (withTempDir (tempdir++"/"++dn)) $ \ddir -> do
case predist of Nothing -> return ExitSuccess
Just pd -> system pd
setCurrentDirectory (tempdir)
hunk ./Get.lhs 34
match_one_context, set_default, set_scripts_executable,
disable_ssh_cm,
pristine_tree, working_repo_dir )
+import RepoFormat ( RepoFormat, identifyRepoFormat, show_repo_format )
import DarcsRepo ( lazily_read_repo, write_inventory,
write_checkpoint_patch,
absolute_dir, get_checkpoint,
hunk ./Get.lhs 56
import Printer ( text, vcat, errorDoc, ($$), Doc, putDocLn, )
import SlurpDirectory ( list_slurpy_files )
import Workaround ( setExecutable )
+import Lock ( writeBinFile )
import Unrecord ( rempatch )
import Repository ( patchSetToPatches )
#include "impossible.h"
hunk ./Get.lhs 121
fix_context [] = []
repodir <- absolute_dir inrepodir
show_motd opts repodir
- - patches <- lazily_read_repo repodir -- laziness doesn't matter here...
+ rf <- identifyRepoFormat repodir
+ patches <- lazily_read_repo rf repodir -- laziness doesn't matter here...
when (Partial `elem` opts) $ putVerbose $ text "Reading checkpoint..."
mch <- get_checkpoint opts repodir
mysimplename <- make_repo_name opts repodir
hunk ./Get.lhs 136
createDirectory "_darcs/prefs"
write_default_prefs
set_defaultrepo repodir opts
+ writeBinFile "_darcs/format" (show_repo_format rf)
putVerbose $ text "Getting the inventory..."
write_inventory "." patches
putVerbose $ text "Copying patches..."
hunk ./Get.lhs 140
- - copy_repo_patches opts repodir "."
+ copy_repo_patches rf opts repodir "."
putVerbose $ text "Patches copied"
hunk ./Get.lhs 142
- - local_patches <- lazily_read_repo "."
+ local_patches <- lazily_read_repo rf "."
putVerbose $ text "Repo lazily read"
repo_is_local <- doesDirectoryExist repodir
putVerbose $ text $ "Repo local: " ++ formatPath (show repo_is_local)
hunk ./Get.lhs 155
putVerbose $ text "Writing working directory"
withCurrentDirectory repodir $ do
pris <- identifyPristine
- - createPristineDirectoryTree pris myname
+ createPristineDirectoryTree rf pris myname
withCurrentDirectory myname $ do
-- note: SetScriptsExecutable is normally checked in PatchApply
-- but darcs get on local repositories does not apply patches
hunk ./Get.lhs 191
setCurrentDirectory myname
sync_repo pristine
putVerbose $ text "Repository synced, going to chosen version..."
- - go_to_chosen_version putVerbose putInfo opts
+ go_to_chosen_version rf putVerbose putInfo opts
putInfo $ text "Finished getting."
where am_verbose = Verbose `elem` orig_opts
am_informative = not $ Quiet `elem` orig_opts
hunk ./Get.lhs 258
file.
\begin{code}
- -go_to_chosen_version :: (Doc -> IO ()) -> (Doc -> IO ())
+go_to_chosen_version :: RepoFormat -> (Doc -> IO ()) -> (Doc -> IO ())
-> [DarcsFlag] -> IO ()
hunk ./Get.lhs 260
- -go_to_chosen_version putVerbose putInfo opts =
+go_to_chosen_version rf putVerbose putInfo opts =
when (have_patchset_match opts) $ do
putVerbose $ text "Going to specified version..."
hunk ./Get.lhs 263
- - patches <- lazily_read_repo "."
+ patches <- lazily_read_repo rf "."
context <- get_one_patchset opts
let (_,us',them') = get_common_and_uncommon (patches, context)
case them' of
hunk ./Get.lhs 274
putInfo $ text $ "Unapplying " ++ (show $ length ps) ++ " " ++ (patch_or_patches $ length ps)
let (_, skipped) = commute_to_end ps patches
sequence_ $ map (write_patch opts) skipped
- - repo_patches <- read_repo "."
+ repo_patches <- read_repo rf "."
write_inventory "." $ foldl (flip rempatch) repo_patches (reverse ps)
pris <- identifyPristine
applyPristine pris (invert $ join_patches ps) `catch` \e ->
hunk ./Init.lhs 26
import DarcsArguments ( DarcsFlag, pristine_tree, working_repo_dir )
import RepoPrefs ( write_default_prefs )
import Pristine ( createPristine, flagsToPristine )
+import RepoFormat ( show_repo_format, initial_repo_format )
import DarcsRepo ( am_not_in_repo, write_inventory )
hunk ./Init.lhs 28
+import Lock ( writeBinFile )
\end{code}
\options{initialize}
hunk ./Init.lhs 101
createPristine $ flagsToPristine opts
createDirectory "_darcs/patches"
createDirectory "_darcs/prefs"
+ writeBinFile "_darcs/format" (show_repo_format initial_repo_format)
write_default_prefs
write_inventory "." [[]]
\end{code}
hunk ./Match.lhs 33
import PatchInfo ( PatchInfo, just_name, human_friendly, patchinfo )
import Patch ( Patch, invert, patch2patchinfo, apply )
- -import Repository ( PatchSet )
- -import DarcsRepo ( read_repo, apply_patches, createPristineDirectoryTree )
+import Repository ( PatchSet, identifyRepository, read_repo )
+import RepoFormat ( identifyRepoFormat )
+import DarcsRepo ( apply_patches, createPristineDirectoryTree )
import Depends ( get_patches_in_tag )
import Depends ( get_patches_beyond_tag, )
hunk ./Match.lhs 192
get_one_patchset :: [DarcsFlag] -> IO PatchSet
get_one_patchset fs =
case nonrange_matcher fs of
- - Just m -> do ps <- read_repo "."
+ Just m -> do ps <- identifyRepository "." >>= read_repo
if nonrange_matcher_is_tag fs
then return $ get_matching_tag m ps
else return $ match_a_patchset m ps
hunk ./Match.lhs 268
= do d <- getCurrentDirectory
withCurrentDirectory r $ do
pris <- identifyPristine
- - createPristineDirectoryTree pris d
+ rf <- identifyRepoFormat "."
+ createPristineDirectoryTree rf pris d
get_matcher :: String -> Matcher -> IO ()
hunk ./Match.lhs 272
- -get_matcher r m = do repo <- read_repo r
+get_matcher r m = do repo <- identifyRepository r >>= read_repo
if match_exists m repo
then do createRemotePristineDirectoryTree r
apply_foo repo
hunk ./Match.lhs 285
get_before_matcher :: String -> Matcher -> IO ()
get_before_matcher r m =
- - do repo <- read_repo r
+ do repo <- identifyRepository r >>= read_repo
if match_exists m repo
then do createRemotePristineDirectoryTree r
apply_foo repo
hunk ./Match.lhs 310
get_dropn :: String -> Int -> IO ()
get_dropn r n = do createRemotePristineDirectoryTree r
- - repo <- read_repo r
+ repo <- identifyRepository r >>= read_repo
apply_patches [] False silently silently $
map invit $ safetake n $ concat repo
where invit (pinf, Nothing) = (pinf, Nothing)
hunk ./Match.lhs 324
\begin{code}
get_tag :: String -> Matcher -> IO ()
get_tag r match = do
- - ps <- read_repo r
+ ps <- identifyRepository r >>= read_repo
let pinfo = fromJust $ patch2patchinfo $ find_a_patch match ps
case get_patches_beyond_tag pinfo ps of
[extras] -> do createRemotePristineDirectoryTree r
hunk ./Optimize.lhs 37
working_repo_dir,
)
import RepoPrefs ( defaultrepo )
- -import Repository ( PatchSet, withRepoLock )
- -import DarcsRepo ( read_repo, write_inventory, write_checkpoint,
+import Repository ( PatchSet, Repository, withRepoLock, read_repo, repositoryFormat )
+import DarcsRepo ( write_inventory, write_checkpoint,
am_in_repo, write_patch,
)
import PatchInfo ( PatchInfo, just_name, make_filename, human_friendly )
hunk ./Optimize.lhs 94
\end{code}
\begin{code}
optimize_cmd :: [DarcsFlag] -> [String] -> IO ()
- -optimize_cmd opts _ = withRepoLock $ \_ -> do
- - do_reorder opts
- - do_optimize_inventory opts
- - when (CheckPoint `elem` opts) $ do_checkpoint opts
+optimize_cmd opts _ = withRepoLock $ \repository -> do
+ do_reorder repository opts
+ do_optimize_inventory repository opts
+ when (CheckPoint `elem` opts) $ do_checkpoint repository opts
when (Compress `elem` opts || UnCompress `elem` opts ||
ModernizePatches `elem` opts)
hunk ./Optimize.lhs 100
- - $ optimize_compression opts
+ $ optimize_compression repository opts
when (Relink `elem` opts || (RelinkPristine `elem` opts)) $
do_relink opts
putStrLn "Done optimizing!"
hunk ./Optimize.lhs 120
become very important in large repositories.
\begin{code}
- -do_optimize_inventory :: [DarcsFlag] -> IO ()
- -do_optimize_inventory opts = do
- - ps <- read_repo "."
+do_optimize_inventory :: Repository -> [DarcsFlag] -> IO ()
+do_optimize_inventory repository opts = do
+ ps <- read_repo repository
when (Verbose `elem` opts) $
putStrLn "Writing out a nice copy of the inventory."
write_inventory "." ps
hunk ./Optimize.lhs 148
\begin{code}
- -do_checkpoint :: [DarcsFlag] -> IO ()
- -do_checkpoint opts = do
- - mpi <- get_tag opts
+do_checkpoint :: Repository -> [DarcsFlag] -> IO ()
+do_checkpoint r opts = do
+ mpi <- get_tag r opts
case mpi of
Nothing -> return ()
Just pinfo -> do putDocLn $ text "Checkpointing tag:"
hunk ./Optimize.lhs 155
$$ human_friendly pinfo
- - write_checkpoint pinfo
+ write_checkpoint (repositoryFormat r) pinfo
hunk ./Optimize.lhs 157
- -get_tag :: [DarcsFlag] -> IO (Maybe PatchInfo)
- -get_tag [] = do ps <- read_repo "."
- - case filter (is_tag . fst) $ lasts ps of
- - [] -> do putStrLn "There is no tag to checkpoint!"
- - return Nothing
- - ((pinfo,_):_) -> return $ Just pinfo
- -get_tag (TagName t:_) =
- - do ps <- read_repo "."
+get_tag :: Repository -> [DarcsFlag] -> IO (Maybe PatchInfo)
+get_tag r [] = do ps <- read_repo r
+ case filter (is_tag . fst) $ lasts ps of
+ [] -> do putStrLn "There is no tag to checkpoint!"
+ return Nothing
+ ((pinfo,_):_) -> return $ Just pinfo
+get_tag r (TagName t:_) =
+ do ps <- read_repo r
case filter (match_tag t) $ map fst $ lasts ps of
(pinfo:_) -> return $ Just pinfo
_ -> case filter (match_tag t) $ map fst $
hunk ./Optimize.lhs 173
_ -> do putStr "Cannot checkpoint any tag "
putStr $ "matching '"++t++"'\n"
return Nothing
- -get_tag (_:fs) = get_tag fs
+get_tag r (_:fs) = get_tag r fs
lasts :: [[a]] -> [a]
lasts [] = []
hunk ./Optimize.lhs 233
an equivalent change (which will, however, commute differently).
\begin{code}
- -optimize_compression :: [DarcsFlag] -> IO ()
- -optimize_compression opts = do
- - r <- read_repo "."
+optimize_compression :: Repository -> [DarcsFlag] -> IO ()
+optimize_compression repository opts = do
+ r <- read_repo repository
withCurrentDirectory "_darcs/patches"
(sequence_ $ map (do_compress.make_filename.fst) $ concat r)
where wps = if Compress `elem` opts
hunk ./Optimize.lhs 314
this could lead to repository corruption.
\begin{code}
- -do_reorder :: [DarcsFlag] -> IO ()
- -do_reorder opts | not (Reorder `elem` opts) = return ()
- -do_reorder opts = do
+do_reorder :: Repository -> [DarcsFlag] -> IO ()
+do_reorder _ opts | not (Reorder `elem` opts) = return ()
+do_reorder repository opts = do
when (Verbose `elem` opts) $ putStrLn "Reordering the inventory."
hunk ./Optimize.lhs 318
- - psnew <- choose_order `liftM` read_repo "."
+ psnew <- choose_order `liftM` read_repo repository
block $ do write_patchset opts psnew
write_inventory "." psnew
hunk ./Population.lhs 32
) where
import FastPackedString ( PackedString, unpackPS, packString,
splitPS, appendPS, nilPS )
- -import Monad ( liftM )
import List ( nub )
import Maybe ( catMaybes )
import DarcsUtils ( withCurrentDirectory )
hunk ./Population.lhs 39
import FileName ( fn2fp, fp2fn, norm_path )
import PatchInfo ( PatchInfo, patchinfo, to_xml )
import Patch ( Patch, applyToPop, patchChanges )
- -import DarcsRepo ( read_repo )
+import Repository ( read_repo, identifyRepository )
import Pristine ( identifyPristine, getPristinePop )
import PopulationData ( Population(..), PopTree(..), Info(..), DirMark(..),
notModified, setPopState, getPopFrom )
hunk ./Population.lhs 223
getRepoPop :: FilePath -> IO Population
getRepoPop repobasedir
- - = do pinfo <- liftM (fst . head . concat) (read_repo repobasedir)
+ = do pinfo <- (fst . head . concat) `fmap` (identifyRepository repobasedir >>= read_repo)
-- pinfo is the latest patchinfo
mp <- withCurrentDirectory repobasedir $
identifyPristine >>= getPristinePop pinfo
hunk ./Population.lhs 233
getRepoPopVersion :: FilePath -> PatchInfo -> IO Population
getRepoPopVersion repobasedir pinfo
- - = do pips <- concat `liftM` read_repo repobasedir
- - return $ applyPatchSetPop [dropWhile ((/=pinfo).fst) pips] initPop
+ = do repo <- identifyRepository repobasedir >>= read_repo
+ return $ applyPatchSetPop [dropWhile ((/=pinfo).fst) $ concat repo] initPop
\end{code}
hunk ./Population.lhs 263
dropDS f = f
lookup_creation_pop :: PatchInfo -> FilePath -> Population -> Maybe Population
- -lookup_creation_pop b a (Pop pinfo pp) = (Pop pinfo) `liftM` lcp pp
+lookup_creation_pop b a (Pop pinfo pp) = (Pop pinfo) `fmap` lcp pp
where lcp p@(PopFile i)
hunk ./Population.lhs 265
- - | fixname `liftM` creationNameI i == f && createdByI i == who = Just p
+ | fixname `fmap` creationNameI i == f && createdByI i == who = Just p
| otherwise = Nothing
lcp p@(PopDir i c)
hunk ./Population.lhs 268
- - | fixname `liftM` creationNameI i == f && createdByI i == who = Just p
+ | fixname `fmap` creationNameI i == f && createdByI i == who = Just p
| otherwise = case catMaybes $ map lcp c of
[apop] -> Just apop
_ -> Nothing
hunk ./Push.lhs 31
disable_ssh_cm,
any_verbosity, set_default, sign
)
- -import Repository ( withRepoLock, slurp_recorded )
- -import DarcsRepo ( read_repo, am_in_repo, absolute_dir )
+import Repository ( withRepoLock, slurp_recorded, identifyRepository, read_repo )
+import DarcsRepo ( am_in_repo, absolute_dir )
import PatchInfo ( human_friendly )
import RepoPrefs ( defaultrepo, set_defaultrepo, get_preflist )
import External ( maybeURLCmd, signString )
hunk ./Push.lhs 121
in if DryRun `elem` opts
then putInfo $ text "NOTE:" <+> msg
else errorDoc msg
- - them <- read_repo repodir
+ them <- identifyRepository repodir >>= read_repo
old_default <- defaultrepo "" []
set_defaultrepo repodir opts
when (old_default == [repodir]) $
hunk ./Push.lhs 126
putInfo $ text $ "Pushing to "++formatPath repodir++"..."
- - us <- read_repo "."
+ us <- identifyRepository "." >>= read_repo
case get_common_and_uncommon (us, them) of
(common, us', _) -> do
putVerbose $ text "We have the following patches to push:"
hunk ./Put.lhs 15
any_verbosity, pristine_tree, working_repo_dir,
disable_ssh_cm,
)
- -import Repository ( patchSetToPatches )
- -import DarcsRepo ( read_repo, am_in_repo,
+import Repository ( patchSetToPatches, identifyRepository, read_repo )
+import DarcsRepo ( am_in_repo,
absolute_dir, write_inventory )
import PatchBundle ( make_bundle )
import Match ( have_patchset_match, get_one_patchset )
hunk ./Put.lhs 105
set_defaultrepo req_absolute_repo_dir opts
patchset <- if have_patchset_match opts
then get_one_patchset opts
- - else read_repo "."
+ else identifyRepository "." >>= read_repo
let patches = patchSetToPatches patchset
when (null patches) $ do
putInfo $
hunk ./Repair.lhs 31
)
import Patch ( patch2patchinfo )
import Repository ( withRepoLock )
+import RepoFormat ( identifyRepoFormat )
import DarcsRepo ( lazily_read_repo, am_in_repo, get_checkpoint_by_default,
apply_patches_with_feedback, simple_feedback )
import Pristine ( identifyPristine, checkPristine, replacePristine )
hunk ./Repair.lhs 81
feedback = simple_feedback opts
in withRepoLock $ \_ -> do
check_uniqueness putVerbose putInfo
- - patches <- lazily_read_repo "."
+ rf <- identifyRepoFormat "."
+ patches <- lazily_read_repo rf "."
maybe_chk <- get_checkpoint_by_default opts "."
formerdir <- getCurrentDirectory
withTempDir (formerdir++"/_darcs/newpristine") $ \newcur -> do
hunk ./Replace.lhs 25
import DarcsCommands
import DarcsArguments
- -import Repository ( withRepoLock,
+import Repository ( withRepoLock, repositoryFormat,
slurp_pending, add_to_pending,
)
import DarcsRepo ( am_in_repo, slurp_recorded_and_unrecorded
hunk ./Replace.lhs 131
unless (is_tok toks tok) $ fail $ "'"++tok++"' is not a valid token!"
checkToken old
checkToken new
- - (_, work) <- slurp_recorded_and_unrecorded "."
+ (_, work) <- slurp_recorded_and_unrecorded (repositoryFormat repository) "."
cur <- slurp_pending repository
ps_and_pswork <- catMaybes `liftM` sequence (map (repl toks cur work) fs)
apply opts True (join_patches $ snd $ unzip ps_and_pswork) `catch` \e ->
hunk ./RepoFormat.lhs 8
\begin{code}
module RepoFormat ( RepoFormat, RepoProperty(..), identifyRepoFormat,
parse_repo_format, write_problem, read_problem,
- - format_has,
+ format_has, show_repo_format, initial_repo_format,
) where
import Monad ( liftM )
hunk ./RepoFormat.lhs 43
parse_repo_format ps =
RF $ map (splitPS '|') $ filter (not.nullPS) $ linesPS ps
+show_repo_format :: RepoFormat -> String
+show_repo_format (RF ls) = unlines $ map (unwords . map unpackPS) ls
+
+initial_repo_format :: RepoFormat
+initial_repo_format = default_repo_format
+
default_repo_format :: RepoFormat
default_repo_format = RF [[rp2ps Darcs1_0]]
\end{code}
hunk ./Repository.lhs 20
\begin{code}
module Repository ( Repository, maybeIdentifyRepository, identifyRepository,
findRepository, amInRepository, slurp_pending,
+ repositoryFormat,
slurp_recorded, slurp_recorded_and_unrecorded,
get_unrecorded, read_repo, sync_repo, absolute_dir,
prefsUrl,
hunk ./Repository.lhs 41
write_problem, read_problem )
import Directory ( doesDirectoryExist, setCurrentDirectory )
import Monad ( liftM, when )
- -import Maybe ( catMaybes )
+import Data.Maybe ( catMaybes, isJust )
import SlurpDirectory ( Slurpy, slurp_unboring, co_slurp, slurp_has )
import DarcsRepo ( seekRepo, youNeedToBeInRepo )
import qualified DarcsRepo
hunk ./Repository.lhs 65
data Repository = Repo !String !RepoFormat !RepoType
+repositoryFormat :: Repository -> RepoFormat
+repositoryFormat (Repo _ rf _) = rf
+
data RepoType = DarcsRepository !Pristine | GitRepository
maybeIdentifyRepository :: String -> IO (Either String Repository)
hunk ./Repository.lhs 150
Nothing -> return cur
slurp_recorded :: Repository -> IO Slurpy
- -slurp_recorded (Repo r _ (DarcsRepository pristine)) =
- - withCurrentDirectory r $ DarcsRepo.surely_slurp_Pristine pristine
+slurp_recorded (Repo r rf (DarcsRepository pristine)) =
+ withCurrentDirectory r $ DarcsRepo.surely_slurp_Pristine rf pristine
slurp_recorded (Repo r _ GitRepository) = GitRepo.slurpHead r
slurp_recorded_and_unrecorded :: Repository -> IO (Slurpy, Slurpy)
hunk ./Repository.lhs 155
- -slurp_recorded_and_unrecorded (Repo r _ (DarcsRepository _)) =
- - DarcsRepo.slurp_recorded_and_unrecorded r
+slurp_recorded_and_unrecorded (Repo r rf (DarcsRepository _)) =
+ DarcsRepo.slurp_recorded_and_unrecorded rf r
slurp_recorded_and_unrecorded repo@(Repo r _ _) = do
cur <- slurp_recorded repo
mbpend <- read_pending repo
hunk ./Repository.lhs 223
where myfilt s nboring f = slurp_has f s || nboring [f] /= []
read_repo :: Repository -> IO PatchSet
- -read_repo (Repo r _ (DarcsRepository _)) = DarcsRepo.read_repo r
+read_repo (Repo _ rf _) | isJust $ read_problem rf =
+ fail $ fromJust $ read_problem rf
+read_repo (Repo r rf (DarcsRepository _)) = DarcsRepo.read_repo rf r
read_repo (Repo r _ GitRepository) = GitRepo.read_repo r
sync_repo :: Repository -> IO ()
hunk ./Resolution.lhs 32
import CommandLine ( parseCmd )
import DarcsUtils ( askUser )
import SlurpDirectory ( Slurpy, slurp, list_slurpy )
- -import Repository ( PatchSet )
- -import DarcsRepo ( slurp_recorded_and_unrecorded )
+import Repository ( PatchSet, identifyRepository, slurp_recorded_and_unrecorded )
import Diff ( smart_diff )
import RepoPrefs ( filetype_function )
import Exec ( exec )
hunk ./Resolution.lhs 151
\begin{code}
external_resolution c _ p1 p2 pmerged = do
- - (_, s) <- slurp_recorded_and_unrecorded "."
+ (_, s) <- identifyRepository "." >>= slurp_recorded_and_unrecorded
former_dir <- getCurrentDirectory
withTempDir "version1" $ \d1 -> do
clonePaths former_dir d1 (list_slurpy s)
hunk ./Tag.lhs 24
import DarcsCommands
import DarcsArguments
import DarcsUtils ( askUser )
- -import Repository ( withRepoLock )
- -import DarcsRepo
+import Repository ( withRepoLock, repositoryFormat, read_repo )
+import DarcsRepo ( add_to_inventory, write_patch, am_in_repo, write_recorded_checkpoint )
import Patch
import PatchInfo
import Depends
hunk ./Tag.lhs 70
\end{code}
\begin{code}
tag_cmd :: [DarcsFlag] -> [String] -> IO ()
- -tag_cmd opts args = withRepoLock $ \_ -> do
+tag_cmd opts args = withRepoLock $ \repository -> do
date <- get_date opts
the_author <- get_author opts
hunk ./Tag.lhs 73
- - deps <- liftM get_tags_right $ read_repo "."
+ deps <- liftM get_tags_right $ read_repo repository
name <- if (not . null) args
then return $ "TAG " ++ unwords args
else get_patchname opts
hunk ./Tag.lhs 82
in do
write_patch opts $ adddeps mypatch deps
add_to_inventory "." [myinfo]
- - when (CheckPoint `elem` opts) $ write_recorded_checkpoint myinfo
+ when (CheckPoint `elem` opts) $ write_recorded_checkpoint
+ (repositoryFormat repository) myinfo
putStrLn $ "Finished tagging patch '"++name++"'"
\end{code}
Each tagged version has a version name.
hunk ./Test.lhs 27
import PatchCore ( patch2patchinfo )
import PatchInfo ( just_name )
import DarcsRepo ( withRecorded )
+import RepoFormat ( identifyRepoFormat )
import DarcsArguments ( DarcsFlag( Verbose, Quiet, LeaveTestDir,
NoPosthook, RunPosthook ),
hunk ./Test.lhs 91
Nothing -> return ExitSuccess
Just _ -> do
formerdir <- getCurrentDirectory
- - withRecorded (wd "testing") $ \td -> do
+ rf <- identifyRepoFormat "."
+ withRecorded rf (wd "testing") $ \td -> do
apply opts False p
setCurrentDirectory formerdir
ec <- run_test opts td
hunk ./TrackDown.lhs 26
import DarcsCommands ( DarcsCommand(..), nodefaults )
import DarcsArguments ( DarcsFlag, verbose, working_repo_dir )
import DarcsRepo ( withRecorded )
- -import Repository ( amInRepository, read_repo, withRepoLock )
+import Repository ( amInRepository, read_repo, withRepoLock, repositoryFormat )
import PatchInfo ( human_friendly )
import Patch ( Patch, patch2patchinfo, apply, invert )
import Printer ( putDocLn )
hunk ./TrackDown.lhs 85
putStrLn $ "Tracking down command:\n"++cmd
return $ (system init, system cmd)
_ -> fail "Trackdown expects zero to two arguments."
- - withRecorded (withTempDir "trackingdown") $ \_ -> do
+ withRecorded (repositoryFormat repository) (withTempDir "trackingdown") $ \_ -> do
init
track_next opts test $ map (invert . fromJust . snd) $ concat patches
\end{code}
hunk ./Unrecord.lhs 34
import Match ( first_match, match_first_patchset,
)
import Repository ( PatchSet, withRepoLock, slurp_recorded,
- - get_unrecorded,
+ read_repo, get_unrecorded,
read_pending, with_new_pending, sync_repo,
)
hunk ./Unrecord.lhs 37
- -import DarcsRepo ( read_repo,
- - write_inventory, write_patch,
+import DarcsRepo ( write_inventory, write_patch,
am_in_repo,
)
import Pristine ( identifyPristine, applyPristine )
hunk ./Unrecord.lhs 151
pend <- do aack <- read_pending repository
return $ case aack of Nothing -> []
Just p -> flatten p
- - allpatches <- read_repo "."
+ allpatches <- read_repo repository
let patches = if first_match opts then get_last_patches opts allpatches
else head allpatches
patches' = map (fromJust . snd) $ reverse patches
hunk ./Unrecord.lhs 167
logMessage "About to write out (potentially) modified patches..."
let (_, skipped) = commute_to_end to_unrecord allpatches
sequence_ $ map (write_patch opts) skipped
- - repo_patches <- read_repo "."
+ repo_patches <- read_repo repository
when (Verbose `elem` opts) $
logMessage "About to write inventory..."
write_inventory "." $ foldl (flip rempatch) repo_patches (reverse to_unrecord)
hunk ./Unrecord.lhs 364
let pend = case mpend of
Nothing -> null_patch
Just p -> p
- - allpatches <- read_repo "."
+ allpatches <- read_repo repository
let patches = if first_match opts then get_last_patches opts allpatches
else head allpatches
patches' = map (fromJust . snd) $ reverse patches
hunk ./Unrecord.lhs 381
withSignalsBlocked $ with_new_pending repository pend' $ do
let (_, skipped) = commute_to_end ps allpatches
sequence_ $ map (write_patch opts) skipped
- - repo_patches <- read_repo "."
+ repo_patches <- read_repo repository
write_inventory "." $ foldl (flip rempatch) repo_patches (reverse ps)
pris <- identifyPristine
applyPristine pris (invert $ join_patches ps) `catch` \e ->
}
[make amend-record.pl test a bit pickier.
David Roundy <[EMAIL PROTECTED]>**20060730103854]
<
> {
hunk ./tests/amend-record.pl 18
like( darcs('init'), qr/^$/i, 'initialized repo');
`echo "Tester" > _darcs/prefs/author`;
+`echo ALL ignore-times >> _darcs/prefs/defaults`;
# Plain amend-record
touch('foo');
hunk ./tests/amend-record.pl 31
like( echo_to_darcs("y","amend-record -a foo"), qr/amending changes/i, 'amend-record -a');
is($?,0, " return code == 0");
+{
+ my $changes = darcs("changes -v");
+ like( $changes, qr/another line/, 'change amended properly');
+}
+
# Special case: patch is empty after amend
cp "foo","foo.old";
}
Context:
[TAG 1.0.8
Tommy Pettersson <[EMAIL PROTECTED]>**20060616160213]
Patch bundle hash:
47c39b882193bc00e6817d8ead2156094acdc8f3
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.3 (GNU/Linux)
iD8DBQFEzJ7zQ6uZI9PVvOwRAtpXAJ4p0h7tkgavhjQEqTpDnCwBOSipYgCgq407
G7o/i1VB1EBCJnQrDTuMoV8=
=Dc2w
-----END PGP SIGNATURE-----
_______________________________________________
darcs-devel mailing list
[email protected]
http://www.abridgegame.org/cgi-bin/mailman/listinfo/darcs-devel
