[darcs-users] darcs patch: make rollback smarter about breaking up ... (and 5 more)

Reinier Lamers tux_rocker at reinier.de
Wed Mar 18 19:14:15 UTC 2009


Hello,

On Monday 16 March 2009 19:22:17 Eric Kow wrote:
> Reinier: would you be interested in reviewing any of the patches below? 
> Note that one of these patches fixes issue1255.

It's so big with all the context it's even giving my mail client's editor a 
hard time :-(. Anyway, here's a review.

>[make rollback smarter about breaking up changes.
>David Roundy <droundy at darcs.net>**20081115212255
> Ignore-this: b822d3d1d1e3263c8cf183fffe754e5a
>] hunk ./src/Darcs/Commands/Rollback.lhs 45
>                           read_repo, slurp_recorded,
>                           tentativelyMergePatches, withGutsOf,
>                           finalizeRepositoryChanges, sync_repo )
>-import Darcs.Patch ( summary, invert, namepatch, effect, fromPrims,
> sort_coalesceFL ) +import Darcs.Patch ( summary, invert, namepatch, effect,
> fromPrims, +                     sort_coalesceFL, canonize )
> import Darcs.Ordered
> import Darcs.Hopefully ( n2pia )
> import Darcs.Lock ( world_readable_temp )
>hunk ./src/Darcs/Commands/Rollback.lhs 126
>                              exitWith ExitSuccess
>        definePatches ps
>        with_selected_last_changes_to_files' "rollback" opts
>-               existing_files (sort_coalesceFL $ effect ps) $ \ (_:>ps'')
> -> +               existing_files (concatFL $ mapFL_FL canonize $
>+                               sort_coalesceFL $ effect ps) $ \ (_:>ps'')
> -> do when (nullFL ps'') $ do logMessage "No changes selected!" exitWith
> ExitSuccess
>             let make_log = world_readable_temp "darcs-rollback"

This canonizes the patches before rolling them back. While this doesn't hurt, 
I don't see why this is an improvement. Haven't they been canonized when they 
were recorded?

>[fix bug in put of darcs-1 format repositories.
>David Roundy <droundy at darcs.net>**20090214214640
> Ignore-this: 71ec341ecd24386450cf999b193e96fef0cf1cb1
>] hunk ./src/Darcs/Commands/Put.lhs 96
>                 else if format_has HashedInventory rf &&
>                         not (UseOldFashionedInventory `elem` opts)
>                      then UseHashedInventory:filter (/= UseFormat2) opts
>-                     else filter (/= UseFormat2) opts
>+                     else UseOldFashionedInventory:filter (/= UseFormat2)
> opts if is_file req_absolute_repo_dir
>      then do createDirectory req_absolute_repo_dir
>              withCurrentDirectory req_absolute_repo_dir $ (command_command
> initialize) initopts

I suppose this makes darcs really create an old-fashioned inventory when the 
user tells it to do so, when putting a darcs-1 repo.

> [] [use exitWith under record, when no patches are
> selected (to not run posthook). David Roundy
> <droundy at darcs.net>**20081117155910
> Ignore-this: fbd2af867aab26093ab216092e8fa8d0
>] hunk ./src/Darcs/Commands/Record.lhs 30
> import Control.Monad ( filterM, when )
> import System.IO ( hGetContents, stdin )
> import Data.List ( sort, isPrefixOf )
>-import System.Exit ( exitFailure, ExitCode(..) )
>+import System.Exit ( exitWith, exitFailure, ExitCode(..) )
> import System.IO ( hPutStrLn )
> import System.Directory ( doesFileExist, doesDirectoryExist, removeFile )
> import Data.Maybe ( isJust )
>hunk ./src/Darcs/Commands/Record.lhs 198
>     debugMessage "About to select changes..."
>     with_selected_changes_to_files' "record" opts
>       (map toFilePath files) ps $ \ (chs:>_) ->
>-      if is_empty_but_not_askdeps chs
>-        then putStrLn "Ok, if you don't want to record anything, that's
> fine!" -        else handleJust only_successful_exits (\_ -> return ()) $
>+      do when (is_empty_but_not_askdeps chs) $
>+              do putStrLn "Ok, if you don't want to record anything, that's
> fine!" +                 exitWith ExitSuccess
>+         handleJust only_successful_exits (\_ -> return ()) $
>              do deps <- if AskDeps `elem` opts
>                         then ask_about_depends repository chs opts
>                         else return []

