[darcs-devel] darcs patch: optimized get --to-match handling for darcs 1 reposito...

[David Roundy]

On Sun, Apr 20, 2008 at 07:33:10PM +0200, tux_rocker at reinier.de wrote:
> Sun Apr 20 17:26:08 CEST 2008  tux_rocker at reinier.de
>   * optimized get --to-match handling for darcs 1 repositories

This looks like a good start, and I'm applying, but I have a few
suggestions for improvements...

Content-Description: A darcs patch for your repository!
> hunk ./src/Darcs/Commands/Get.lhs 156
> +  if (not (null [p | OnePattern p <- opts]) -- --to-match given
> +     && not (Partial `elem` opts)
> +     && not (format_has HashedInventory rf))

I'm not clear here why we need such a tricky "if"...  I'm willing to allow
a performance regression for the "get --partial --to-match" case (in which
we ignore the --partial), which does very much seem to be a corner case,
particularly as this command will commonly fail.  I suppose it's possible
that it's in common use (e.g. to get the latest tag).

The other question I have is why we want the OnePattern test? It seems like
we'd want this optimization to apply to --to-patch and --context as well.
I suspect what we'd want is to use the have_patchset_match predicate
defined in Darcs.Match.

And of course I'd like this optimization to be applied to hashed
repositories as well, but that shouldn't be hard to add in later, given the
clean implementation below.

> +    then withRepository opts $- \repository -> do
> +      debugMessage "Using economical get --to-match handling"

Yay debugMessage!  :)

> +      fromrepo <- identifyRepositoryFor  repository repodir
> +      patches_to_get <- get_one_patchset fromrepo opts 
> +      _ <- patchSetToRepository patches_to_get opts

Here I'm not sure why you match the empty pattern.  This would mean the
same thing if written without the "_ <- ".

> +      debugMessage "Finished converting selected patch set to new repository"
> +      return ()
> +    else copy_repo_and_go_to_chosen_version opts repodir rfsource rf putInfo
> +        where am_informative = not $ Quiet `elem` orig_opts
> +              putInfo s = when am_informative $ putDocLn s
> +
> +get_cmd _ _ = fail "You must provide 'get' with either one or two arguments."
> +
> +-- called by get_cmd
> +-- assumes that the target repo of the get is the current directory, and that an inventory in the
> +-- right format has already been created.
> +copy_repo_and_go_to_chosen_version :: [DarcsFlag] -> String -> RepoFormat -> RepoFormat -> (Doc -> IO ()) -> IO ()
> +copy_repo_and_go_to_chosen_version opts repodir rfsource rf putInfo = do
> hunk ./src/Darcs/Commands/Get.lhs 194
> -      where am_informative = not $ Quiet `elem` orig_opts
> -            putInfo s = when am_informative $ putDocLn s
> hunk ./src/Darcs/Commands/Get.lhs 195
> -get_cmd _ _ = fail "You must provide 'get' with either one or two arguments."
> hunk ./src/Darcs/Repository.lhs 39
> +                    patchSetToRepository,
> hunk ./src/Darcs/Repository.lhs 74
> +import Data.Either(Either(..))
> hunk ./src/Darcs/Repository.lhs 97
> +
> +#include "impossible.h"
> +
> hunk ./src/Darcs/Repository.lhs 192
> -              unless (Partial `elem` opts || Lazy `elem` opts || Ephemeral `elem` opts) $
> -                       do putInfo "Copying patches, to get lazy repository hit ctrl-C..."
> -                          Sealed r <- read_repo torepository
> -                          let peekaboo :: PatchInfoAnd p C(x y) -> IO ()
> -                              peekaboo x = case extractHash x of
> -                                           Left _ -> return ()
> -                                           Right h -> fetchFileUsingCache c "patches" h >> return ()
> -                          sequence_ $ mapRL peekaboo $ progressRL "Copying patches" $ concatRL r
> +              fetch_patches_if_necessary opts torepository
> hunk ./src/Darcs/Repository.lhs 207
> -      where putInfo = when (not $ Quiet `elem` opts) . putStrLn
> +
> +-- | patchSetToRepository takes a patch set, and writes a new repository in the current directory
> +--   that contains all the patches in the patch set. This function is used when 'darcs get'ing a
> +--   repository with the --to-match flag and the new repository is not in hashed format.
> +--   This function does not (yet) work for hashed repositories. If the passed @DarcsFlag at s tell 
> +--   darcs to create a hashed repository, this function will call @error at .
> +patchSetToRepository :: RepoPatch p => PatchSet p -> [DarcsFlag] -> IO (Repository p)
> +patchSetToRepository patchset opts = do
> +    maybeRepo <- maybeIdentifyRepository opts "."
> +    let repo@(Repo _ _ rf2 (DarcsRepository _ _)) = 
> +          case maybeRepo of
> +            Right r -> r
> +            Left e  -> bug ("Current directory not repository in patchSetToRepository: " ++ e)
> +    when (format_has HashedInventory rf2) (bug "Cannot create hashed repositories with patchSetToRepository")
> +    debugMessage "Writing inventory"
> +    DarcsRepo.write_inventory_and_patches opts patchset
> +    read_repo repo `unsealM` (apply_patches opts . reverseRL . concatRL)
> +    debugMessage "Writing the pristine"
> +    pristineFromWorking repo
> +    return repo

Looks good!

> +-- | Unless a flag has been given in the first argument that tells darcs not to do so (--lazy,
> +--   --partial or --ephemeral), this function fetches all patches that the given repository has 
> +--   with fetchFileUsingCache. This is used as a helper in copyFullRepository.
> +fetch_patches_if_necessary :: RepoPatch p => [DarcsFlag] -> Repository p -> IO ()
> +fetch_patches_if_necessary opts torepository@(Repo _ _ _ (DarcsRepository _ c)) = 
> +    unless (Partial `elem` opts || Lazy `elem` opts || Ephemeral `elem` opts) $
> +             do putInfo "Copying patches, to get lazy repository hit ctrl-C..."
> +                Sealed r <- read_repo torepository
> +                let peekaboo :: PatchInfoAnd p C(x y) -> IO ()
> +                    peekaboo x = case extractHash x of
> +                                 Left _ -> return ()
> +                                 Right h -> fetchFileUsingCache c "patches" h >> return ()
> +                sequence_ $ mapRL peekaboo $ progressRL "Copying patches" $ concatRL r
> +  where putInfo = when (not $ Quiet `elem` opts) . putStrLn

This refactor of fetch_patches_if_necessary would have been nicer to
include in a separate patch, given that it looks like you don't use this
function in any of your new code.
-- 
David Roundy
Department of Physics
Oregon State University