[darcs-devel] A forwarded darcs patch

Juliusz Chroboczek jch at pps.jussieu.fr
Mon Jun 14 16:03:57 PDT 2004


The following patch was either unsigned, or signed by a non-allowed
key, or there was a gpg failure.

>From jch at pps.jussieu.fr Mon Jun 14 19:03:57 2004
Return-path: <jch at pps.jussieu.fr>
Envelope-to: droundy at abridgegame.org
Delivery-date: Mon, 14 Jun 2004 19:03:57 -0400
Received: from postfix4-1.free.fr ([213.228.0.62])
	by www.abridgegame.org with esmtp (Exim 3.35 #1 (Debian))
	id 1Ba0Ue-0005x9-00
	for <droundy at abridgegame.org>; Mon, 14 Jun 2004 19:03:56 -0400
Received: from trurl (drac-1-82-225-44-56.fbx.proxad.net [82.225.44.56])
	by postfix4-1.free.fr (Postfix) with ESMTP id CD742143690
	for <droundy at abridgegame.org>; Tue, 15 Jun 2004 01:03:54 +0200 (CEST)
Received: from jch by trurl with local (Exim 4.32)
	id 1Ba0Ud-000600-EY
	for droundy at abridgegame.org; Tue, 15 Jun 2004 01:03:55 +0200
To: Davids Darcs Repo <droundy at abridgegame.org>
Subject: darcs patch
DarcsURL: http://abridgegame.org/repos/darcs
Content-Type: multipart/mixed; boundary="aaack"
Message-Id: <E1Ba0Ud-000600-EY at trurl>
Sender: Juliusz Chroboczek <jch at pps.jussieu.fr>
Date: Tue, 15 Jun 2004 01:03:55 +0200

--aaack


Tue Jun 15 00:12:12 CEST 2004  Juliusz Chroboczek <jch at pps.jussieu.fr>
  * Implement withCurrentDirectory.

Tue Jun 15 00:58:21 CEST 2004  Juliusz Chroboczek <jch at pps.jussieu.fr>
  * Use withCurrentDirectory.
  Replace setCurrentDirectory usages with withCurrentDirectory, which
  ensures bracketing.  This does not replace all uses, just the more
  obvious ones.


--aaack
Content-Type: text/x-darcs-patch
Content-Description: A darcs patch for your repository!


New patches:

[Implement withCurrentDirectory.
Juliusz Chroboczek <jch at pps.jussieu.fr>**20040614221212] {
hunk ./DarcsUtils.lhs 6
-                    putStrError, putStrLnError ) where
+                    putStrError, putStrLnError,
+                    withCurrentDirectory ) where
hunk ./DarcsUtils.lhs 11
+import IO ( bracket )
+import Directory ( setCurrentDirectory )
+import Workaround ( getCurrentDirectory )
+import Monad ( when )
hunk ./DarcsUtils.lhs 34
+
+withCurrentDirectory :: FilePath -> IO a -> IO a
+withCurrentDirectory name m = 
+    bracket 
+        (do cwd <- getCurrentDirectory
+            when (name /= "") (setCurrentDirectory name)
+            return cwd)
+        (\oldwd -> do setCurrentDirectory oldwd)
+        (const m)
}

