[darcs-users] darcs patch: add utility functions to Commands.lhs (and 10 more)
Reinier Lamers
tux_rocker at reinier.de
Sun Oct 4 00:10:58 UTC 2009
Hi Florent,
I think the whitespace fix in Pull.lhs should be removed. For the rest,
when you tell me why you changed the scope of 'revertable' in Pull.lhs and
it passes tests, I will push.
Bye,
Reinier
>New patches:
>
>[add utility functions to Commands.lhs
>Florent Becker <florent.becker at ens-lyon.org>**20090928130619
> Ignore-this: 856f9f8edb2e4aae13248e16bbd0e51c
>]
>+am_verbose :: [DarcsFlag] -> Bool
>+am_verbose = elem Verbose
>+
>+am_quiet :: [DarcsFlag] -> Bool
>+am_quiet = elem Quiet
>+
>+putVerbose :: [DarcsFlag] -> Doc -> IO ()
>+putVerbose opts = when (am_verbose opts) . putDocLn
>+
>+putInfo :: [DarcsFlag] -> Doc -> IO ()
>+putInfo opts = unless (am_quiet opts) . putDocLn
Nothing strange here.
>+putWarning :: [DarcsFlag] -> Doc -> IO ()
>+putWarning opts = unless (am_quiet opts) . hPutDocLn stderr
That's a good idea.
>[Haddock documentation for Darcs.Patch.Core.Named
>Florent Becker <florent.becker at ens-lyon.org>**20090918122203
> Ignore-this: 735d685fb7072a38302e987dbec85fea
>]
>+-- | The @Named@ type adds a patch info about a patch, that is a name.
> data Named p C(x y) where
>hunk ./src/Darcs/Patch/Core.lhs 66
>- NamedP :: !PatchInfo -> ![PatchInfo] -> !(p C(x y)) -> Named p C(x y)
>+ NamedP :: !PatchInfo
>+ -> ![PatchInfo]
>+ -> !(p C(x y))
>+ -> Named p C(x y)
>+-- ^ @NamedP info deps p@ represents patch @p@ with name
>+-- @info at . @deps@ is a list of dependencies added at the named patch
>+-- level, compared with the unnamed level (ie, dependencies added with
>+-- @darcs record --ask-deps@).
Hmmm, that last sentence could be clearer. You mean that @deps@ contains
only those dependencies added with --ask-deps, not the dependencies that exist
between the primitive patches?
>[typo in Hopefully.lhs
>Florent Becker <florent.becker at ens-lyon.org>**20090922143044
> Ignore-this: 935b1906e53d2fa700f4d3f17ed62aca
>] hunk ./src/Darcs/Hopefully.hs 76
>--- | @n2pia@ creates a PatchInfoAnd represeting a @Named@ patch.
>+-- | @n2pia@ creates a PatchInfoAnd representing a @Named@ patch.
OK.
>[remove Darcs.Commands.Loggers
>Florent Becker <florent.becker at ens-lyon.org>**20090929135014
> Ignore-this: d5f9c230260c34202b222989b12f4e8e
>] hunk ./src/Darcs/Commands.lhs 40
>- loggers,
>hunk ./src/Darcs/Commands.lhs 51
>-import Darcs.Utils ( putStrLnError )
>hunk ./src/Darcs/Commands.lhs 302
>--- | Output functions equivalent to (putStrLn, hPutStrLn stderr, putDocLn)
>-loggers :: [DarcsFlag] -> ( String -> IO ()
>- , String -> IO ()
>- , Doc -> IO ())
>-loggers _ = (putStrLn, putStrLnError, putDocLn)
>-
OK.
>hunk ./src/Darcs/Commands/Pull.lhs 29
>-import Darcs.Commands ( DarcsCommand(..), loggers )
>+import Darcs.Commands ( DarcsCommand(..), putVerbose, putInfo )
>hunk ./src/Darcs/Commands/Pull.lhs 31
>-import Darcs.Arguments ( DarcsFlag( Verbose, Quiet, DryRun, MarkConflicts, XMLOutput,
>- Intersection, Complement, AllowConflicts, NoAllowConflicts ),
>+import Darcs.Arguments ( DarcsFlag( Verbose, DryRun, MarkConflicts,
>+ Intersection, Complement, AllowConflicts,
>+ NoAllowConflicts ),
>hunk ./src/Darcs/Commands/Pull.lhs 110
>-
>-pull_cmd opts unfixedrepodirs@(_:_) =
>- let (logMessage, _, logDocLn) = loggers opts
>- putInfo = if (Quiet `elem` opts || XMLOutput `elem` opts) then \_ -> return () else logDocLn
>- putVerbose = if Verbose `elem` opts then putDocLn else \_ -> return ()
>- in withRepoLock opts $- \repository -> do
>+pull_cmd opts unfixedrepodirs@(_:_) = withRepoLock opts $- \repository ->
>- in putInfo $ text $ pulling++" from "++concatMap formatPath repodirs++"..."
>+ in putInfo opts $ text $ pulling++" from "++concatMap formatPath repodirs++"..."
>hunk ./src/Darcs/Commands/Pull.lhs 136
>- $$ (vcat $ mapFL description ps)
>- when (nullFL ps) $ do putInfo $ text "No remote changes to pull in!"
>- definePatches ps
>- exitWith ExitSuccess
>+ $$ (vcat $ mapFL description ps)
>+ when (nullFL ps) $ do putInfo opts $ text "No remote changes to pull in!"
>+ definePatches ps
>+ exitWith ExitSuccess
>hunk ./src/Darcs/Commands/Pull.lhs 141
>- \ (to_be_pulled:>_) -> do
>- print_dry_run_message_and_exit "pull" opts to_be_pulled
>- definePatches to_be_pulled
>- when (nullFL to_be_pulled) $ do
>- logMessage "You don't want to pull any patches, and that's fine
> with me!" - exitWith ExitSuccess
>- check_paths opts to_be_pulled
>- putVerbose $ text "Getting and merging the following patches:"
>- putVerbose $ vcat $ mapFL description to_be_pulled
>- let merge_opts | NoAllowConflicts `elem` opts = opts
>- | AllowConflicts `elem` opts = opts
>- | otherwise = MarkConflicts : opts
>- Sealed pw <- tentativelyMergePatches repository "pull" merge_opts
>- (reverseRL us') to_be_pulled
>- invalidateIndex repository
>- withGutsOf repository $ do finalizeRepositoryChanges repository
>+ \ (to_be_pulled:>_) ->
>+ do
>+ print_dry_run_message_and_exit "pull" opts to_be_pulled
>+ definePatches to_be_pulled
>+ when (nullFL to_be_pulled) $ do
>+ putStrLn "You don't want to pull any
> patches, and that's fine with me!" + exitWith
> ExitSuccess
>+ check_paths opts to_be_pulled
>+ putVerbose opts $ text "Getting and merging the following
> patches:" + putVerbose opts $ vcat $ mapFL description
> to_be_pulled + let merge_opts | NoAllowConflicts `elem` opts =
> opts
>+ | AllowConflicts `elem` opts = opts
>+ | otherwise = MarkConflicts :
> opts + Sealed pw <- tentativelyMergePatches repository "pull"
> merge_opts + (reverseRL us') to_be_pulled
>+ invalidateIndex repository
>+ withGutsOf repository $ do finalizeRepositoryChanges repository
Change the calls to putVerbose to include the extra argument, and adjust
some whitespace here and there.
> hunk ./src/Darcs/Commands/Pull.lhs 159
> - revertable $ do wait_a_moment
> - applyToWorking repository opts pw
> - sync_repo repository
> - putInfo $ text "Finished pulling and applying."
> - where revertable x = x `clarifyErrors` unlines
> - ["Error applying patch to the working directory.","",
> - "This may have left your working directory an inconsistent",
> - "but recoverable state. If you had no un-recorded changes",
> - "by using 'darcs revert' you should be able to make your",
> - "working directory consistent again."]
> + revertable $ do wait_a_moment
> + applyToWorking repository opts pw
> + sync_repo repository
> + putInfo opts $ text "Finished pulling and applying."
> +
Here you change the scope of the 'revertable' in the top line to cover only
wait_a_moment, not applyToWorking. Why is that?
The rest of the bundle contains a lot of boring changes where old
flag-parsing is removed in favor of the new functions. Until:
> [Use Commands.putInfo in Push
> Florent Becker <florent.becker at ens-lyon.org>**20090929151632
> Ignore-this: 3492a41ad1aa411ff8c3434abcee8e7
> ] hunk ./src/Darcs/Commands/Pull.lhs 213
>
> If you provide more than one repository as an argument to pull, darcs'
> behavior is determined by the presence of the \verb!--complement!,
>-\verb!--intersection!, and \verb!--union! flags.
>+\verb!--intersection!, and \verb!--union! flags.
Why fix a whitespace issue in Pull.lhs in a patch that pertains to Push.lhs
according to its name?
> hunk ./src/Darcs/Commands/Push.lhs 51
> -import Printer ( vcat, empty, text, ($$), (<+>), putDocLn, errorDoc )
> +import Printer ( Doc, vcat, empty, text, ($$), (<+>), errorDoc )
Why import the Doc type here?
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 197 bytes
Desc: This is a digitally signed message part.
URL: <http://lists.osuosl.org/pipermail/darcs-users/attachments/20091004/0d36b7f1/attachment.pgp>
More information about the darcs-users
mailing list