[darcs-users] darcs patch: add utility functions to Commands.lhs (and 5 more)

Reinier Lamers tux_rocker at reinier.de
Sat Sep 26 20:37:44 UTC 2009


Hi all,

Here's a review of the first two patches. I want to know if you really want to undo some changes that your patches have conflicted with. If so, I will push it, otherwise, please amend.

>[add utility functions to Commands.lhs
>Florent Becker <florent.becker at ens-lyon.org>**20090910142708
> Ignore-this: 742bed2e28038fe080021457dec45d36
>] hunk ./src/Darcs/Commands.lhs 41
>+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 =
>+    when  (not (Quiet `elem` opts || XMLOutput `elem` opts)) .
>+          putDocLn

These changes offer some useful functionality, but they do suffer from the problems inherent in the current [DarcsFlag] paradigm of command line handling. It seems that when you specify both --quiet and --verbose, you get the debug output but not the info output.

Also, isn't it a better idea to write verbose output to standard error (putVerbose writes to stdout)? Now you can get verbose output in your XML when you use --verbose and --xml-output at the same time.

>hunk ./src/Darcs/Commands/Pull.lhs 109
> pull_cmd :: [DarcsFlag] -> [String] -> IO ()
>
> 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
>-  here <- getCurrentDirectory
>-  repodirs <- (nub . filter (/= here)) `fmap` mapM (fixUrl opts) unfixedrepodirs
>-  -- Test to make sure we aren't trying to pull from the current repo
>-  when (null repodirs) $
>+    withRepoLock opts $- \repository -> do
>+      here <- getCurrentDirectory
>+      repodirs <- (nub . filter (/= here)) `fmap` mapM (fixUrl opts) unfixedrepodirs
>+      -- Test to make sure we aren't trying to pull from the current repo
>+      when (null repodirs) $

Ah, this makes clear makes clear why defining putVerbose and putInfo globally really makes things better.

