[darcs-users] [patch415] Replace tmp- prefixes with meta- in packs (and 7 more)

[Petr Rockai]

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.