[Use withCurrentDirectory.
Juliusz Chroboczek <jch at pps.jussieu.fr>**20040614225821
 Replace setCurrentDirectory usages with withCurrentDirectory, which
 ensures bracketing.  This does not replace all uses, just the more
 obvious ones.
] {
hunk ./Add.lhs 28
-import Directory ( setCurrentDirectory )
-import Workaround ( getCurrentDirectory )
+import DarcsUtils ( withCurrentDirectory )
hunk ./Add.lhs 144
-     else do formerdir <- getCurrentDirectory
-             setCurrentDirectory f
-             fs <- list_files
-             setCurrentDirectory formerdir
+     else do fs <- withCurrentDirectory f list_files
hunk ./Apply.lhs 26
-import Directory hiding ( getCurrentDirectory )
-import Workaround ( getCurrentDirectory )
+import DarcsUtils ( withCurrentDirectory )
hunk ./Apply.lhs 115
-  former_dir <- getCurrentDirectory
hunk ./Apply.lhs 173
-                setCurrentDirectory "_darcs/current"
hunk ./Apply.lhs 174
-                  slurp_write_dirty rec'
-                  wait_a_moment
-                  setCurrentDirectory former_dir
+                  withCurrentDirectory "_darcs/current" $
+                    do  slurp_write_dirty rec'
+                        wait_a_moment
+                        return ()
hunk ./Check.lhs 20
-import Directory ( setCurrentDirectory )
hunk ./Check.lhs 89
-  formerdir <- getCurrentDirectory
+  cwd <- getCurrentDirectory
hunk ./Check.lhs 101
-    is_same <- cmp (formerdir++"/_darcs/current") chd
+    is_same <- cmp (cwd++"/_darcs/current") chd
hunk ./Check.lhs 107
-           else do setCurrentDirectory formerdir
-                   ec <- run_test opts chd
+           else do ec <- run_test opts chd
hunk ./Check.lhs 110
-              c <- slurp (formerdir++"/_darcs/current")
+              c <- slurp (cwd++"/_darcs/current")
hunk ./DarcsArguments.lhs 53
-import Workaround ( getCurrentDirectory )
hunk ./DarcsArguments.lhs 60
-import DarcsUtils ( catchall, ortryrunning )
+import DarcsUtils ( catchall, ortryrunning, withCurrentDirectory )
hunk ./DarcsArguments.lhs 657
-    former_dir <- getCurrentDirectory
hunk ./DarcsArguments.lhs 661
-    setCurrentDirectory former_dir
hunk ./DarcsArguments.lhs 668
-       then do former_dir <- getCurrentDirectory
-               setCurrentDirectory f
-               fnames <- skip_boring `liftM` getDirectoryContents "."
-               subdirlist <- do_this_list skip_boring fnames
-               setCurrentDirectory former_dir
-               rest <- do_this_list skip_boring fs
-               return $ f : rest ++ map ((++) (f++"/")) subdirlist
-               --return $ rest ++ map ((++) (f++"/")) subdirlist
+       then do
+            subdirlist <- 
+                (withCurrentDirectory f $
+                 do fnames <- skip_boring `liftM` getDirectoryContents "."
+                    do_this_list skip_boring fnames)
+            rest <- do_this_list skip_boring fs
+            return $ f : rest ++ map ((++) (f++"/")) subdirlist
+            --return $ rest ++ map ((++) (f++"/")) subdirlist
hunk ./DarcsArguments.lhs 685
-list_registered_files = do former_dir <- getCurrentDirectory
-                           setCurrentDirectory "_darcs/current"
-                           files <- list_files
-                           setCurrentDirectory former_dir
-                           return files
+list_registered_files = withCurrentDirectory "_darcs/current" list_files
hunk ./DiffCommand.lhs 19
-import Directory ( setCurrentDirectory )
hunk ./DiffCommand.lhs 20
+import DarcsUtils ( withCurrentDirectory )
hunk ./DiffCommand.lhs 118
-    setCurrentDirectory odir
-    if first_match opts
-      then get_first_match formerdir opts
-      else do recorded <- slurp_recorded formerdir
-              slurp_write recorded
-    setCurrentDirectory ndir
-    if second_match opts
-      then get_second_match formerdir opts
-      else do recorded_with_pending <- slurp_pending formerdir
-              latest <- co_slurp recorded_with_pending formerdir
-              slurp_write latest
-    setCurrentDirectory $ odir++"/.."
+    withCurrentDirectory odir $
+      do if first_match opts
+            then get_first_match formerdir opts
+            else do recorded <- slurp_recorded formerdir
+                    slurp_write recorded
+    withCurrentDirectory ndir $
+      do if second_match opts
+            then get_second_match formerdir opts
+            else do recorded_with_pending <- slurp_pending formerdir
+                    latest <- co_slurp recorded_with_pending formerdir
+                    slurp_write latest
hunk ./DiffCommand.lhs 130
-      [] -> rundiff (just_dir odir) (just_dir ndir)
-      fs -> concat `liftM` mapM (\f -> rundiff
-                                 (just_dir odir ++ "/" ++ f)
-                                 (just_dir ndir ++ "/" ++ f)) fs
-    setCurrentDirectory formerdir
+               [] -> rundiff (just_dir odir) (just_dir ndir)
+               fs -> concat `liftM` mapM (\f -> rundiff
+                                          (just_dir odir ++ "/" ++ f)
+                                          (just_dir ndir ++ "/" ++ f)) fs
hunk ./Get.lhs 22
-                   createDirectory,
-                 )
+                   createDirectory )
hunk ./Lock.lhs 44
+import DarcsUtils ( withCurrentDirectory )
hunk ./Lock.lhs 102
-                  rd -> do cd <- getCurrentDirectory
-                           setCurrentDirectory rd
-                           fd <- getCurrentDirectory
-                           setCurrentDirectory cd
-                           return $ fd ++ "/" ++ simplefilename
+                  rd -> withCurrentDirectory rd $
+                          do fd <- getCurrentDirectory
+                             return $ fd ++ "/" ++ simplefilename
hunk ./Lock.lhs 243
-                             setCurrentDirectory d
-                             sequence_ $ map rm_recursive conts
+                             withCurrentDirectory d $
+                               (sequence_ $ map rm_recursive conts)
hunk ./Optimize.lhs 19
-import System.Directory ( setCurrentDirectory )
+import DarcsUtils ( withCurrentDirectory )
hunk ./Optimize.lhs 139
-    setCurrentDirectory "_darcs/patches"
-    sequence_ $ map (do_compress.make_filename.fst) $ concat r
-    setCurrentDirectory "../.."
+    withCurrentDirectory "_darcs/patches"
+        (sequence_ $ map (do_compress.make_filename.fst) $ concat r)
hunk ./Population.lhs 35
-import Directory ( setCurrentDirectory,
-                   doesDirectoryExist, getDirectoryContents )
-import Workaround ( getCurrentDirectory )
+import Directory ( doesDirectoryExist, getDirectoryContents )
+import DarcsUtils ( withCurrentDirectory )
hunk ./Population.lhs 122
-getPopFrom the_directory pinfo
-  = do former_dir <- getCurrentDirectory
-       setCurrentDirectory the_directory
-       popT <- getPopFrom_helper "."
-       setCurrentDirectory former_dir
-       return (Pop pinfo popT)
+getPopFrom the_directory pinfo =
+    withCurrentDirectory the_directory $
+       do popT <- getPopFrom_helper "."
+          return (Pop pinfo popT)
hunk ./Population.lhs 132
-           former_dir <- getCurrentDirectory
hunk ./Population.lhs 133
-           setCurrentDirectory dirname
-           sl <- sequence $ map getPopFrom_helper $ filter not_hidden fnames
-           setCurrentDirectory former_dir
+           sl <- withCurrentDirectory dirname
+                 (sequence $ map getPopFrom_helper $ filter not_hidden fnames)
hunk ./Repository.lhs 65
+import DarcsUtils ( withCurrentDirectory )
hunk ./Repository.lhs 428
-          former_dir <- getCurrentDirectory
-          setCurrentDirectory dir
-          realdir <- getCurrentDirectory -- This one is absolute!
-          setCurrentDirectory former_dir
+          realdir <- withCurrentDirectory dir getCurrentDirectory
+                     -- This one is absolute!
hunk ./Repository.lhs 484
-    repodir <-  getCurrentDirectory
hunk ./Repository.lhs 488
-      s <- if use_mmap then mmap_slurp "." else slurp "."
-      setCurrentDirectory repodir
+      s <- withCurrentDirectory "" $
+             if use_mmap then mmap_slurp "." else slurp "."
hunk ./SlurpDirectory.lhs 47
+import DarcsUtils ( withCurrentDirectory )
hunk ./SlurpDirectory.lhs 169
-       then do
-            setCurrentDirectory dirname
-            actualname <- getCurrentDirectory
-            Just slurpy <- genslurp_helper usemm nb actualname "" "."
-            setCurrentDirectory former_dir
-            return slurpy
+       then withCurrentDirectory dirname $
+            do actualname <- getCurrentDirectory
+               Just slurpy <- genslurp_helper usemm nb actualname "" "."
+               return slurpy
hunk ./SlurpDirectory.lhs 212
-       then do
-            former_dir <- getCurrentDirectory
-            setCurrentDirectory dirname
-            actualname <- getCurrentDirectory
-            Just slurpy <- co_slurp_helper actualname guide
-            setCurrentDirectory former_dir
-            return slurpy
+       then withCurrentDirectory dirname $ do
+              actualname <- getCurrentDirectory
+              Just slurpy <- co_slurp_helper actualname guide
+              return slurpy
hunk ./SlurpDirectory.lhs 250
-                 (_,"") -> do fd <- getCurrentDirectory
-                              setCurrentDirectory parentdir
-                              absd <- getCurrentDirectory
-                              setCurrentDirectory fd
+                 (_,"") -> do absd <- withCurrentDirectory parentdir $
+                                        getCurrentDirectory
hunk ./SlurpDirectory.lhs 514
-slurp_write (SlurpDir d p ss) = block $ do
-  former_dir <- getCurrentDirectory
-  isdir <- doesDirectoryReallyExist $ fn2fp d
-  unless isdir $ createDirectory $ fn2fp d
-  setCurrentDirectory $ fn2fp d
-  runpatch p
-  sequence_ $ map slurp_write ss
-  setCurrentDirectory former_dir
+slurp_write (SlurpDir d p ss) = block $ 
+  do isdir <- doesDirectoryReallyExist $ fn2fp d
+     unless isdir (createDirectory $ fn2fp d)
+     withCurrentDirectory (fn2fp d) $
+       do runpatch p
+          sequence_ $ map slurp_write ss
hunk ./SlurpDirectory.lhs 549
-slurp_write_dirty (SlurpDir d p ss) = block $ do
-  former_dir <- getCurrentDirectory
-  setCurrentDirectory $ fn2fp d
-  runpatch p
-  sequence_ $ map slurp_write_dirty ss
-  setCurrentDirectory former_dir
+slurp_write_dirty (SlurpDir d p ss) = block $ 
+  withCurrentDirectory (fn2fp d) $
+    do runpatch p
+       sequence_ $ map slurp_write_dirty ss
hunk ./SlurpDirectory.lhs 559
-slurp_write_and_read_dirty (SlurpDir d Nothing ss) = block $ do
-  former_dir <- getCurrentDirectory
-  setCurrentDirectory $ fn2fp d
-  ss' <- sequence $ map slurp_write_and_read_dirty ss
-  setCurrentDirectory former_dir
-  return $ SlurpDir d nopatch ss'
+slurp_write_and_read_dirty (SlurpDir d Nothing ss) = 
+  block $
+    do ss' <- withCurrentDirectory (fn2fp d) $ 
+                (sequence $ map slurp_write_and_read_dirty ss)
+       return $ SlurpDir d nopatch ss'
hunk ./SlurpDirectory.lhs 565
-    = do formerdir <- getCurrentDirectory
-         setCurrentDirectory (fn2fp d)
-         slurp_write_dirty s
-         setCurrentDirectory formerdir
+    = do withCurrentDirectory (fn2fp d) $ slurp_write_dirty s
hunk ./Test.lhs 20
+import DarcsUtils ( withCurrentDirectory )
hunk ./Test.lhs 52
-                           setCurrentDirectory testdir
-                           test
+                           withCurrentDirectory testdir test
hunk ./Test.lhs 77
-   formerdir <- getCurrentDirectory
hunk ./Test.lhs 81
-       slurp_write $ launder_slurpy s
-       setCurrentDirectory formerdir
+       withCurrentDirectory "" (slurp_write $ launder_slurpy s)
hunk ./Unrecord.lhs 19
-import Directory ( setCurrentDirectory )
-import Workaround ( getCurrentDirectory )
+import DarcsUtils ( withCurrentDirectory )
hunk ./Unrecord.lhs 112
-          former_dir <- getCurrentDirectory
hunk ./Unrecord.lhs 113
-          setCurrentDirectory "_darcs/current"
-          slurp_write_dirty recorded'
-          setCurrentDirectory former_dir
+          withCurrentDirectory "_darcs/current" $
+              slurp_write_dirty recorded'
hunk ./Unrecord.lhs 216
-                former_dir <- getCurrentDirectory
-                setCurrentDirectory "_darcs/current"
-                slurp_write_dirty rec'
-                setCurrentDirectory former_dir
+                withCurrentDirectory "_darcs/current" $
+                    slurp_write_dirty rec'
}



