Here's the rest of the review. I guess I'm marking this amend-requested. If
we had a nice amount of automation, it may make sense for each patch to have
its own ticket rather than each bundle. That would only be practical with
automation though.
> > Thu Oct 8 16:04:29 BST 2009 Florent Becker <florent.becker@ens-lyon.org>
> > * Refactor Darcs.Commands.Apply
>
> This conflicts, but I think I can fix it myself.
The conflict was with the --skip-conflicts work (which I made use of to
review this bundle).
I've pushed a conflict resolution and also thrown in a type signature
tweak so that the witnesses build compiles with GHC 6.8.3 (yay
buildbot!)
> > Thu Oct 15 09:28:18 BST 2009 Florent Becker <florent.becker@ens-lyon.org>
> > * Refactor Darcs.Commands.Push
> >
> > Thu Oct 15 14:07:43 BST 2009 Florent Becker <florent.becker@ens-lyon.org>
> > * Refactor Darcs.Commands.Send
I've pushed these fairly straightforward patches. There's a review below,
but it doesn't say very much
> > Thu Sep 24 15:13:35 BST 2009 Florent Becker <florent.becker@ens-lyon.org>
> > * simplify Darcs.Commands.Record.ask_about_depends
I don't think I like this one and would like to request that you go back to the
drawing board. I may just be being grumpy for no reason, so feel free to argue
more strongly for this.
simplify Darcs.Commands.Record.ask_about_depends
------------------------------------------------
I need the whole function for context here
ask_about_depends :: RepoPatch p => Repository p -> FL Prim -> [DarcsFlag] -> IO [PatchInfo]
ask_about_depends repository pa' opts = do
pps <- read_repo repository
pa <- n2pia `fmap` anonymous (fromPrims pa')
> - let ps = (reverseRL $ headRL pps)+>+(pa:>:NilFL)
> + let
> + ps = (reverseRL $ headRL pps)
> + -- Why can't a patch depend on a patch under a tag? Florent
ps changes meaning, but that's fine because it doesn't appear elsewhere
to just mean the set of patches within the tag (and not it plus the new
patches).
COMMENT: I was a bit confused by Florent's question because here the
code is manipulating tags in the sense of Darcs.Patch.Choice, whereas
Florent's question was about tags in the sense of 'darcs tag'. I think
he's referring to the fact that we do headRL pps instead of something
like concatRL pps
> - (pc, tps) = patchChoicesTps ps
> - ta = case filter ((pa `unsafeCompare`) . tpPatch) $ unsafeUnFL tps of
> - [tp] -> tag tp
> - [] -> error "ask_about_depends: []"
> - _ -> error "ask_about_depends: many"
> + (pc , ta) = ps `snocAndTag` pa
OK so here we retrieve the taggged sequence
(reverseRL $ headRL pps)+>+(pa:>:NilFL)
What's nice is that you manage to get rid of a lot of bureaucracy which comes
from the fact of putting pa in a box (tagging it) and then pulling it back out
of the box (retrieving it from a list we expect to be singleton), due to filter
ps' = mapFL_FL tpPatch $ middle_choice $ forceFirst ta pc
with_selected_changes_reversed "depend on" (filter askdep_allowed opts) Nothing ps'
$ \(deps:>_) -> return $ mapFL info deps
where headRL (x:<:_) = x
headRL NilRL = impossible
askdep_allowed = not . patch_select_flag
middle_choice p = mc where (_ :> mc :> _) = getChoices p
> hunk ./src/Darcs/Patch/Choices.hs 370
> +-- | @snocAndTag ps p@ adds @p@ at the end of @ps@ and returns
> +-- @(choices,tagged_ps,t)@, where the decision in @choices@ is
> +-- uniformly @InMiddle@, and t is the tag of p in @choices@.
I think you must have earlier tried to do more in this function, and then
backed off to something simpler. The haddock is now out of date. :-)
> +snocAndTag :: (Patchy p) => FL p C(x y) -> p C(y z) ->
> + (PatchChoices p C(x z), Tag)
> +snocAndTag ps p = (pc, t)
> + where t = TG Nothing . fromIntegral $ lengthFL ps + 1
> + pc = patchChoices $ ps +>+ (p :>: NilFL)
I don't like this snocAndTag function very much. We snoc, tag the sequence and
re-invent the tag for the last element in the sequence. Sounds like a recipe
for trouble if we ever change how the underlying patchChoices works. If we're
going to do this, we should grab the tag of the snocced patch from the sequence,
not re-invent it.
Finally, it's not obvious to me what this function would be good for. If I may
speak vaguely, I feel like we're breaking the problem down into the wrong
chunks. Why not just have a snocFL function?
Could we have some sort of search function within tagged patches that returns
Maybe?
Refactor Darcs.Commands.Apply
-----------------------------
> with_selected_changes "apply" fixed_opts Nothing their_ps $
> - \ (to_be_applied:>_) -> do
> + \ (to_be_applied:>_) ->
> + applyItNow opts from_whom repository us' to_be_applied
Type signature looks right, details below.
> +applyItNow :: RepoPatch p =>
> + FORALL(r u t x y z)
I've changed this to applyItNow :: FORALL(p r u t x y z) => RepoPatch p
> [DarcsFlag]
> -> String
from_whom (not sure what that is)
> -> Repository p C(r u t)
repository
> + -> RL (PatchInfoAnd p) C(x r)
our patches from the common state (x) to the repository state (r)
[the relevant constructor is
(:<:) :: a C(y z) -> RL a C(x y) -> RL a C(x z)
for those confused by RL and FL]
> -> FL (PatchInfoAnd p) C(x z) -> IO ()
the patches to apply from the common state to the remote state (z)
> +applyItNow opts from_whom repository us' to_be_applied = do
Just more of the usual breaking up of large functions into more
manageable chunks. There's a tradeoff between having too large chunks
and too many chunks, but I guess I agree with Florent that the commands
were quite unreasonable.
> print_dry_run_message_and_exit "apply" opts to_be_applied
> when (nullFL to_be_applied) $
> do putStrLn "You don't want to apply any patches, so I'm exiting!"
> hunk ./src/Darcs/Commands/Apply.lhs 195
> applyToWorking repository opts pw `catch` \e ->
> fail ("Error applying patch to working dir:\n" ++ show e)
> putStrLn "Finished applying..."
> +cannotApplyMissing :: PatchInfo -> a
> +cannotApplyPartialRepo :: PatchInfo -> String -> a
No changes here, just helper functions moved out to the top level.
No comment on whether this is a good precedent to set or not; will
just trust Florent to get on with it :-)
> +Darcs apply accepts a single argument, which is the name of the patch
> +file to be applied. If you omit this argument, the patch is read from
> +standard input. Darcs also interprets an argument of `\-' to mean it
> +should read the file from standard input. This allows you to use apply
> +with a pipe from your email program, for example.
> +
> +\begin{options}
> +--verify
> +\end{options}
COMMENT: I think this documentation was removed in one of Trent's
refactors and got accidentally re-inserted during some sort of manual
merge. Florent: could you confirm?
Refactor Darcs.Commands.Push
----------------------------
COMMENT: I'm happy to push this, but I hope you'll be continuing work in
this module, because the new divisions/names don't always make a lot of
sense. I guess this is because it was hard to do this while sticking to
the principle of not changing anything and just cutting things up into
pieces.
> import System.Console.GetOpt( OptDescr, usageInfo )
> hunk ./src/Darcs/Commands.lhs 47
> +abortRun :: [DarcsFlag] -> Doc -> IO ()
> +abortRun opts msg = if DryRun `elem` opts
> + then putInfo opts $ text "NOTE:" <+> msg
> + else errorDoc msg
New function to fail (or just print an error message if we're in
dry-run). This blows up using 'error'.
COMMENT: This is inherited via cut-and-paste programming, but in perhaps
in the future we can replace this with fail? I'm just thinking that
error should be reserved for bugs, but I could just be being silly.
> hunk ./src/Darcs/Commands/Push.lhs 21
> {-# OPTIONS_GHC -cpp #-}
> -{-# LANGUAGE CPP #-}
> +{-# LANGUAGE CPP, TypeOperators #-}
COMMENT: Why do we now need this extension?
> push_cmd :: [DarcsFlag] -> [String] -> IO ()
> -push_cmd opts [""] = push_cmd opts []
> +push_cmd _ [""] = impossible
This is just more direct (push_cmd _ [] is impossible)
> push_cmd opts [unfixedrepodir] =
> do
> repodir <- fixUrl opts unfixedrepodir
> hunk ./src/Darcs/Commands/Push.lhs 99
> -- Test to make sure we aren't trying to push to the current repo
> here <- getCurrentDirectory
> + checkOptionsSanity opts repodir
> when (repodir == here) $
> fail "Cannot push from repository to itself."
> -- absolute '.' also taken into account by fix_filepath
> hunk ./src/Darcs/Commands/Push.lhs 103
> - (bundle,num_to_pull) <- withRepoReadLock opts $- \repository -> do
[snip big chunk of code moved to checkOptionsSanity and nicely
refactored with abortRun]
prepareBundle
~~~~~~~~~~~~~
> +prepareBundle :: forall p C(r u t) . (RepoPatch p) => [DarcsFlag] -> String -> Repository p C(r u t) ->
> + IO (Doc, Int)
> +prepareBundle opts repodir repository = do
> them <- identifyRepositoryFor repository repodir >>= read_repo
> old_default <- get_preflist "defaultrepo"
> set_defaultrepo repodir opts
> hunk ./src/Darcs/Commands/Push.lhs 132
> us <- read_repo repository
> case get_common_and_uncommon (us, them) of
> (common, us' :\/: them') -> do
> - checkUnrelatedRepos opts common us them
> - putVerbose opts $ text "We have the following patches to push:"
> + prePushChatter opts common us us' them
> + with_selected_changes "push" opts Nothing (reverseRL us') $ bundlePatches opts them' common
The name 'prepareBundle' seems to be wrong and in any case, confusing,
given bundlePatches
COMMENT: I wonder if prePushChatter could be moved out.
Since we're breaking things up, maybe we should be more consistent
about it, for example, by establishing something that looks more
like:
prePushChatter
selectPatchesToPush
remoteApplyPatches
postPushChatter
I guess the principle at work is to keep things all at the same level of
abstraction. Anyway, I'm probably just making this all up and you've
thought about it longer than me.
prePushChatter
~~~~~~~~~~~~~~
> +prePushChatter :: forall p a C(x y z t) . (ShowPatch a) =>
> + [DarcsFlag] -> [PatchInfo] -> PatchSet p C(x) ->
> + RL a C(y z) -> PatchSet p C(t) -> IO ()
> +prePushChatter opts common us us' them = do
> + checkUnrelatedRepos opts common us them
> + putVerbose opts $ text "We have the following patches to push:"
> $$ (vcat $ mapRL description us')
I wonder if in practice we can replace the FORALL macro with forall p
C().
> hunk ./src/Darcs/Commands/Push.lhs 142
> - (case us' of
> - NilRL -> do putInfo opts $ text "No recorded local changes to push!"
> - exitWith ExitSuccess
> - _ -> return ()) :: IO ()
> + when (nullRL us') $ do putInfo opts $ text "No recorded local changes to push!"
> + exitWith ExitSuccess
Basic when refactor.
> - with_selected_changes "push" opts Nothing (reverseRL us') $
> - \ (to_be_pushed:>_) -> do
see prepareBundle
bundlePatches
~~~~~~~~~~~~~
> +bundlePatches :: forall t p a C(x y z w). RepoPatch p => [DarcsFlag] -> RL a C(x y) -> [PatchInfo]
> + -> (FL (PatchInfoAnd p) :> t) C(z w)
> + -> IO (Doc, Int)
> +bundlePatches opts them' common (to_be_pushed :> _) =
> + do
> definePatches to_be_pushed
> print_dry_run_message_and_exit "push" opts to_be_pushed
> when (nullFL to_be_pushed) $ do
Future work:
1. re-arrange the module so that prepareBundle and bundlePatches
are closer together
2. perhaps focus bundlePatches on really just preparing the bundle
for example, the patch counting could really be moved to what is
now prepareBundle or to a postPushChatter
Refactor Darcs.Commands.Send
----------------------------
> - Just fname -> do (d,f) <- get_description opts to_be_sent
> - let putabs a = do writeDocBinFile a (d $$ bundle)
> - putStrLn $ "Wrote patch to " ++ toFilePath a ++ "."
> - putstd = putDoc (d $$ bundle)
> - useAbsoluteOrStd putabs putstd fname
> - cleanup f
> +writeBundleToFile :: forall p C(x y) . (RepoPatch p) => [DarcsFlag] -> FL (PatchInfoAnd p) C(x y) -> Doc ->
> + AbsolutePathOrStd -> IO ()
> +writeBundleToFile opts to_be_sent bundle fname =
> + do (d,f) <- get_description opts to_be_sent
> + let putabs a = do writeDocBinFile a (d $$ bundle)
> + putStrLn $ "Wrote patch to " ++ toFilePath a ++ "."
> + putstd = putDoc (d $$ bundle)
> + useAbsoluteOrStd putabs putstd fname
> + cleanup opts f
This appears to be the main change, with everything else just being a
consequence of that.
--
Eric Kow <http://www.nltg.brighton.ac.uk/home/Eric.Kow>
PGP Key ID: 08AC04F9
|