Hi,
Replace tmp- prefixes with meta- in packs
-----------------------------------------
> hunk ./src/Darcs/Commands/Optimize.lhs 384
> mapM fileEntry' ps
> renameFile (patchesTar <.> "part") patchesTar
> is <- map ((darcsdir </> "inventories") </>) <$> HashedRepo.listInventories
> - writeFile (darcsdir </> "tmp-filelist-inventories") . unlines $
> + writeFile (darcsdir </> "meta-filelist-inventories") . unlines $
> map takeFileName is
> pr <- sortByMTime =<< dirContents "pristine.hashed"
> hunk ./src/Darcs/Commands/Optimize.lhs 387
> - writeFile (darcsdir </> "tmp-filelist-pristine") . unlines $
> + writeFile (darcsdir </> "meta-filelist-pristine") . unlines $
> map takeFileName pr
> BL.writeFile (basicTar <.> "part") . compress . write =<< mapM fileEntry' (
> [ darcsdir </> "hashed_inventory"
> hunk ./src/Darcs/Commands/Optimize.lhs 391
> - , darcsdir </> "tmp-filelist-pristine"
> - , darcsdir </> "tmp-filelist-inventories"
> + , darcsdir </> "meta-filelist-pristine"
> + , darcsdir </> "meta-filelist-inventories"
> ] ++ reverse pr ++ reverse is)
> renameFile (basicTar <.> "part") basicTar
> hunk ./src/Darcs/Commands/Optimize.lhs 395
> - removeFile $ darcsdir </> "tmp-filelist-inventories"
> - removeFile $ darcsdir </> "tmp-filelist-pristine"
> + removeFile $ darcsdir </> "meta-filelist-inventories"
> + removeFile $ darcsdir </> "meta-filelist-pristine"
> where
> packsDir = darcsdir </> "packs"
> basicTar = packsDir </> "basic.tar.gz"
> hunk ./src/Darcs/Repository.hs 345
> procHashedInv _ (Tar.Fail e) = fail e
> procTmp _ Tar.Done = return ()
> procTmp ca xxs@(Tar.Next x xs) = withTarFile x $ \p c ->
> - if "tmp-" `isPrefixOf` takeFileName p
> + if "meta-" `isPrefixOf` takeFileName p
> then do
> BL.writeFile p c
> procTmp ca xs
> hunk ./src/Darcs/Repository.hs 351
> else do
> ex <- and <$> mapM doesFileExist
> - [ darcsdir </> "tmp-filelist-pristine"
> - , darcsdir </> "tmp-filelist-inventories"
> + [ darcsdir </> "meta-filelist-pristine"
> + , darcsdir </> "meta-filelist-inventories"
> ]
> if ex
> then do
> hunk ./src/Darcs/Repository.hs 359
> mv <- newEmptyMVar
> _ <- forkIO . flip finally (putMVar mv ()) $ do
> fetchFiles ca HashedInventoriesDir . lines =<<
> - readFile (darcsdir </> "tmp-filelist-inventories")
> + readFile (darcsdir </> "meta-filelist-inventories")
> fetchFiles ca HashedPristineDir . lines =<<
> hunk ./src/Darcs/Repository.hs 361
> - readFile (darcsdir </> "tmp-filelist-pristine")
> + readFile (darcsdir </> "meta-filelist-pristine")
> procFiles (cacheDir ca) xxs
> takeMVar mv
> else procFiles (cacheDir ca) xxs
> hunk ./src/Darcs/Repository.hs 366
> mapM_ removeFile . (map (darcsdir </>)) .
> - filter (("tmp-" `isPrefixOf`) . takeFileName) =<<
> + filter (("meta-" `isPrefixOf`) . takeFileName) =<<
> getDirectoryContents darcsdir
> procTmp _ (Tar.Fail e) = fail e
> procFiles _ Tar.Done = return ()
OK
Perform cleanup on exceptions in doOptimizeHTTP
-----------------------------------------------
> hunk ./src/Darcs/Commands/Optimize.lhs 24
>
> module Darcs.Commands.Optimize ( optimize ) where
> import Control.Applicative ( (<$>) )
> +import Control.Exception ( finally )
> import Control.Monad ( when, unless )
> import Data.Maybe ( isJust )
> import Data.List ( sort )
> hunk ./src/Darcs/Commands/Optimize.lhs 374
> mapM_ removeFile gzs
>
> doOptimizeHTTP :: RepoPatch p => Repository p C(r u t) -> IO ()
> -doOptimizeHTTP repo = do
> +doOptimizeHTTP repo = flip finally (mapM_ (removeFileIfExists)
> + [ darcsdir </> "meta-filelist-inventories"
> + , darcsdir </> "meta-filelist-pristine"
> + , basicTar <.> "part"
> + , patchesTar <.> "part"
> + ]) $ do
> rf <- either fail return =<< identifyRepoFormat "."
> unless (formatHas HashedInventory rf) . fail $
> "Unsupported repository format:\n" ++
> hunk ./src/Darcs/Commands/Optimize.lhs 401
> , darcsdir </> "meta-filelist-inventories"
> ] ++ reverse pr ++ reverse is)
> renameFile (basicTar <.> "part") basicTar
> - removeFile $ darcsdir </> "meta-filelist-inventories"
> - removeFile $ darcsdir </> "meta-filelist-pristine"
> where
> packsDir = darcsdir </> "packs"
> basicTar = packsDir </> "basic.tar.gz"
OK
> hunk ./src/Darcs/Commands/Optimize.lhs 417
> Right h -> darcsdir </> "patches" </> h
> sortByMTime xs = map snd . sort <$> mapM (\x -> (\t -> (t, x)) <$>
> getModificationTime x) xs
> + removeFileIfExists x = do
> + ex <- doesFileExist x
> + when ex $ removeFile x
OK (isn't there something like this already somewhere in utils or such?)
Remove warnings about name shadowing
------------------------------------
> hunk ./src/Darcs/Repository.hs 382
> withTarFile x f = case Tar.entryContent x of
> Tar.NormalFile x' _ -> f (Tar.entryPath x) x'
> _ -> fail "Unexpected non-file tar entry"
> - writeFile' Nothing x y = withTemp $ \x' -> do
> + writeFile' Nothing z y = withTemp $ \x' -> do
> BL.writeFile x' y
> hunk ./src/Darcs/Repository.hs 384
> - renameFile x' x
> - writeFile' (Just ca) x y = do
> - let x' = joinPath . tail $ splitPath x -- drop darcsdir
> + renameFile x' z
> + writeFile' (Just ca) z y = do
> + let x' = joinPath . tail $ splitPath z -- drop darcsdir
> ex <- doesFileExist $ ca </> x'
> if ex
> hunk ./src/Darcs/Repository.hs 389
> - then createLink' (ca </> x') x
> + then createLink' (ca </> x') z
> else withTemp $ \x'' -> do
> BL.writeFile x'' y
> createLink' x'' $ ca </> x'
> hunk ./src/Darcs/Repository.hs 393
> - renameFile x'' x
> - createLink' x y = do
> + renameFile x'' z
> + createLink' z y = do
> createDirectoryIfMissing True $ takeDirectory y
> hunk ./src/Darcs/Repository.hs 396
> - createLink x y `catchall` return ()
> + createLink z y `catchall` return ()
> fetchFiles _ _ [] = return ()
> fetchFiles c d (f:fs) = do
> ex <- doesFileExist $ darcsdir </> hashedDir d </> f
OK
I am not going to make it farther today, hopefully later this week
(tomorrow is a bit busy, but I still might make it).
Thanks for the patches Alexey, overall they look quite good.
Yours,
Petr.
_______________________________________________
darcs-users mailing list
darcs-users@darcs.net
http://lists.osuosl.org/mailman/listinfo/darcs-users
