Hi,

this is an amended version of the repair patches for issue971 I have previously
sent. They should address most of the review comments -- or so I hope. However,
they do not address the failing test (I haven't investigated yet) and they do
not improve the heuristic on how often to dump the slurpy to disk (still every
100 patches). I intend to improve on those two later this week -- I need to
crash to bed again now.

(I have found a bug as well, where we have missed that files went missing from
pristine -- this has been there before, although it's much harder to get this
kind of corruption in hashed pristine I guess (rm'd files reappear thanks to
laziness no problem, one of the directory listings would have to get corrupted
somehow). Nevertheless, we catch that now as well, hopefully without bad
side-effects.)

Yours,
   Petr.

Tue Aug 12 02:21:14 CEST 2008  [EMAIL PROTECTED]
  * Parametrize "pristine.hashed" in a bunch of functions.

Tue Aug 12 02:23:45 CEST 2008  [EMAIL PROTECTED]
  * Add writeSlurpy to roll out a copy of slurpy into a filesystem.

Tue Aug 12 02:27:08 CEST 2008  [EMAIL PROTECTED]
  * Generalize HashRepo.clean_pristine to HashIO.clean_hashdir.

Tue Aug 12 02:38:10 CEST 2008  [EMAIL PROTECTED]
  * Add forceHashSlurped that hashes the slurpy even if it already contains 
hashes.

Tue Aug 12 02:50:39 CEST 2008  [EMAIL PROTECTED]
  * Add Repository.checkPristineAgainstSlurpy.

Tue Aug 12 02:54:23 CEST 2008  [EMAIL PROTECTED]
  * First working (albeit slow) version of repair that uses hashed newpristine.

Tue Aug 12 03:06:03 CEST 2008  [EMAIL PROTECTED]
  * Only "update" (sync to disk) the slurpy every 100 patches.

Tue Aug 12 03:25:24 CEST 2008  [EMAIL PROTECTED]
  * Add Repository.replacePristineFromSlurpy.

Tue Aug 12 03:27:20 CEST 2008  [EMAIL PROTECTED]
  * Fix checkPristineAgainst{Cwd,Slurpy}: we ignored files missing in pristine.
  
  Add LookForAdds to smart_diff options to fix that and also throw in 
IgnoreTimes
  for a good measure and extra paranoia.

New patches:

[Parametrize "pristine.hashed" in a bunch of functions.
[EMAIL PROTECTED] hunk ./src/Darcs/Repository/HashedIO.lhs 52
-applyHashed c fs h p = do s <- slurpHashed c fs h
+applyHashed c fs h p = do s <- slurpHashed c fs h "pristine.hashed"
hunk ./src/Darcs/Repository/HashedIO.lhs 56
-                            Right (s', ()) -> hashSlurped c fs s'
+                            Right (s', ()) -> hashSlurped c fs s' "pristine.hashed"
hunk ./src/Darcs/Repository/HashedIO.lhs 65
-                             options :: ![DarcsFlag], rootHash :: !String }
+                             options :: ![DarcsFlag], rootHash :: !String,
+                             hashDir :: !String }
hunk ./src/Darcs/Repository/HashedIO.lhs 172
-                z <- lift $ unsafeInterleaveIO $ readHashFile c "pristine.hashed" h
+                dir_ <- gets hashDir
+                z <- lift $ unsafeInterleaveIO $ readHashFile c dir_ h
hunk ./src/Darcs/Repository/HashedIO.lhs 182
-gethashmtime h = do HashDir _ c _ _ <- get
-                    lift $ unsafeInterleaveIO $ findFileMtimeUsingCache c "pristine.hashed" h
+gethashmtime h = do HashDir _ c _ _ dir_ <- get
+                    lift $ unsafeInterleaveIO $ findFileMtimeUsingCache c dir_ h
hunk ./src/Darcs/Repository/HashedIO.lhs 201
-safeInterleave job = do HashDir _ c opts h <- get
+safeInterleave job = do HashDir _ c opts h dir_ <- get
hunk ./src/Darcs/Repository/HashedIO.lhs 203
-                             (HashDir { permissions = RO, cache = c, options = opts, rootHash = h })
+                             (HashDir { permissions = RO, cache = c, options = opts, rootHash = h, hashDir = dir_ })
hunk ./src/Darcs/Repository/HashedIO.lhs 214
-                           mapM_ (\(_,_,z) -> lift $ speculateFileUsingCache cac "pristine.hashed" z) c
+                           dir_ <- gets hashDir
+                           mapM_ (\(_,_,z) -> lift $ speculateFileUsingCache cac dir_ z) c
hunk ./src/Darcs/Repository/HashedIO.lhs 217
-          peekroot = do HashDir _ c _ h <- get
-                        lift $ peekInCache c "pristine.hashed" h
+          peekroot = do HashDir _ c _ h dir_ <- get
+                        lift $ peekInCache c dir_ h
hunk ./src/Darcs/Repository/HashedIO.lhs 260
-                      lift $ writeFileUsingCache c opts "pristine.hashed" ps
+                      dir_ <- gets hashDir
+                      lift $ writeFileUsingCache c opts dir_ ps
hunk ./src/Darcs/Repository/HashedIO.lhs 263
-slurpHashed :: Cache -> [DarcsFlag] -> String -> IO Slurpy
-slurpHashed c opts h = fst `fmap` runStateT slh
+slurpHashed :: Cache -> [DarcsFlag] -> String -> String -> IO Slurpy
+slurpHashed c opts h dir_ = fst `fmap` runStateT slh
hunk ./src/Darcs/Repository/HashedIO.lhs 266
-                                             options = opts, rootHash = h })
+                                             options = opts, rootHash = h,
+                                             hashDir = dir_ })
hunk ./src/Darcs/Repository/HashedIO.lhs 288
-hashSlurped :: Cache -> [DarcsFlag] -> Slurpy -> IO String
-hashSlurped c opts sl = do beginTedious k
-                           h <- fst `fmap` runStateT (hsl sl)
-                                        (HashDir { permissions = RW, cache = c,
-                                                   options = opts, rootHash = sha1PS nilPS })
-                           endTedious k
-                           return h
+hashSlurped :: Cache -> [DarcsFlag] -> Slurpy -> String -> IO String
+hashSlurped c opts sl dir_ =
+    do beginTedious k
+       h <- fst `fmap` runStateT (hsl sl)
+            (HashDir { permissions = RW, cache = c,
+                       hashDir = dir_,
+                       options = opts, rootHash = sha1PS nilPS })
+       endTedious k
+       return h
hunk ./src/Darcs/Repository/HashedIO.lhs 320
-syncHashed c s r = do runStateT sh $ HashDir {permissions=RW, cache=c, options=[], rootHash=r}
+syncHashed c s r = do runStateT sh $ HashDir {permissions=RW, cache=c, options=[], rootHash=r, hashDir="pristine.hashed" }
hunk ./src/Darcs/Repository/HashedIO.lhs 330
-                            do t <- lift $ findFileMtimeUsingCache c "pristine.hashed" h
+                            do dir_ <- gets hashDir
+                               t <- lift $ findFileMtimeUsingCache c dir_ h
hunk ./src/Darcs/Repository/HashedIO.lhs 335
-                                            lift $ setFileMtimeUsingCache c "pristine.hashed" h t'
+                                            lift $ setFileMtimeUsingCache c dir_ h t'
hunk ./src/Darcs/Repository/HashedIO.lhs 341
-                                                     options = opts, rootHash = z }
+                                                     options = opts, rootHash = z,
+                                                   hashDir = "pristine.hashed" }
hunk ./src/Darcs/Repository/HashedIO.lhs 361
-                                             options=opts, rootHash = root }
+                                             options=opts, rootHash = root,
+                                             hashDir = "pristine.hashed" }
hunk ./src/Darcs/Repository/HashedIO.lhs 373
-listHashedContents :: String -> Cache -> [DarcsFlag] -> String -> IO [String]
-listHashedContents k c opts root =
+-- Seems to list all hashes reachable from "root".
+listHashedContents :: String -> Cache -> [DarcsFlag] -> String -> String -> IO [String]
+listHashedContents k c opts root dir_ =
hunk ./src/Darcs/Repository/HashedIO.lhs 378
-       x <- fst `fmap` runStateT (lhc (D,fp2fn ".",root)) (HashDir RO c opts root)
+       x <- fst `fmap` runStateT (lhc (D,fp2fn ".",root)) (HashDir RO c opts root dir_)
hunk ./src/Darcs/Repository/HashedRepo.lhs 102
-      hs <- listHashedContents "Cleaning pristine cache" (extractCache r) opts $ inv2pris i
+      hs <- listHashedContents "Cleaning pristine cache" (extractCache r) opts (inv2pris i) "pristine.hashed"
hunk ./src/Darcs/Repository/HashedRepo.lhs 334
-                                      | otherwise -> slurpHashed c opts h
+                                      | otherwise -> slurpHashed c opts h "pristine.hashed"
hunk ./src/Darcs/Repository/HashedRepo.lhs 341
-                              h <- hashSlurped c opts s
+                              h <- hashSlurped c opts s "pristine.hashed"