Context:

[Make locks work on non-POSIX filesystems.
Juliusz Chroboczek <jch at pps.jussieu.fr>**20040613225300
 Probably Linux-specific.
] 
[Better error reporting for lockfile creation.
Juliusz Chroboczek <jch at pps.jussieu.fr>**20040613223236] 
[mention darcs-devel on website.
David Roundy <droundy at abridgegame.org>**20040613111107] 
[fix bug when specifying logfile in a subdirectory.
David Roundy <droundy at abridgegame.org>**20040613110227
 Darcs wasn't correcting the relative path of the logfile, and thus was
 losing the logfile.
] 
[web page fixes.
David Roundy <droundy at abridgegame.org>**20040613104246] 
[give nice error message when adding a file to a directory that isn't in the repo.
David Roundy <droundy at abridgegame.org>**20040613103521] 
[support backslashes for directory separators in windows.
David Roundy <droundy at abridgegame.org>**20040613101834] 
[make windows link go to wiki page.
David Roundy <droundy at abridgegame.org>**20040613095337] 
[fix make install-server problem with darcs.cgi when making debs.
David Roundy <droundy at abridgegame.org>**20040613095307] 
[Install xslt files with appropriate perms
Nigel Rowe <rho at swiftdsl.com.au>**20040612113632] 
[Avoid unpacking PackedStrings in the printer.
jch at pps.jussieu.fr**20040613000234
 Darcs reads file data into PackedStrings, but unpacks them when
 printing out a patch.
       
 The fix is to make the printer able to grok streams of arbitrary
 tokens, not just Haskell strings (streams of Char).  See the type
 class Printer.Printable and the instance Printer.PChar.  See also the
 type synonim PrintPatch.PrinterType, which is what gets actually used.
 
 The net effect is that darcs whatsnew is more than twice as fast, and
 darcs pull of large patches uses 10 (!) times less memory.  On the
 other hand, darcs pull of many small patches uses up a few percent
 more CPU time, which I don't understand.
] 
[TAG 0.9.21
David Roundy <droundy at abridgegame.org>**20040612105625] 

--aaack





More information about the darcs-devel mailing list