Like Trent, I prefer reaching the end of a function over explicitly calling 
exitWith. But it seems to be the right thing not to run the posthook if the 
record aborts - and I'm not an absolutist when it comes to style. I'd apply 
this one.

>[eliminate gratuitous use of Reader monad in Printer.
>David Roundy <droundy at darcs.net>**20081209155810
> Ignore-this: 7208dc721584803e7f2aca04a059db2c
>hunk ./src/Printer.lhs 151
>
> -- | a 'Doc' is a bit of enriched text. 'Doc's get concatanated using
> -- '<>', which is right-associative.
>-newtype Doc = Doc { unDoc :: Reader St Document }
>+newtype Doc = Doc { unDoc :: St -> Document }
>
> -- | The State associated with a doc. Contains a set of printers for each
> -- hanlde, and the current prefix of the document.

So this is the important bit: go from a Reader St Document to a function from 
St to Document. It's only a change in the way of thinking about it, a Reader 
St Document is also really an St -> Document.

It seems to be a good change: the code becomes shorter, and it stays at least 
as easy to comprehend.

What follows is a lot of changing code to strip it off the Reader monad stuff. 
I only comment on hunks where I have more to say than "alright".

>hunk ./src/Printer.lhs 226
> init_state prs = St { printers = prs, current_prefix = id }
>
> prefix :: String -> Doc -> Doc
>-prefix s (Doc d) =
>-    Doc $ local (\st -> st { current_prefix = current_prefix st . (p:) })
>-                   (do d' <- d
>-                       case d' of
>-                           Document d'' -> return $ Document $ (p:) . d''
>-                           Empty -> return Empty)
>-    where p = S s
>+prefix s (Doc d) = Doc $ \st ->
>+                   let p = S s
>+                       st' = st { current_prefix = current_prefix st . (p:)
> } in +                   case d st' of
>+                     Document d'' -> Document $ (p:) . d''
>+                     Empty -> Empty

I do not understand what the current_prefix field in the state is for, but it 
looks like this one also follows logically from the Reader-to-function change. 
Nitpick: d'' can become d' because the original d' is gone.

> hiddenPrefix :: String -> Doc -> Doc
> hiddenPrefix s (Doc d) =
>hunk ./src/Printer.lhs 239
>-    Doc $ do pr <- asks printers
>-             let p = S (renderStringWith pr $ hiddenText s)
>-             local (\st -> st { current_prefix = current_prefix st . (p:)
> }) -                       (do d' <- d
>-                           case d' of
>-                             Document d'' -> return $ Document $ (p:) . d''
>-                             Empty -> return Empty)
>+    Doc $ \st -> let pr = printers st
>+                     p = S (renderStringWith pr $ hiddenText s)
>+                     st' = st { current_prefix = current_prefix st . (p:) }
>+                 in case d st' of
>+                      Document d'' -> Document $ (p:) . d''
>+                      Empty -> Empty

Analogous to prefix above. And again d'' could be d'.

>hunk ./src/Printer.lhs 271
>
> -- | 'unsafeChar' creates a Doc containing just one character.
> unsafeChar :: Char -> Doc
>-unsafeChar = unsafeText . return
>+unsafeChar = unsafeText . (:"")

Again, correct but could be more stylish. '(:"")' is more intelligible if it's 
written as 'singleton'.

>[clean up Depends a wee tad
>David Roundy <droundy at darcs.net>**20081209180547
> Ignore-this: 3e49dd4bb769fc412249f4ee0fc16dfe
>] hunk ./src/Darcs/Patch/Depends.hs 34
>-import Control.Monad.Error (Error(..), MonadError(..))
>+import Control.Monad.Error ( Error(..) )
>hunk ./src/Darcs/Patch/Depends.hs 301
>                          $$ human_friendly (info $ n2pia hpc)
>       where ep = case hopefullyM hp of
>                  Right p' -> return p'
>-                 Left e -> throwError (MissingPatch (info hp) e)
>+                 Left e -> Left (MissingPatch (info hp) e)

This saves us an import, and Left looks more idiomatic to me than throwError.

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/20090318/d04aa136/attachment.pgp>


More information about the darcs-users mailing list