>conflictor [
>hunk ./src/Darcs/Commands/Pull.lhs 127
>-  let avoided = mapRL info (concatRL compl')
>-  ps :> _ <- return $ partitionFL (not . (`elem` avoided) . info) $ reverseRL $ concatRL them''
>+  let avoided = mapRL info compl'
>+  ps :> _ <- return $ partitionFL (not . (`elem` avoided) . info) $ reverseRL them '' ]
>
>hunk ./src/Darcs/Commands/Pull.lhs 115
>-  (Sealed them, Sealed compl) <- read_repos repository opts repodirs
>-  old_default <- get_preflist "defaultrepo"
>-  set_defaultrepo (head repodirs) opts
>-  mapM_ (add_to_preflist "repos") repodirs
>-  when (old_default == repodirs) $
>-      let pulling = if DryRun `elem` opts then "Would pull" else "Pulling"
>-      in  putInfo $ text $ pulling++" from "++concatMap formatPath repodirs++"..." -  mapM_ (show_motd opts) repodirs
>-  us <- read_repo repository
>-  (common, us' :\/: them'') <- return $ get_common_and_uncommon (us, them)
>-  (_     ,   _ :\/: compl') <- return $ get_common_and_uncommon (us, compl)
>-  checkUnrelatedRepos opts common us them
>-  let avoided = mapRL info (concatRL compl')
>-  ps :> _ <- return $ partitionFL (not . (`elem` avoided) . info) $ reverseRL $ concatRL them''
>-  do when (Verbose `elem` opts) $
>+      (Sealed them, Sealed compl) <- read_repos repository opts repodirs
>+      old_default <- get_preflist "defaultrepo"
>+      set_defaultrepo (head repodirs) opts
>+      mapM_ (add_to_preflist "repos") repodirs
>+      when (old_default == repodirs) $
>+           let pulling = if DryRun `elem` opts then "Would pull" else
> "Pulling" +           in  putInfo opts $ text $ pulling++" from
> "++concatMap formatPath repodirs++"..." +      mapM_ (show_motd opts)
> repodirs
>+      us <- read_repo repository
>+      (common, us' :\/: them'') <- return $ get_common_and_uncommon (us,
> them) +      (_     ,   _ :\/: compl') <- return $ get_common_and_uncommon
> (us, compl) +      checkUnrelatedRepos opts common us them
>+      let avoided = mapRL info (concatRL compl')
>+      ps :> _ <- return $ partitionFL (not . (`elem` avoided) . info) $
> reverseRL $ concatRL them'' +      when (Verbose `elem` opts) $


Almost purely an indentation patch. But it undoes the change that it conflicts with! Is that really what you want?

> conflictor [
> hunk ./src/Darcs/Commands/Pull.lhs 152
> -      Sealed pw <- tentativelyMergePatches repository "pull" merge_opts
> -                   (reverseRL $ head $ unsafeUnRL us') to_be_pulled
> +      Sealed pw <- case us' of
> +                     h_us :<: NilRL -> tentativelyMergePatches repository "pull" merge_opts
> +                                        (reverseRL h_us) to_be_pulled
> +                     _ -> impossible -- we believe that get_common_and_uncommon should guarantee this,
> +                                     -- at least in this case. Error out if we're wrong, so that
> +                                     -- we find out. An alternative would be to do a concatRL of the whole
> +                                     -- us' list, but the code originally just took the head, and so we
> +                                     -- might instead introduce some subtle bug by doing a concat.
> hunk ./src/Darcs/Commands/Pull.lhs 152
> -      Sealed pw <- case us' of
> -                     h_us :<: NilRL -> tentativelyMergePatches repository "pull" merge_opts
> -                                        (reverseRL h_us) to_be_pulled
> -                     _ -> impossible -- we believe that get_common_and_uncommon should guarantee this,
> -                                     -- at least in this case. Error out if we're wrong, so that
> -                                     -- we find out. An alternative would be to do a concatRL of the whole
> -                                     -- us' list, but the code originally just took the head, and so we
> -                                     -- might instead introduce some subtle bug by doing a concat.
> +      Sealed pw <- tentativelyMergePatches repository "pull" merge_opts
> +                   (reverseRL us') to_be_pulled
> hunk ./src/Darcs/Commands/Pull.lhs 139
> -     with_selected_changes "pull" opts ps $
> +     with_selected_changes "pull" opts Nothing ps $
> ]
> :
> hunk ./src/Darcs/Commands/Pull.lhs 135
> -                                                 $$ (vcat $ mapFL description ps)
> -     when (nullFL ps) $ do putInfo $ text "No remote changes to pull in!"
> -                           definePatches ps
> -                           exitWith ExitSuccess
> -     with_selected_changes "pull" opts ps $
> -      \ (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 $ head $ unsafeUnRL us') to_be_pulled
> -      invalidateIndex repository
> -      withGutsOf repository $ do finalizeRepositoryChanges repository
> -                                 -- so work will be more recent than rec:
> -                                 revertable $ do wait_a_moment
> -                                                 applyToWorking repository opts pw
> -      sync_repo repository
> -      putInfo $ text "Finished pulling and applying."
> -          where revertable x = x `clarify_errors` 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."]
> +                                       $$ (vcat $ mapFL description ps)
> +      when (nullFL ps) $ do putDocLn $ text "No remote changes to pull in!"
> +                            definePatches ps
> +                            exitWith ExitSuccess
> +      with_selected_changes "pull" opts ps $
> +                                \ (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 $ head $ unsafeUnRL us') to_be_pulled
> +                                         invalidateIndex repository
> +                                         withGutsOf repository $ do finalizeRepositoryChanges repository
> +                                                      -- so work will be more recent than rec:
> +                                                                    revertable $ do wait_a_moment
> +                                                                    applyToWorking repository opts pw
> +                                                                    sync_repo repository
> +                                         putInfo opts $ text "Finished pulling and applying."

Was it really necessary to change the indentation by 1 space? :-/ That, combined with the seemingly strange conflict, does not make your reviewer happy.

It appears to undo the third conflicted patch. Again, is that what you want? For the rest, it appears fine.

>+revertable :: IO a -> IO a
>+revertable x =
>+    x `clarify_errors` 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."]
>+
>+

Give revertable to its own top-level definition. Seems fine.

Lots of places where you replace logMessage by putStrLn follow.

Regards,
Reinier


-------------- 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/20090926/20c8f2cd/attachment.pgp>


More information about the darcs-users mailing list