[Add writeSlurpy to roll out a copy of slurpy into a filesystem.
[EMAIL PROTECTED] hunk ./src/Darcs/SlurpDirectory.lhs 44
-                        SlurpMonad(..), withSlurpy, write_files
+                        SlurpMonad(..), withSlurpy, write_files,
+                        writeSlurpy
hunk ./src/Darcs/SlurpDirectory.lhs 177
+writeSlurpy :: Slurpy -> FilePath -> IO ()
+writeSlurpy s d = do
+  createDirectory d
+  withCurrentDirectory d $ write_files s (list_slurpy s)

[Generalize HashRepo.clean_pristine to HashIO.clean_hashdir.
[EMAIL PROTECTED] hunk ./src/Darcs/Repository/HashedIO.lhs 22
-                                   slurpHashed, hashSlurped ) where
+                                   slurpHashed, hashSlurped,
+                                   clean_hashdir ) where
hunk ./src/Darcs/Repository/HashedIO.lhs 25
+import Darcs.Global ( darcsdir )
+import Data.List ( (\\) )
+import System.Directory ( getDirectoryContents )
hunk ./src/Darcs/Repository/HashedIO.lhs 38
-                                findFileMtimeUsingCache, setFileMtimeUsingCache )
+                                findFileMtimeUsingCache, setFileMtimeUsingCache,
+                                okayHash, cleanCaches )
hunk ./src/Darcs/Repository/HashedIO.lhs 43
-import Darcs.Lock ( writeAtomicFilePS )
+import Darcs.Lock ( writeAtomicFilePS, removeFileMayNotExist )
hunk ./src/Darcs/Repository/HashedIO.lhs 394
+clean_hashdir :: Cache -> [DarcsFlag] -> String -> String -> IO ()
+clean_hashdir c opts dir_ hashroot =
+   do -- we'll remove obsolete bits of "dir"
+      debugMessage $ "Cleaning out " ++ dir_ ++ "..."
+      let hashdir = darcsdir ++ "/" ++ dir_ ++ "/"
+      hs <- listHashedContents "cleaning up..." c opts hashroot dir_
+      fs <- filter okayHash `fmap` getDirectoryContents hashdir
+      mapM_ (removeFileMayNotExist . (hashdir++)) (fs \\ hs)
+      -- and also clean out any global caches.
+      debugMessage "Cleaning out any global caches..."
+      cleanCaches c dir_
+
hunk ./src/Darcs/Repository/HashedRepo.lhs 35
-import System.Directory ( getDirectoryContents, doesFileExist )
+import System.Directory ( doesFileExist )
hunk ./src/Darcs/Repository/HashedRepo.lhs 38
-import Data.List ( delete, (\\) )
+import Data.List ( delete )
hunk ./src/Darcs/Repository/HashedRepo.lhs 46
-                                unionCaches, cleanCaches, repo2cache, okayHash, takeHash )
-import Darcs.Repository.HashedIO ( applyHashed, slurpHashed, hashSlurped, listHashedContents,
-                                   copyHashed, syncHashed, copyPartialsHashed )
+                                unionCaches, repo2cache, okayHash, takeHash )
+import Darcs.Repository.HashedIO ( applyHashed, slurpHashed, hashSlurped,
+                                   copyHashed, syncHashed, copyPartialsHashed,
+                                   clean_hashdir )
hunk ./src/Darcs/Repository/HashedRepo.lhs 66
-import Darcs.Lock ( writeBinFile, writeDocBinFile, writeAtomicFilePS, appendBinFile, appendDocBinFile,
-                    removeFileMayNotExist )
+import Darcs.Lock ( writeBinFile, writeDocBinFile, writeAtomicFilePS, appendBinFile, appendDocBinFile )
hunk ./src/Darcs/Repository/HashedRepo.lhs 102
-      hs <- listHashedContents "Cleaning pristine cache" (extractCache r) opts (inv2pris i) "pristine.hashed"
-      let hashdir = darcsdir++"/pristine.hashed/"
-      fs <- filter okayHash `fmap` getDirectoryContents hashdir
-      mapM_ (removeFileMayNotExist . (hashdir++)) (fs \\ hs)
-      -- and also clean out any global caches.
-      debugMessage "Cleaning out any global caches..."
-      cleanCaches (extractCache r) "pristine.hashed"
+      clean_hashdir (extractCache r) opts "pristine.hashed" $ inv2pris i

