[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