[Add forceHashSlurped that hashes the slurpy even if it already contains hashes.
[EMAIL PROTECTED] hunk ./src/Darcs/Repository/HashedIO.lhs 22
-                                   slurpHashed, hashSlurped,
+                                   slurpHashed, hashSlurped, forceHashSlurped,
hunk ./src/Darcs/Repository/HashedIO.lhs 293
-hashSlurped :: Cache -> [DarcsFlag] -> Slurpy -> String -> IO String
-hashSlurped c opts sl dir_ =
+hashSlurped' :: Bool -> Cache -> [DarcsFlag] -> Slurpy -> String -> IO String
+hashSlurped' force c opts sl dir_ =
hunk ./src/Darcs/Repository/HashedIO.lhs 296
-       h <- fst `fmap` runStateT (hsl sl)
+       h <- fst `fmap` runStateT (hsl . scrub $ sl)
hunk ./src/Darcs/Repository/HashedIO.lhs 304
-                                           mapM hs ss >>= writedir
+                                           mapM (hs . scrub) ss >>= writedir
hunk ./src/Darcs/Repository/HashedIO.lhs 308
-          hs s@(SlurpDir d Nothing _) = do h <- hsl s
+          hs s@(SlurpDir d Nothing _) = do h <- (hsl . scrub) s
hunk ./src/Darcs/Repository/HashedIO.lhs 312
-          hs s@(SlurpFile f _ _) = do h <- hsl s
+          hs s@(SlurpFile f _ _) = do h <- (hsl . scrub) s
hunk ./src/Darcs/Repository/HashedIO.lhs 315
+          scrub (SlurpDir n h s) = SlurpDir n (if force then Nothing else h) s
+          scrub (SlurpFile n (h,m,l) content) =
+              SlurpFile n ((if force then Nothing else h),m,l) content
hunk ./src/Darcs/Repository/HashedIO.lhs 320
+hashSlurped :: Cache -> [DarcsFlag] -> Slurpy -> String -> IO String
+hashSlurped = hashSlurped' False
+forceHashSlurped :: Cache -> [DarcsFlag] -> Slurpy -> String -> IO String
+forceHashSlurped = hashSlurped' True
+

[Add Repository.checkPristineAgainstSlurpy.
[EMAIL PROTECTED] hunk ./src/Darcs/Repository.lhs 45
-                    getMarkedupFile,
+                    checkPristineAgainstSlurpy, getMarkedupFile,
hunk ./src/Darcs/Repository.lhs 60
-     prefsUrl, checkPristineAgainstCwd,
+     prefsUrl, checkPristineAgainstCwd, checkPristineAgainstSlurpy,
hunk ./src/Darcs/Repository/Internal.lhs 28
+                    checkPristineAgainstSlurpy,
hunk ./src/Darcs/Repository/Internal.lhs 884
-withTentative :: forall p a C(r u t). RepoPatch p =>
-                 Repository p C(r u t) -> ((FilePath -> IO a) -> IO a) -> (FilePath -> IO a) -> IO a
+checkPristineAgainstSlurpy :: RepoPatch p => Repository p -> Slurpy -> IO Bool
+checkPristineAgainstSlurpy repository@(Repo _ opts _ _) s2 =
+    do s1 <- slurp_recorded repository
+       ftf <- filetype_function
+       case smart_diff opts ftf s1 s2 of
+         NilFL -> return True
+         _ -> return False
+
+withTentative :: forall p a C(r u t). RepoPatch p =>
+                 Repository p C(r u t) -> ((FilePath -> IO a) -> IO a) -> (FilePath -> IO a) -> IO a

[First working (albeit slow) version of repair that uses hashed newpristine.
[EMAIL PROTECTED] hunk ./src/Darcs/Commands/Repair.lhs 21
-import Workaround ( getCurrentDirectory )
+import Workaround ( getCurrentDirectory, createDirectoryIfMissing )
hunk ./src/Darcs/Commands/Repair.lhs 35
+import Darcs.Repository.Prefs ( Cache )
hunk ./src/Darcs/Commands/Repair.lhs 38
-                          checkPristineAgainstCwd, replacePristine )
+                          replacePristineFromSlurpy,
+                          checkPristineAgainstSlurpy )
hunk ./src/Darcs/Commands/Repair.lhs 41
+import Darcs.Repository.InternalTypes ( extractCache )
+import Darcs.Repository.HashedIO ( slurpHashed, hashSlurped, clean_hashdir )
+import Darcs.SlurpDirectory ( empty_slurpy, withSlurpy, Slurpy, SlurpMonad )
hunk ./src/Darcs/Commands/Repair.lhs 47
-import Darcs.Lock( withTempDir )
+import Darcs.Lock( rm_recursive )
hunk ./src/Darcs/Commands/Repair.lhs 88
+
+{- FIXME: we have two problems here
+ 1) we re-slurp newpristine *way* too often (probably call every hundred
+    or so patches, to avoid bloating memory)
+ 2) we call clean_hashdir too often (should call every few hundred patches)
+-}
+run_slurpy :: Cache -> [DarcsFlag] -> Slurpy -> SlurpMonad a -> IO (Slurpy, a)
+run_slurpy c opts s f =
+    case withSlurpy s f of
+      Left err -> fail err
+      Right (s', x) -> do 
+        h <- hashSlurped c opts s' "newpristine"
+        s1 <- slurpHashed c opts h "newpristine"
+        clean_hashdir c opts "newpristine" h
+        return (s1, x)
+
hunk ./src/Darcs/Commands/Repair.lhs 111
-  withTempDir (formerdir++"/"++darcsdir++"/newpristine") $ \newcur -> do
-    putVerbose $ text "Applying patches..."
-    case maybe_chk of
-        Just (Sealed chk) ->
-             do let chtg = patch2patchinfo chk
-                putVerbose $ text "I am repairing from a checkpoint."
-                patches <- read_repo repository
-                applyAndTryToFix chk
-                applyAndFix repository
+  let c = extractCache repository
+  createDirectoryIfMissing False $ darcsdir ++ "/newpristine"
+  rooth <- hashSlurped c opts empty_slurpy "newpristine"
+  s <- slurpHashed c opts rooth "newpristine"
+  putVerbose $ text "Applying patches..."
+  s' <- case maybe_chk of
+    Just (Sealed chk) ->
+        do let chtg = patch2patchinfo chk
+           putVerbose $ text "I am repairing from a checkpoint."
+           patches <- read_repo repository
+           (s'', _) <- run_slurpy c opts s $ applyAndTryToFix chk
+           (_, s_) <- applyAndFix c opts s'' repository
hunk ./src/Darcs/Commands/Repair.lhs 124
-                return ()
-        Nothing -> do debugMessage "Fixing any broken patches..."
-                      rawpatches <- read_repo repository
-                      let psin = reverseRL $ concatRL rawpatches
-                      ps <- applyAndFix repository psin
-                      withCurrentDirectory formerdir $
-                                           writePatchSet (reverseFL ps :<: NilRL) opts
-                      debugMessage "Done fixing broken patches..."
-    is_same <- checkPristineAgainstCwd repository `catchall` return False
-    if is_same
-      then do putStrLn "The repository is already consistent, no changes made."
-              exitWith ExitSuccess
-      else do putStrLn "Fixing pristine tree..."
-              replacePristine repository newcur
-              exitWith ExitSuccess
+           return s_
+    Nothing -> do debugMessage "Fixing any broken patches..."
+                  rawpatches <- read_repo repository
+                  let psin = reverseRL $ concatRL rawpatches
+                  (ps, s_) <- applyAndFix c opts s repository psin
+                  withCurrentDirectory formerdir $
+                                       writePatchSet (reverseFL ps :<: NilRL) opts
+                  debugMessage "Done fixing broken patches..."
+                  return s_
+  is_same <- checkPristineAgainstSlurpy repository s' `catchall` return False
+  if is_same
+      then putStrLn "The repository is already consistent, no changes made."
+      else do
+        putStrLn "Fixing pristine tree..."
+        replacePristineFromSlurpy repository s'
+  rm_recursive $ darcsdir ++ "/newpristine" 
+  exitWith ExitSuccess
hunk ./src/Darcs/Commands/Repair.lhs 142
-applyAndFix :: RepoPatch p => Repository p -> FL (PatchInfoAnd p) -> IO (FL (PatchInfoAnd p))
-applyAndFix _ NilFL = return NilFL
-applyAndFix r psin = do beginTedious k
-                        tediousSize k $ lengthFL psin
-                        ps <- aaf psin
-                        endTedious k
-                        return ps
+applyAndFix :: RepoPatch p => Cache -> [DarcsFlag] -> Slurpy -> Repository p -> FL (PatchInfoAnd p) -> IO (FL (PatchInfoAnd p), Slurpy)
+applyAndFix _ _ s _ NilFL = return (NilFL, s)
+applyAndFix c opts s_ r psin =
+    do beginTedious k
+       tediousSize k $ lengthFL psin
+       ps <- aaf s_ psin
+       endTedious k
+       return ps
hunk ./src/Darcs/Commands/Repair.lhs 151
-          aaf NilFL = return NilFL
-          aaf (p:>:ps) = do mp' <- applyAndTryToFix p
-                            finishedOneIO k $ show $ human_friendly $ info p
-                            p' <- case mp' of
+          aaf s NilFL = return (NilFL, s)
+          aaf s (p:>:ps) = do (s', mp') <- run_slurpy c opts s $
+                                          applyAndTryToFix p
+                              finishedOneIO k $ show $ human_friendly $ info p
+                              p' <- case mp' of
hunk ./src/Darcs/Commands/Repair.lhs 159
-                            p'' <- makePatchLazy r p'
-                            ps' <- aaf ps
-                            return (p'':>:ps')
+                              p'' <- makePatchLazy r p'
+                              (ps', s'') <- aaf s' ps
+                              return ((p'':>:ps'), s'')

[Only "update" (sync to disk) the slurpy every 100 patches.
[EMAIL PROTECTED] hunk ./src/Darcs/Commands/Repair.lhs 89
-{- FIXME: we have two problems here
- 1) we re-slurp newpristine *way* too often (probably call every hundred
-    or so patches, to avoid bloating memory)
- 2) we call clean_hashdir too often (should call every few hundred patches)
--}
-run_slurpy :: Cache -> [DarcsFlag] -> Slurpy -> SlurpMonad a -> IO (Slurpy, a)
-run_slurpy c opts s f =
+run_slurpy :: Slurpy -> SlurpMonad a -> IO (Slurpy, a)
+run_slurpy s f =
hunk ./src/Darcs/Commands/Repair.lhs 93
-      Right (s', x) -> do 
-        h <- hashSlurped c opts s' "newpristine"
-        s1 <- slurpHashed c opts h "newpristine"
-        clean_hashdir c opts "newpristine" h
-        return (s1, x)
+      Right x -> return x
+
+update_slurpy :: Cache -> [DarcsFlag] -> Slurpy -> IO Slurpy
+update_slurpy c opts s = do
+  h <- hashSlurped c opts s "newpristine"
+  s' <- slurpHashed c opts h "newpristine"
+  clean_hashdir c opts "newpristine" h
+  return s'
hunk ./src/Darcs/Commands/Repair.lhs 119
-           (s'', _) <- run_slurpy c opts s $ applyAndTryToFix chk
+           (s'', _) <- run_slurpy s $ applyAndTryToFix chk
hunk ./src/Darcs/Commands/Repair.lhs 145
-       ps <- aaf s_ psin
+       ps <- aaf 0 s_ psin
hunk ./src/Darcs/Commands/Repair.lhs 149
-          aaf s NilFL = return (NilFL, s)
-          aaf s (p:>:ps) = do (s', mp') <- run_slurpy c opts s $
-                                          applyAndTryToFix p
-                              finishedOneIO k $ show $ human_friendly $ info p
-                              p' <- case mp' of
-                                  Nothing -> return p
-                                  Just (e,pp) -> do putStrLn e
-                                                    return pp
-                              p'' <- makePatchLazy r p'
-                              (ps', s'') <- aaf s' ps
-                              return ((p'':>:ps'), s'')
+          aaf _ s NilFL = return (NilFL, s)
+          aaf i s (p:>:ps) = do
+            (s', mp') <- run_slurpy s $ applyAndTryToFix p
+            finishedOneIO k $ show $ human_friendly $ info p
+            p' <- case mp' of
+                    Nothing -> return p
+                    Just (e,pp) -> do putStrLn e
+                                      return pp
+            p'' <- makePatchLazy r p'
+            let j = if ((i::Int) + 1 < 100) then i + 1 else 0
+            (ps', s'') <- aaf j s' ps
+            s''' <- if j == 0 then update_slurpy c opts s''
+                      else return s''
+            return ((p'':>:ps'), s''')

[Add Repository.replacePristineFromSlurpy.
[EMAIL PROTECTED] hunk ./src/Darcs/Repository.lhs 28
-                    slurp_pending, replacePristine,
+                    slurp_pending, replacePristine, replacePristineFromSlurpy,
hunk ./src/Darcs/Repository.lhs 55
-     slurp_pending, replacePristine,
+     slurp_pending, replacePristine, replacePristineFromSlurpy,
hunk ./src/Darcs/Repository/HashedRepo.lhs 30
+                                     replacePristineFromSlurpy,
hunk ./src/Darcs/Repository/HashedRepo.lhs 48
-import Darcs.Repository.HashedIO ( applyHashed, slurpHashed, hashSlurped,
+import Darcs.Repository.HashedIO ( applyHashed, slurpHashed, forceHashSlurped,
hunk ./src/Darcs/Repository/HashedRepo.lhs 336
-                              h <- hashSlurped c opts s "pristine.hashed"
-                              let t = darcsdir++"/hashed_inventory"
-                              i <- gzReadFilePS t
-                              writeDocBinFile t $ pris2inv h i
+                              replacePristineFromSlurpy c opts s
+
+replacePristineFromSlurpy :: Cache -> [DarcsFlag] -> Slurpy -> IO ()
+replacePristineFromSlurpy c opts s = do 
+  h <- forceHashSlurped c opts s "pristine.hashed"
+  let t = darcsdir++"/hashed_inventory"
+  i <- gzReadFilePS t
+  writeDocBinFile t $ pris2inv h i
hunk ./src/Darcs/Repository/Internal.lhs 42
-                    replacePristine,
+                    replacePristine, replacePristineFromSlurpy,
hunk ./src/Darcs/Repository/Internal.lhs 62
-import qualified Darcs.Repository.Pristine as Pristine ( replacePristine )
+import qualified Darcs.Repository.Pristine as Pristine ( replacePristine,
+                                                         replacePristineFromSlurpy )
hunk ./src/Darcs/Repository/Internal.lhs 90
-                              replacePristine, slurp_all_but_darcs )
+                              replacePristine, replacePristineFromSlurpy,
+                              slurp_all_but_darcs )
hunk ./src/Darcs/Repository/Internal.lhs 840
+replacePristineFromSlurpy :: Repository p -> Slurpy -> IO ()
+replacePristineFromSlurpy (Repo r opts rf (DarcsRepository pris c)) s
+    | format_has HashedInventory rf = withCurrentDirectory r $ HashedRepo.replacePristineFromSlurpy c opts s
+    | otherwise = withCurrentDirectory r $ Pristine.replacePristineFromSlurpy s pris
+
hunk ./src/Darcs/Repository/Pristine.lhs 27
-                 syncPristine, replacePristine, getPristinePop,
+                 syncPristine, replacePristine, replacePristineFromSlurpy,
+                 getPristinePop,
hunk ./src/Darcs/Repository/Pristine.lhs 41
-import Darcs.SlurpDirectory ( Slurpy,  mmap_slurp, co_slurp )
+import Darcs.SlurpDirectory ( Slurpy,  mmap_slurp, co_slurp, writeSlurpy )
hunk ./src/Darcs/Repository/Pristine.lhs 171
+replacePristineFromSlurpy :: Slurpy -> Pristine -> IO ()
+replacePristineFromSlurpy _ (NoPristine _) = return ()
+replacePristineFromSlurpy s (PlainPristine n) =
+    do rm_recursive nold
+           `catchall` return ()
+       writeSlurpy s ntmp
+       renameDirectory n nold
+       renameDirectory ntmp n
+       return ()
+           where nold = darcsdir ++ "/" ++ pristineName ++ "-old"
+                 ntmp = darcsdir ++ "/" ++ pristineName ++ "-tmp"
+replacePristineFromSlurpy _ HashedPristine =
+    bug "HashedPristine is not implemented yet."
+

[Fix checkPristineAgainst{Cwd,Slurpy}: we ignored files missing in pristine.
[EMAIL PROTECTED]
 
 Add LookForAdds to smart_diff options to fix that and also throw in IgnoreTimes
 for a good measure and extra paranoia.
] hunk ./src/Darcs/Repository/Internal.lhs 96
-                               SetScriptsExecutable, DryRun),
+                               SetScriptsExecutable, DryRun, IgnoreTimes ),
hunk ./src/Darcs/Repository/Internal.lhs 885
-checkPristineAgainstCwd repository@(Repo _ opts _ _) =
-    do s2 <- mmap_slurp "."
-       s1 <- slurp_recorded repository
-       ftf <- filetype_function
-       return $ nullFL $ smart_diff opts ftf s1 s2
+checkPristineAgainstCwd r =
+    do s <- mmap_slurp "."
+       checkPristineAgainstSlurpy r s
hunk ./src/Darcs/Repository/Internal.lhs 893
-       case smart_diff opts ftf s1 s2 of
-         NilFL -> return True
-         _ -> return False
+       return $ nullFL $ smart_diff (LookForAdds:IgnoreTimes:opts) ftf s1 s2

Context:

[Print a warning when the remote end does not have darcs 2.
Eric Kow <[EMAIL PROTECTED]>**20080811100933
 
 Two reasons:
 (1) right now people get a scary warning from ssh when it can't fetch
     some non-essential files (it used to be that we would send stderr from ssh
     to /dev/null, but that has other problems...)
 (2) darcs transfer-mode more widely deployed could help a lot of people
     wrt darcs performance
] 
[Added a beware note to the unrecord command
[EMAIL PROTECTED] 
[Fixed typo
[EMAIL PROTECTED] 
[Better debug messages in URL module.
Dmitry Kurochkin <[EMAIL PROTECTED]>**20080809215247] 
[make Convert.lhs compile.
David Roundy <[EMAIL PROTECTED]>**20080810201725] 
[improve type safety of Darcs.Repository.Internal.
Jason Dagit <[EMAIL PROTECTED]>**20080810051109] 
[Refactor `darcs convert' warning at kowey's request.
Trent W. Buck <[EMAIL PROTECTED]>**20080810110014] 
[Expand formats text based in part on suggestions from darcs-users
Max Battcher <[EMAIL PROTECTED]>**20080809184043] 
[Fixes to global cache text based on darcs-users suggestions
Max Battcher <[EMAIL PROTECTED]>**20080809181424] 
[Add user-focused documentation of repository format options
Max Battcher <[EMAIL PROTECTED]>**20080807195429] 
[Highlight the global cache as a best practice
Max Battcher <[EMAIL PROTECTED]>**20080807193918] 
[Describe best practice in `darcs convert --help'.
Trent W. Buck <[EMAIL PROTECTED]>**20080810110615] 
[add type witnesses to Population
Jason Dagit <[EMAIL PROTECTED]>**20080808053252] 
[add type witnesses to CommandsAux
Jason Dagit <[EMAIL PROTECTED]>**20080808052738] 
[Add type witnesses to more modules, rounding out Darcs/Repository/*
Jason Dagit <[EMAIL PROTECTED]>**20080808050947] 
[fixed a bug in identity_commutes property
Jason Dagit <[EMAIL PROTECTED]>**20080808023025
 In the right identity check the patch order should have gone from
 (identity :> p) to (p2 :> i2).  I added a rigid type context too
 so that ghc 6.8 and newer would type the definition.
] 
[Make Darcs.Repository.Internal compile with type witnesses.
Jason Dagit <[EMAIL PROTECTED]>**20080808015343] 
[UF8.lhs: remove unusued functions/imports/docs
[EMAIL PROTECTED] 
[Resolve issue974 : do not pass both -optc-g and -opta-g to GHC
Eric Kow <[EMAIL PROTECTED]>**20080807073620] 
[make this test more cross-platform
Simon Michael <[EMAIL PROTECTED]>**20080807103433] 
[document how to run unit tests
Simon Michael <[EMAIL PROTECTED]>**20080807030416] 
[move (most) failing tests to bugs for clean test output
Simon Michael <[EMAIL PROTECTED]>**20080806191336] 
[fix an old spelling error
Simon Michael <[EMAIL PROTECTED]>**20080806170432] 
[make searching for "test:" in makefile work
Simon Michael <[EMAIL PROTECTED]>**20080805222241] 
[run only normal (expected to pass) tests by default
Simon Michael <[EMAIL PROTECTED]>**20080805222108] 
[Downplay quantum mechanics link.
Eric Kow <[EMAIL PROTECTED]>**20080806124109
 Besides, darcs has far more than 3 users by now.
] 
[Make patch theory intro more inviting to math people.
Eric Kow <[EMAIL PROTECTED]>**20080806123411] 
[cleanup and slight rewrite of the test docs
Simon Michael <[EMAIL PROTECTED]>**20080806165949] 
[make order of running tests consistent
Simon Michael <[EMAIL PROTECTED]>**20080806172123] 
[small makefile refactoring: allow just the normal tests to be run, without bugs/*
Simon Michael <[EMAIL PROTECTED]>**20080805203242] 
[Rectify dist help
[EMAIL PROTECTED]
 Removed the "make dist" suggestion, the manual is a better place for that.
 Instead, make clear that it operates on a clean copy of the tree, and
 mention the "predist" functionality.
] 
[website: explain that darcs 2 is required to get the darcs source.
Simon Michael <[EMAIL PROTECTED]>**20080803181216] 
[Canonize Gaetan Lehmann and Daniel Buenzli.
Eric Kow <[EMAIL PROTECTED]>**20080730104357
 (for Daniel B, avoid an accent in his name)
] 
[configure: check for packages needed with split base.
Eric Kow <[EMAIL PROTECTED]>**20080730103840
 Now that all packages must be used explicitly.
] 
[fix type witness compile errors specific to ghc 6.8
Jason Dagit <[EMAIL PROTECTED]>**20080722182729] 
[avoid import of unused function fromMaybe.
David Roundy <[EMAIL PROTECTED]>**20080729172825] 
[configure: suggest regex-compat before text
Eric Kow <[EMAIL PROTECTED]>**20080725095336] 
[configure: mention Haskell in 'try installing' suggestion
Eric Kow <[EMAIL PROTECTED]>**20080725095015] 
[Typo (Text.Regex)
Eric Kow <[EMAIL PROTECTED]>**20080715121708] 
[Use haskeline to have a readline-like behavior when asking something to the user
[EMAIL PROTECTED]
 Unlike the implementations using readline or editline packages, this code
 code doesn't break the Ctrl-C behavior.
] 
[Improve generic rules for English plurals. 
Eric Kow <[EMAIL PROTECTED]>**20080604123728] 
[add configure check for Network.URI.
David Roundy <[EMAIL PROTECTED]>**20080711011914] 
[add -hide-all-packages to default GHCFLAGS.
David Roundy <[EMAIL PROTECTED]>**20080711010952] 
[add support for outputting patch numbers in darcs changes.
David Roundy <[EMAIL PROTECTED]>**20080710011211] 
[add support for matching single patches by index.
David Roundy <[EMAIL PROTECTED]>**20080710004512] 
[add support for matching ranges of patches (counting back from present).
David Roundy <[EMAIL PROTECTED]>**20080710003225] 
[Better avoid silly manpage error.
Trent W. Buck <[EMAIL PROTECTED]>**20080704024920
 
 It turned out only initialize's help string used 'quotes', so just
 remove them.  This makes init's docstring consistent with the others.
] 
[Missing period at end of sentence.
Trent W. Buck <[EMAIL PROTECTED]>**20080704024232] 
[darcs --overview no longer works, so don't document it.
Trent W. Buck <[EMAIL PROTECTED]>**20080704030804] 
[Avoid silly manpage error.
Trent W. Buck <[EMAIL PROTECTED]>**20080703010733
 man (nroff) treats an apostrophe in the first column specially,
 resulting in a syntax error without this patch.
 
 Ideally, all cases of 'foo' in the manpage (i.e. docstrings) should
 become `foo', since man -Tps turns ` and ' into left and right single
 quotes respectively.
] 
[obliterate whitespace in Darcs.Commands.Get
[EMAIL PROTECTED]
 'twas causing lhs/haddock difficulties where a \end{code} wasn't getting recognized.
] 
[rm haddock CPP business
[EMAIL PROTECTED]
 Try as I might, I can't see any reason to special-case some Haddock CPP logic to deal with some *commented-out guards*, unless CPP magically restores and uncomments the code if Haddock isn't being run.
] 
[make pull less verbose when --verbose flag is given.
David Roundy <[EMAIL PROTECTED]>**20080624170035] 
[fix makefile to remember to regenerate version information after running configure.
David Roundy <[EMAIL PROTECTED]>**20080624170001] 
[TAG 2.0.2
David Roundy <[EMAIL PROTECTED]>**20080624012041] 
[bump version number again (brown bag!)
David Roundy <[EMAIL PROTECTED]>**20080624011914] 
[add script to check that "make dist" actually works.
David Roundy <[EMAIL PROTECTED]>**20080624011817] 
[fix buggy and inconsistent release-determining scripts.
David Roundy <[EMAIL PROTECTED]>**20080624011759] 
[ignore boring changelog entry patches when constructing ChangeLog.
David Roundy <[EMAIL PROTECTED]>**20080623224504] 
[add changelog entry for fix of version-numbering bug.
David Roundy <[EMAIL PROTECTED]>**20080623223901] 
[fix bug in determine_release_state.pl.
David Roundy <[EMAIL PROTECTED]>**20080623223739] 
[TAG 2.0.1
David Roundy <[EMAIL PROTECTED]>**20080623214707] 
Patch bundle hash:
7f1431eadfb136c7f1952c553e022c46402aab1b
_______________________________________________
darcs-users mailing list
[email protected]
http://lists.osuosl.org/mailman/listinfo/darcs-users

Reply via email to