3 patches for repository http://darcs.net/:

Thu Jun  3 14:53:57 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Implement darcs optimize --http

Thu Jun  3 14:59:00 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Add --http flag for optimize

Thu Jun  3 15:11:36 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Refactor Darcs.Repository.copyInventory (consistent naming)

Attachments

• implement-darcs-optimize-__http.dpatch
• unnamed

Rah! What do you think, Petr?

2 patches for repository http://darcs.net/:

Thu Jun  3 14:53:57 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Implement darcs optimize --http

Thu Jun  3 21:15:40 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Recompress repository packs

In this version files get decompressed, packed and then compressed back,
resulting in ~2x smaller pack sizes.  Also, fixed crashing on access to
unoptimized repositories, and implemented getting patches pack.

Attachments

• implement-darcs-optimize-__http.dpatch
• unnamed

Hi,

Alexey Levan <bugs@darcs.net> writes:
> In this version files get decompressed, packed and then compressed
> back, resulting in ~2x smaller pack sizes.  Also, fixed crashing on
> access to unoptimized repositories, and implemented getting patches
> pack.

Thanks for your patch(es)! I have read through them and I have a few
things to discuss -- you should find (and reply to) the comments inline.
Ta.

Implement darcs optimize --http
--------------------------------

> hunk ./src/Darcs/Commands/Get.lhs 161
>      putInfo opts $ text "Warning: 'old-fashioned-inventory' is ignored with a darcs-2 repository\n"
>    let opts' = if formatHas Darcs2 rfsource
>                then UseFormat2:opts
> -              else if not (UseOldFashionedInventory `elem` opts)
> +              else if not (UseOldFashionedInventory `elem` opts) &&
> +                      not (Partial `elem` opts)
>                     then UseHashedInventory:filter (/= UseFormat2) opts
>                     else UseOldFashionedInventory:filter (/= UseFormat2) opts
>    createRepository opts'
I am not sure you want this hunk included in this patch. Could you
explain what was the intention of this change? (There was a discussion
in #darcs recently about --partial behaviour, but this certainly needs
to be done as a separate patch, if at all.)

> hunk ./src/Darcs/Commands/Optimize.lhs 36
>  import Darcs.Arguments ( DarcsFlag( UpgradeFormat, UseHashedInventory,
>                                      Compress, UnCompress,
>                                      NoCompress, Reorder,
> -                                    Relink, RelinkPristine, OptimizePristine ),
> +                                    Relink, RelinkPristine, OptimizePristine,
> +                                    OptimizeHTTP ),
>                          reorderPatches,
>                          uncompressNocompress,
>                          relink, relinkPristine, sibling,
> hunk ./src/Darcs/Commands/Optimize.lhs 43
>                          flagsToSiblings,
>                          upgradeFormat,
> -                        workingRepoDir, umaskOption, optimizePristine
> +                        workingRepoDir, umaskOption, optimizePristine,
> +                        optimizeHTTP
>                        )
>  import Darcs.Repository.Prefs ( getPreflist )
>  import Darcs.Repository ( Repository,
OK

> hunk ./src/Darcs/Commands/Optimize.lhs 89
>  import Storage.Hashed.Plain( readPlainTree )
>  import Storage.Hashed.Darcs( writeDarcsHashed )
>  
> +import Codec.Archive.Tar ( create )
> +
>  #include "gadts.h"
>  
>  optimizeDescription :: String
OK

> hunk ./src/Darcs/Commands/Optimize.lhs 134
>                                                   sibling, relink,
>                                                   relinkPristine,
>                                                    upgradeFormat,
> -                                                 optimizePristine]}
> +                                                 optimizePristine,
> +                                                 optimizeHTTP]}
>  
>  optimizeCmd :: [DarcsFlag] -> [String] -> IO ()
>  optimizeCmd origopts _ = do
OK

> hunk ./src/Darcs/Commands/Optimize.lhs 140
>      when (UpgradeFormat `elem` origopts) optimizeUpgradeFormat
> +    when (OptimizeHTTP `elem` origopts) doOptimizeHTTP
>      withRepoLock opts $- \repository -> do
>      if (OptimizePristine `elem` opts)
>         then doOptimizePristine repository
This should maybe run within a repository lock?

> hunk ./src/Darcs/Commands/Optimize.lhs 364
>      withCurrentDirectory dir $ do
>        gzs <- filter ((== ".gz") . takeExtension) `fmap` getDirectoryContents "."
>        mapM_ removeFile gzs
> +
> +doOptimizeHTTP :: IO ()
> +doOptimizeHTTP = withRepoLock [] $- \_ -> do
> +  createDirectoryIfMissing False packsDir
> +  create (packsDir </> "invprist.tar") "" $ map (darcsdir </>)
> +    ["hashed_inventory", "inventories", "pristine.hashed"]
> +  create (packsDir </> "patches.tar") "" $ [darcsdir </> "patches"]
> + where
> +  packsDir = darcsdir </> "packs"
>  \end{code}

I am not very happy with the "invprist" filename. At first sight, it
sounds like "inverted pristine" to me, although I understand it's meant
to say inventories and pristine. So one (probably too verbose) option
would be to name it inventories_and_pristine.tar, or possibly
inventories+pristine (but needs escaping in URLs) or maybe something
like "basic.tar" or "minimal.tar" that would convey that this is a
minimal working repository.

> hunk ./src/Darcs/Repository.hs 94
>  import Darcs.Hopefully ( PatchInfoAnd, info, extractHash )
>  import Darcs.Repository.Checkpoint ( identifyCheckpoint, writeCheckpointPatch, getCheckpoint )
>  import Darcs.Repository.ApplyPatches ( applyPatches )
> -import Darcs.Repository.HashedRepo ( applyToTentativePristine, pris2inv )
> +import Darcs.Repository.HashedRepo ( applyToTentativePristine, pris2inv, revertTentativeChanges )
>  import Darcs.Repository.InternalTypes ( Pristine(..), extractOptions )
>  import Darcs.Patch ( RepoPatch, Named, Prim, Patch, patch2patchinfo, apply )
>  import Darcs.Witnesses.Ordered ( FL(..), RL(..), bunchFL, mapFL, mapRL
> hunk ./src/Darcs/Repository.hs 98
> -                               , reverseRL ,lengthRL, (+>+) )
> +                               , reverseRL ,lengthRL, (+>+), (:\/:)(..) )
>  import Darcs.Patch.Info ( PatchInfo )
>  import Darcs.Repository.Format ( RepoProperty ( HashedInventory ),
>                                   createRepoFormat, formatHas, writeRepoFormat )
> hunk ./src/Darcs/Repository.hs 104
>  import Darcs.Repository.Prefs ( writeDefaultPrefs )
>  import Darcs.Repository.Pristine ( createPristine, flagsToPristine, createPristineFromWorking )
> -import Darcs.Patch.Depends ( getPatchesBeyondTag, areUnrelatedRepos )
> +import Darcs.Patch.Depends ( getPatchesBeyondTag, areUnrelatedRepos, findCommonAndUncommon )
>  import Darcs.Utils ( withCurrentDirectory, catchall, promptYorn, prettyError )
> hunk ./src/Darcs/Repository.hs 106
> -import Darcs.External ( copyFileOrUrl, Cachable(..) )
> +import Darcs.External ( copyFileOrUrl, Cachable(..), fetchFilePS )
> +import Darcs.Lock ( withTemp )
>  import Progress ( debugMessage, tediousSize, beginTedious, endTedious )
>  import Darcs.ProgressPatches (progressRLShowTags, progressFL)
>  import Darcs.Lock ( writeBinFile, writeDocBinFile, rmRecursive )
> hunk ./src/Darcs/Repository.hs 125
>  import ByteStringUtils( gzReadFilePS )
>  
>  import System.FilePath( (</>) )
> +import Codec.Archive.Tar ( extract )
>  
>  import qualified Data.ByteString.Char8 as BS
>  
OK (just imports)

> hunk ./src/Darcs/Repository.hs 148

>  copyRepository :: RepoPatch p => Repository p C(r u t) -> IO ()
> -copyRepository fromrepository@(Repo _ opts rf _)
> +copyRepository fromRepo@(Repo fromDir opts rf _)
>      | Partial `elem` opts && not (formatHas HashedInventory rf) =
> hunk ./src/Darcs/Repository.hs 150
> -        do isPartial <- copyPartialRepository fromrepository
> -           unless (isPartial == IsPartial) $ copyFullRepository fromrepository
> -    | otherwise = copyFullRepository fromrepository
> +        do isPartial <- copyPartialRepository fromRepo
> +           unless (isPartial == IsPartial) $ copyFullRepository fromRepo
> +    | otherwise = do
> +        isPacked <- doesRemoteFileExist $ fromDir </> darcsdir </>
> +          "packs" </> "invprist.tar"
> +        if isPacked
> +          then copyPackedRepository fromRepo
> +          else copyFullRepository fromRepo
> + where
> +  doesRemoteFileExist x = fetchFilePS x Cachable >> return True `catch`
> +    (\_ -> return False)
It is not very clear that this does what it seems to want to do. I am
assuming that your intention was to get the download going in this
place, and have the second request in copyPackedRepository below
(copyFileOrUrl) to be satisfied from the already fetched file.

However, the Cachable bit only seems to affect proxies or generally the
Pragma/Cache-Control HTTP headers and nothing much else. So it seems to
me that this code as it is will actually download the code twice. For
all I can tell, fetchFilePS is completely strict, so it will wait till
the download is complete, and it will erase its temporary file after
reading it into memory.

I think the way to fix this is to just try copyPackedRepository right
away and if it fails, fall back to copyFullRepository -- you will have
to reorder copyPackedRepository a bit to *first* grab the tarball and
only then set up prefs and finally unpack the tarball.

>  data PorNP = NotPartial | IsPartial
>               deriving ( Eq )
> hunk ./src/Darcs/Repository.hs 261
>                     debugMessage "Writing the pristine"
>                     pristineFromWorking torepository
>  
> +copyPackedRepository :: forall p C(r u t). RepoPatch p => Repository p C(r u t) -> IO ()
> +copyPackedRepository fromRepo@(Repo fromDir opts _ (DarcsRepository _ fromCache)) = do
> +  debugMessage "Copying prefs"
> +  copyFileOrUrl opts (fromDir ++ "/" ++ darcsdir ++ "/prefs/prefs")
> +    (darcsdir ++ "/prefs/prefs") (MaxAge 600) `catchall` return ()
> +  debugMessage "Grabbing lock in new repository..."
> +  Repo toDir _ toFormat (DarcsRepository toPristine toCache) <-
> +    identifyRepositoryFor fromRepo "."
> +  toCache2 <- unionRemoteCaches toCache fromCache fromDir
> +  let toRepo :: Repository p C(r u t)
> +      toRepo = Repo toDir opts toFormat $ DarcsRepository toPristine toCache2
> +  -- unpack inventory & pristine cache
> +  withTemp $ \tmp -> do
> +    let fromPacksDir = fromDir ++ "/" ++ darcsdir ++ "/packs/"
> +    copyFileOrUrl [] (fromPacksDir ++ "invprist.tar") tmp Uncachable
> +    extract toDir tmp
> +    createPristineDirectoryTree toRepo "."
> +  -- pull new patches
> +  us <- readRepo toRepo
> +  them <- readRepo fromRepo
> +  comm :\/: unc <- return $ findCommonAndUncommon us them
> +  revertTentativeChanges
> +  Sealed pw <- tentativelyMergePatches toRepo "get" opts comm unc
> +  withGutsOf toRepo $ do
> +    finalizeRepositoryChanges toRepo
> +    applyToWorking toRepo opts pw
> +    return ()
> +  -- get old patches
> +  fetchPatchesIfNecessary opts toRepo
Other than the above observation, I think this is basically OK. It may
be useful to factor the "pull new patches" bit into a helper function
(or look if there is one already, although there probably isn't). Or
maybe not. I defer that decision to you.

Recompress repository packs
---------------------------

> hunk ./src/Darcs/Commands/Optimize.lhs 24
>  {-# LANGUAGE CPP #-}
>  
>  module Darcs.Commands.Optimize ( optimize ) where
> -import Control.Monad ( when, unless )
> +import Control.Applicative ( (<$>) )
> +import Control.Monad ( when, unless, (<=<) )
>  import Data.Maybe ( isJust )
>  import System.Directory ( getDirectoryContents, doesDirectoryExist, doesFileExist )
>  import qualified Data.ByteString.Char8 as BS
> hunk ./src/Darcs/Commands/Optimize.lhs 29
> +import qualified Data.ByteString.Lazy as BL
>  
>  import Storage.Hashed.Darcs( decodeDarcsSize )
>  
> hunk ./src/Darcs/Commands/Optimize.lhs 91
>  import Storage.Hashed.Plain( readPlainTree )
>  import Storage.Hashed.Darcs( writeDarcsHashed )
>  
> -import Codec.Archive.Tar ( create )
> +import Codec.Archive.Tar ( write )
> +import Codec.Archive.Tar.Entry ( fileEntry, toTarPath )
> +import Codec.Compression.GZip ( compress )
>  
>  #include "gadts.h"
>  
OK (imports again)

> hunk ./src/Darcs/Commands/Optimize.lhs 371
>  
>  doOptimizeHTTP :: IO ()
>  doOptimizeHTTP = withRepoLock [] $- \_ -> do
> +  rf <- either fail return =<< identifyRepoFormat "."
> +  unless (formatHas HashedInventory rf) $ fail
> +    "Unsupported repository format"
>    createDirectoryIfMissing False packsDir
Good point. Does this maybe belong to a separate patch, or maybe to the
previous one? Does not seem to be directly related to re-compression.

> hunk ./src/Darcs/Commands/Optimize.lhs 375
> -  create (packsDir </> "invprist.tar") "" $ map (darcsdir </>)
> -    ["hashed_inventory", "inventories", "pristine.hashed"]
> -  create (packsDir </> "patches.tar") "" $ [darcsdir </> "patches"]
> +  i <- fileEntry' $ darcsdir </> "hashed_inventory"
> +  is <- tarDarcsDir "inventories"
> +  pr <- tarDarcsDir "pristine.hashed"
> +  BL.writeFile (packsDir </> "invprist.tar.gz") . compress $ write (i : (is ++ pr))
> +  ps <- tarDarcsDir "patches"
> +  BL.writeFile (packsDir </> "patches.tar.gz") . compress $ write ps
>   where
>    packsDir = darcsdir </> "packs"
> hunk ./src/Darcs/Commands/Optimize.lhs 383
> +  fileEntry' x = do
> +    content <- BL.fromChunks . return <$> gzReadFilePS x
> +    tp <- either fail return (toTarPath False x)
> +    return $ fileEntry tp content
> +  dirContents d = map (d </>) . filter ((/= '.') . head) <$> getDirectoryContents d
> +  tarDarcsDir = mapM fileEntry' <=< dirContents . (darcsdir </>)
OK

> hunk ./src/Darcs/Repository.hs 48
>      ) where
>  
>  import System.Exit ( ExitCode(..), exitWith )
> +import Data.List ( isSuffixOf )
>  import Data.Maybe( catMaybes )
>  
>  import Darcs.Repository.State( readRecorded, readUnrecorded, readWorking, unrecordedChanges
> hunk ./src/Darcs/Repository.hs 86
>  import URL ( maxPipelineLength )
>  
>  import Control.Monad ( unless, when )
> -import System.Directory ( createDirectory, renameDirectory )
> +import System.Directory ( createDirectory, renameDirectory, createDirectoryIfMissing )
>  import System.IO.Error ( isAlreadyExistsError )
>  
>  import qualified Darcs.Repository.DarcsRepo as DarcsRepo
> hunk ./src/Darcs/Repository.hs 108
>  import Darcs.Patch.Depends ( getPatchesBeyondTag, areUnrelatedRepos, findCommonAndUncommon )
>  import Darcs.Utils ( withCurrentDirectory, catchall, promptYorn, prettyError )
>  import Darcs.External ( copyFileOrUrl, Cachable(..), fetchFilePS )
> -import Darcs.Lock ( withTemp )
>  import Progress ( debugMessage, tediousSize, beginTedious, endTedious )
>  import Darcs.ProgressPatches (progressRLShowTags, progressFL)
>  import Darcs.Lock ( writeBinFile, writeDocBinFile, rmRecursive )
> hunk ./src/Darcs/Repository.hs 125
>  import ByteStringUtils( gzReadFilePS )
>  
>  import System.FilePath( (</>) )
> -import Codec.Archive.Tar ( extract )
> -
> +import qualified Codec.Archive.Tar as Tar
> +import Codec.Compression.GZip ( compress, decompress )
>  import qualified Data.ByteString.Char8 as BS
> hunk ./src/Darcs/Repository.hs 128
> +import qualified Data.ByteString.Lazy as BL
>  
>  #include "impossible.h"
>  
OK, more imports

> hunk ./src/Darcs/Repository.hs 155
>             unless (isPartial == IsPartial) $ copyFullRepository fromRepo
>      | otherwise = do
>          isPacked <- doesRemoteFileExist $ fromDir </> darcsdir </>
> -          "packs" </> "invprist.tar"
> +          "packs" </> "invprist.tar.gz"
>          if isPacked
>            then copyPackedRepository fromRepo
>            else copyFullRepository fromRepo
OK

> hunk ./src/Darcs/Repository.hs 160
>   where
> -  doesRemoteFileExist x = fetchFilePS x Cachable >> return True `catch`
> -    (\_ -> return False)
> +  doesRemoteFileExist x = (fetchFilePS x Cachable >> return True) `catchall`
> +    return False
Changes catch to catchall, probably quite OK. Maybe should be amend of
previous though, instead of part of this one.

>  data PorNP = NotPartial | IsPartial
>               deriving ( Eq )
> hunk ./src/Darcs/Repository.hs 273
>    toCache2 <- unionRemoteCaches toCache fromCache fromDir
>    let toRepo :: Repository p C(r u t)
>        toRepo = Repo toDir opts toFormat $ DarcsRepository toPristine toCache2
> +      fromPacksDir = fromDir ++ "/" ++ darcsdir ++ "/packs/"
> +  createDirectoryIfMissing False $ toDir </> darcsdir </> "inventories"
> +  createDirectoryIfMissing False $ toDir </> darcsdir </> "pristine.hashed"
> +  createDirectoryIfMissing False $ toDir </> darcsdir </> "patches"
>    -- unpack inventory & pristine cache
> hunk ./src/Darcs/Repository.hs 278
> -  withTemp $ \tmp -> do
> -    let fromPacksDir = fromDir ++ "/" ++ darcsdir ++ "/packs/"
> -    copyFileOrUrl [] (fromPacksDir ++ "invprist.tar") tmp Uncachable
> -    extract toDir tmp
> -    createPristineDirectoryTree toRepo "."
> +  writeCompressed . Tar.read . decompress . BL.fromChunks . return =<<
> +    fetchFilePS (fromPacksDir ++ "invprist.tar.gz") Uncachable
This is a little dangerous, since it means having the complete tarball
in memory at once. The version with temporary directory is probably
better. You can presumably decompress and unpack the tarball in a
streamed fashion from disk somehow? This may need some benchmarking and
maybe some creative way to measure memory usage during decompression.

> +  createPristineDirectoryTree toRepo "."
>    -- pull new patches
>    us <- readRepo toRepo
>    them <- readRepo fromRepo
> hunk ./src/Darcs/Repository.hs 292
>      applyToWorking toRepo opts pw
>      return ()
>    -- get old patches
> -  fetchPatchesIfNecessary opts toRepo
> +  writeCompressed . Tar.read . decompress . BL.fromChunks .
> +    return =<< fetchFilePS (fromPacksDir ++ "patches.tar.gz") Uncachable
> + where
> +  writeCompressed Tar.Done = return ()
> +  writeCompressed (Tar.Next x xs) = case Tar.entryContent x of
> +    Tar.NormalFile x' _ -> do
> +      let p = Tar.entryPath x
> +      BL.writeFile p $ if "hashed_inventory" `isSuffixOf` p
> +        then x'
> +        else compress x'
> +      writeCompressed xs
> +    _ -> fail ""
> +  writeCompressed (Tar.Fail e) = fail e
OK

Yours,
    Petr.

2010/6/3 Petr Rockai <me@mornfall.net>:
>
> Implement darcs optimize --http
> --------------------------------
>
>> hunk ./src/Darcs/Commands/Get.lhs 161
>>      putInfo opts $ text "Warning: 'old-fashioned-inventory' is ignored with a darcs-2 repository\n"
>>    let opts' = if formatHas Darcs2 rfsource
>>                then UseFormat2:opts
>> -              else if not (UseOldFashionedInventory `elem` opts)
>> +              else if not (UseOldFashionedInventory `elem` opts) &&
>> +                      not (Partial `elem` opts)
>>                     then UseHashedInventory:filter (/= UseFormat2) opts
>>                     else UseOldFashionedInventory:filter (/= UseFormat2) opts
>>    createRepository opts'
> I am not sure you want this hunk included in this patch. Could you
> explain what was the intention of this change? (There was a discussion
> in #darcs recently about --partial behaviour, but this certainly needs
> to be done as a separate patch, if at all.)

Ugh, that really doesn't belong to this patch. I just saw a ticket,
and was hacking around, so I thought it's trivial to implement and
just did it. After that, I've successfully forgotten about this change
:-) It shouldn't be here, I didn't even test it after all.

>> hunk ./src/Darcs/Commands/Optimize.lhs 36
>>  import Darcs.Arguments ( DarcsFlag( UpgradeFormat, UseHashedInventory,
>>                                      Compress, UnCompress,
>>                                      NoCompress, Reorder,
>> -                                    Relink, RelinkPristine, OptimizePristine ),
>> +                                    Relink, RelinkPristine, OptimizePristine,
>> +                                    OptimizeHTTP ),
>>                          reorderPatches,
>>                          uncompressNocompress,
>>                          relink, relinkPristine, sibling,
>> hunk ./src/Darcs/Commands/Optimize.lhs 43
>>                          flagsToSiblings,
>>                          upgradeFormat,
>> -                        workingRepoDir, umaskOption, optimizePristine
>> +                        workingRepoDir, umaskOption, optimizePristine,
>> +                        optimizeHTTP
>>                        )
>>  import Darcs.Repository.Prefs ( getPreflist )
>>  import Darcs.Repository ( Repository,
> OK
>
>> hunk ./src/Darcs/Commands/Optimize.lhs 89
>>  import Storage.Hashed.Plain( readPlainTree )
>>  import Storage.Hashed.Darcs( writeDarcsHashed )
>>
>> +import Codec.Archive.Tar ( create )
>> +
>>  #include "gadts.h"
>>
>>  optimizeDescription :: String
> OK
>
>> hunk ./src/Darcs/Commands/Optimize.lhs 134
>>                                                   sibling, relink,
>>                                                   relinkPristine,
>>                                                    upgradeFormat,
>> -                                                 optimizePristine]}
>> +                                                 optimizePristine,
>> +                                                 optimizeHTTP]}
>>
>>  optimizeCmd :: [DarcsFlag] -> [String] -> IO ()
>>  optimizeCmd origopts _ = do
> OK
>
>> hunk ./src/Darcs/Commands/Optimize.lhs 140
>>      when (UpgradeFormat `elem` origopts) optimizeUpgradeFormat
>> +    when (OptimizeHTTP `elem` origopts) doOptimizeHTTP
>>      withRepoLock opts $- \repository -> do
>>      if (OptimizePristine `elem` opts)
>>         then doOptimizePristine repository
> This should maybe run within a repository lock?

Yep, certainly.

>> hunk ./src/Darcs/Commands/Optimize.lhs 364
>>      withCurrentDirectory dir $ do
>>        gzs <- filter ((== ".gz") . takeExtension) `fmap` getDirectoryContents "."
>>        mapM_ removeFile gzs
>> +
>> +doOptimizeHTTP :: IO ()
>> +doOptimizeHTTP = withRepoLock [] $- \_ -> do
>> +  createDirectoryIfMissing False packsDir
>> +  create (packsDir </> "invprist.tar") "" $ map (darcsdir </>)
>> +    ["hashed_inventory", "inventories", "pristine.hashed"]
>> +  create (packsDir </> "patches.tar") "" $ [darcsdir </> "patches"]
>> + where
>> +  packsDir = darcsdir </> "packs"
>>  \end{code}
>
> I am not very happy with the "invprist" filename. At first sight, it
> sounds like "inverted pristine" to me, although I understand it's meant
> to say inventories and pristine. So one (probably too verbose) option
> would be to name it inventories_and_pristine.tar, or possibly
> inventories+pristine (but needs escaping in URLs) or maybe something
> like "basic.tar" or "minimal.tar" that would convey that this is a
> minimal working repository.

basic.tar is less typing, so I'll go with it :-)

>> hunk ./src/Darcs/Repository.hs 94
>>  import Darcs.Hopefully ( PatchInfoAnd, info, extractHash )
>>  import Darcs.Repository.Checkpoint ( identifyCheckpoint, writeCheckpointPatch, getCheckpoint )
>>  import Darcs.Repository.ApplyPatches ( applyPatches )
>> -import Darcs.Repository.HashedRepo ( applyToTentativePristine, pris2inv )
>> +import Darcs.Repository.HashedRepo ( applyToTentativePristine, pris2inv, revertTentativeChanges )
>>  import Darcs.Repository.InternalTypes ( Pristine(..), extractOptions )
>>  import Darcs.Patch ( RepoPatch, Named, Prim, Patch, patch2patchinfo, apply )
>>  import Darcs.Witnesses.Ordered ( FL(..), RL(..), bunchFL, mapFL, mapRL
>> hunk ./src/Darcs/Repository.hs 98
>> -                               , reverseRL ,lengthRL, (+>+) )
>> +                               , reverseRL ,lengthRL, (+>+), (:\/:)(..) )
>>  import Darcs.Patch.Info ( PatchInfo )
>>  import Darcs.Repository.Format ( RepoProperty ( HashedInventory ),
>>                                   createRepoFormat, formatHas, writeRepoFormat )
>> hunk ./src/Darcs/Repository.hs 104
>>  import Darcs.Repository.Prefs ( writeDefaultPrefs )
>>  import Darcs.Repository.Pristine ( createPristine, flagsToPristine, createPristineFromWorking )
>> -import Darcs.Patch.Depends ( getPatchesBeyondTag, areUnrelatedRepos )
>> +import Darcs.Patch.Depends ( getPatchesBeyondTag, areUnrelatedRepos, findCommonAndUncommon )
>>  import Darcs.Utils ( withCurrentDirectory, catchall, promptYorn, prettyError )
>> hunk ./src/Darcs/Repository.hs 106
>> -import Darcs.External ( copyFileOrUrl, Cachable(..) )
>> +import Darcs.External ( copyFileOrUrl, Cachable(..), fetchFilePS )
>> +import Darcs.Lock ( withTemp )
>>  import Progress ( debugMessage, tediousSize, beginTedious, endTedious )
>>  import Darcs.ProgressPatches (progressRLShowTags, progressFL)
>>  import Darcs.Lock ( writeBinFile, writeDocBinFile, rmRecursive )
>> hunk ./src/Darcs/Repository.hs 125
>>  import ByteStringUtils( gzReadFilePS )
>>
>>  import System.FilePath( (</>) )
>> +import Codec.Archive.Tar ( extract )
>>
>>  import qualified Data.ByteString.Char8 as BS
>>
> OK (just imports)
>
>> hunk ./src/Darcs/Repository.hs 148
>
>>  copyRepository :: RepoPatch p => Repository p C(r u t) -> IO ()
>> -copyRepository fromrepository@(Repo _ opts rf _)
>> +copyRepository fromRepo@(Repo fromDir opts rf _)
>>      | Partial `elem` opts && not (formatHas HashedInventory rf) =
>> hunk ./src/Darcs/Repository.hs 150
>> -        do isPartial <- copyPartialRepository fromrepository
>> -           unless (isPartial == IsPartial) $ copyFullRepository fromrepository
>> -    | otherwise = copyFullRepository fromrepository
>> +        do isPartial <- copyPartialRepository fromRepo
>> +           unless (isPartial == IsPartial) $ copyFullRepository fromRepo
>> +    | otherwise = do
>> +        isPacked <- doesRemoteFileExist $ fromDir </> darcsdir </>
>> +          "packs" </> "invprist.tar"
>> +        if isPacked
>> +          then copyPackedRepository fromRepo
>> +          else copyFullRepository fromRepo
>> + where
>> +  doesRemoteFileExist x = fetchFilePS x Cachable >> return True `catch`
>> +    (\_ -> return False)
> It is not very clear that this does what it seems to want to do. I am
> assuming that your intention was to get the download going in this
> place, and have the second request in copyPackedRepository below
> (copyFileOrUrl) to be satisfied from the already fetched file.
>
> However, the Cachable bit only seems to affect proxies or generally the
> Pragma/Cache-Control HTTP headers and nothing much else. So it seems to
> me that this code as it is will actually download the code twice. For
> all I can tell, fetchFilePS is completely strict, so it will wait till
> the download is complete, and it will erase its temporary file after
> reading it into memory.
>
> I think the way to fix this is to just try copyPackedRepository right
> away and if it fails, fall back to copyFullRepository -- you will have
> to reorder copyPackedRepository a bit to *first* grab the tarball and
> only then set up prefs and finally unpack the tarball.

Cachable bit is just copy/paste artifact, it's taken from code that
checks repository format. Difference is, that there inventory is
downloaded, so it's not a big deal. I'll follow your suggestion on
this.

>>  data PorNP = NotPartial | IsPartial
>>               deriving ( Eq )
>> hunk ./src/Darcs/Repository.hs 261
>>                     debugMessage "Writing the pristine"
>>                     pristineFromWorking torepository
>>
>> +copyPackedRepository :: forall p C(r u t). RepoPatch p => Repository p C(r u t) -> IO ()
>> +copyPackedRepository fromRepo@(Repo fromDir opts _ (DarcsRepository _ fromCache)) = do
>> +  debugMessage "Copying prefs"
>> +  copyFileOrUrl opts (fromDir ++ "/" ++ darcsdir ++ "/prefs/prefs")
>> +    (darcsdir ++ "/prefs/prefs") (MaxAge 600) `catchall` return ()
>> +  debugMessage "Grabbing lock in new repository..."
>> +  Repo toDir _ toFormat (DarcsRepository toPristine toCache) <-
>> +    identifyRepositoryFor fromRepo "."
>> +  toCache2 <- unionRemoteCaches toCache fromCache fromDir
>> +  let toRepo :: Repository p C(r u t)
>> +      toRepo = Repo toDir opts toFormat $ DarcsRepository toPristine toCache2
>> +  -- unpack inventory & pristine cache
>> +  withTemp $ \tmp -> do
>> +    let fromPacksDir = fromDir ++ "/" ++ darcsdir ++ "/packs/"
>> +    copyFileOrUrl [] (fromPacksDir ++ "invprist.tar") tmp Uncachable
>> +    extract toDir tmp
>> +    createPristineDirectoryTree toRepo "."
>> +  -- pull new patches
>> +  us <- readRepo toRepo
>> +  them <- readRepo fromRepo
>> +  comm :\/: unc <- return $ findCommonAndUncommon us them
>> +  revertTentativeChanges
>> +  Sealed pw <- tentativelyMergePatches toRepo "get" opts comm unc
>> +  withGutsOf toRepo $ do
>> +    finalizeRepositoryChanges toRepo
>> +    applyToWorking toRepo opts pw
>> +    return ()
>> +  -- get old patches
>> +  fetchPatchesIfNecessary opts toRepo
> Other than the above observation, I think this is basically OK. It may
> be useful to factor the "pull new patches" bit into a helper function
> (or look if there is one already, although there probably isn't). Or
> maybe not. I defer that decision to you.

Looks useful for me, too. Though I wouldn't put high priority on that.

> Recompress repository packs
> ---------------------------
>
>> hunk ./src/Darcs/Commands/Optimize.lhs 24
>>  {-# LANGUAGE CPP #-}
>>
>>  module Darcs.Commands.Optimize ( optimize ) where
>> -import Control.Monad ( when, unless )
>> +import Control.Applicative ( (<$>) )
>> +import Control.Monad ( when, unless, (<=<) )
>>  import Data.Maybe ( isJust )
>>  import System.Directory ( getDirectoryContents, doesDirectoryExist, doesFileExist )
>>  import qualified Data.ByteString.Char8 as BS
>> hunk ./src/Darcs/Commands/Optimize.lhs 29
>> +import qualified Data.ByteString.Lazy as BL
>>
>>  import Storage.Hashed.Darcs( decodeDarcsSize )
>>
>> hunk ./src/Darcs/Commands/Optimize.lhs 91
>>  import Storage.Hashed.Plain( readPlainTree )
>>  import Storage.Hashed.Darcs( writeDarcsHashed )
>>
>> -import Codec.Archive.Tar ( create )
>> +import Codec.Archive.Tar ( write )
>> +import Codec.Archive.Tar.Entry ( fileEntry, toTarPath )
>> +import Codec.Compression.GZip ( compress )
>>
>>  #include "gadts.h"
>>
> OK (imports again)
>
>> hunk ./src/Darcs/Commands/Optimize.lhs 371
>>
>>  doOptimizeHTTP :: IO ()
>>  doOptimizeHTTP = withRepoLock [] $- \_ -> do
>> +  rf <- either fail return =<< identifyRepoFormat "."
>> +  unless (formatHas HashedInventory rf) $ fail
>> +    "Unsupported repository format"
>>    createDirectoryIfMissing False packsDir
> Good point. Does this maybe belong to a separate patch, or maybe to the
> previous one? Does not seem to be directly related to re-compression.

I've put some fixes of previous patch to this one, they'll be in place
in the next amendment.

>> hunk ./src/Darcs/Commands/Optimize.lhs 375
>> -  create (packsDir </> "invprist.tar") "" $ map (darcsdir </>)
>> -    ["hashed_inventory", "inventories", "pristine.hashed"]
>> -  create (packsDir </> "patches.tar") "" $ [darcsdir </> "patches"]
>> +  i <- fileEntry' $ darcsdir </> "hashed_inventory"
>> +  is <- tarDarcsDir "inventories"
>> +  pr <- tarDarcsDir "pristine.hashed"
>> +  BL.writeFile (packsDir </> "invprist.tar.gz") . compress $ write (i : (is ++ pr))
>> +  ps <- tarDarcsDir "patches"
>> +  BL.writeFile (packsDir </> "patches.tar.gz") . compress $ write ps
>>   where
>>    packsDir = darcsdir </> "packs"
>> hunk ./src/Darcs/Commands/Optimize.lhs 383
>> +  fileEntry' x = do
>> +    content <- BL.fromChunks . return <$> gzReadFilePS x
>> +    tp <- either fail return (toTarPath False x)
>> +    return $ fileEntry tp content
>> +  dirContents d = map (d </>) . filter ((/= '.') . head) <$> getDirectoryContents d
>> +  tarDarcsDir = mapM fileEntry' <=< dirContents . (darcsdir </>)
> OK
>
>> hunk ./src/Darcs/Repository.hs 48
>>      ) where
>>
>>  import System.Exit ( ExitCode(..), exitWith )
>> +import Data.List ( isSuffixOf )
>>  import Data.Maybe( catMaybes )
>>
>>  import Darcs.Repository.State( readRecorded, readUnrecorded, readWorking, unrecordedChanges
>> hunk ./src/Darcs/Repository.hs 86
>>  import URL ( maxPipelineLength )
>>
>>  import Control.Monad ( unless, when )
>> -import System.Directory ( createDirectory, renameDirectory )
>> +import System.Directory ( createDirectory, renameDirectory, createDirectoryIfMissing )
>>  import System.IO.Error ( isAlreadyExistsError )
>>
>>  import qualified Darcs.Repository.DarcsRepo as DarcsRepo
>> hunk ./src/Darcs/Repository.hs 108
>>  import Darcs.Patch.Depends ( getPatchesBeyondTag, areUnrelatedRepos, findCommonAndUncommon )
>>  import Darcs.Utils ( withCurrentDirectory, catchall, promptYorn, prettyError )
>>  import Darcs.External ( copyFileOrUrl, Cachable(..), fetchFilePS )
>> -import Darcs.Lock ( withTemp )
>>  import Progress ( debugMessage, tediousSize, beginTedious, endTedious )
>>  import Darcs.ProgressPatches (progressRLShowTags, progressFL)
>>  import Darcs.Lock ( writeBinFile, writeDocBinFile, rmRecursive )
>> hunk ./src/Darcs/Repository.hs 125
>>  import ByteStringUtils( gzReadFilePS )
>>
>>  import System.FilePath( (</>) )
>> -import Codec.Archive.Tar ( extract )
>> -
>> +import qualified Codec.Archive.Tar as Tar
>> +import Codec.Compression.GZip ( compress, decompress )
>>  import qualified Data.ByteString.Char8 as BS
>> hunk ./src/Darcs/Repository.hs 128
>> +import qualified Data.ByteString.Lazy as BL
>>
>>  #include "impossible.h"
>>
> OK, more imports
>
>> hunk ./src/Darcs/Repository.hs 155
>>             unless (isPartial == IsPartial) $ copyFullRepository fromRepo
>>      | otherwise = do
>>          isPacked <- doesRemoteFileExist $ fromDir </> darcsdir </>
>> -          "packs" </> "invprist.tar"
>> +          "packs" </> "invprist.tar.gz"
>>          if isPacked
>>            then copyPackedRepository fromRepo
>>            else copyFullRepository fromRepo
> OK
>
>> hunk ./src/Darcs/Repository.hs 160
>>   where
>> -  doesRemoteFileExist x = fetchFilePS x Cachable >> return True `catch`
>> -    (\_ -> return False)
>> +  doesRemoteFileExist x = (fetchFilePS x Cachable >> return True) `catchall`
>> +    return False
> Changes catch to catchall, probably quite OK. Maybe should be amend of
> previous though, instead of part of this one.

The main fix here are parentheses, without them exception doesn't get caught.

>>  data PorNP = NotPartial | IsPartial
>>               deriving ( Eq )
>> hunk ./src/Darcs/Repository.hs 273
>>    toCache2 <- unionRemoteCaches toCache fromCache fromDir
>>    let toRepo :: Repository p C(r u t)
>>        toRepo = Repo toDir opts toFormat $ DarcsRepository toPristine toCache2
>> +      fromPacksDir = fromDir ++ "/" ++ darcsdir ++ "/packs/"
>> +  createDirectoryIfMissing False $ toDir </> darcsdir </> "inventories"
>> +  createDirectoryIfMissing False $ toDir </> darcsdir </> "pristine.hashed"
>> +  createDirectoryIfMissing False $ toDir </> darcsdir </> "patches"
>>    -- unpack inventory & pristine cache
>> hunk ./src/Darcs/Repository.hs 278
>> -  withTemp $ \tmp -> do
>> -    let fromPacksDir = fromDir ++ "/" ++ darcsdir ++ "/packs/"
>> -    copyFileOrUrl [] (fromPacksDir ++ "invprist.tar") tmp Uncachable
>> -    extract toDir tmp
>> -    createPristineDirectoryTree toRepo "."
>> +  writeCompressed . Tar.read . decompress . BL.fromChunks . return =<<
>> +    fetchFilePS (fromPacksDir ++ "invprist.tar.gz") Uncachable
> This is a little dangerous, since it means having the complete tarball
> in memory at once. The version with temporary directory is probably
> better. You can presumably decompress and unpack the tarball in a
> streamed fashion from disk somehow? This may need some benchmarking and
> maybe some creative way to measure memory usage during decompression.

Clone of fetchFilePS that works on lazy bytestrings should solve that,
even without saving to disk. And why there's need for creative
benchmarking, wouldn't GHC's standard profiling features suffice?

>> +  createPristineDirectoryTree toRepo "."
>>    -- pull new patches
>>    us <- readRepo toRepo
>>    them <- readRepo fromRepo
>> hunk ./src/Darcs/Repository.hs 292
>>      applyToWorking toRepo opts pw
>>      return ()
>>    -- get old patches
>> -  fetchPatchesIfNecessary opts toRepo
>> +  writeCompressed . Tar.read . decompress . BL.fromChunks .
>> +    return =<< fetchFilePS (fromPacksDir ++ "patches.tar.gz") Uncachable
>> + where
>> +  writeCompressed Tar.Done = return ()
>> +  writeCompressed (Tar.Next x xs) = case Tar.entryContent x of
>> +    Tar.NormalFile x' _ -> do
>> +      let p = Tar.entryPath x
>> +      BL.writeFile p $ if "hashed_inventory" `isSuffixOf` p
>> +        then x'
>> +        else compress x'
>> +      writeCompressed xs
>> +    _ -> fail ""
>> +  writeCompressed (Tar.Fail e) = fail e
> OK

The one thing I'm not sure about is how to use cache. For me it looks like this:

case number of cached patches of
  Few -> copy a patch pack, ignore cached patches
  Many -> copy cached patches, copy remote patches one-by-one

But reliable way to determine border between these cases is mystery to
me. Or maybe these methods could be somehow combined? Say, start
copying patch pack to get patches from the end of history and in
parallel copy patches one by one using cache from the start. Looks
like a good idea, maybe there are some cases where it won't work well?

4 patches for repository http://darcs.net/:

Thu Jun  3 14:59:00 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Add --http flag for optimize

Thu Jun  3 15:11:36 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Refactor Darcs.Repository.copyInventory (consistent naming)

Thu Jun 10 21:51:42 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Create a function for lazy fetching files

Fri Jun 18 22:25:00 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Implement darcs optimize --http

Attachments

• add-__http-flag-for-optimize.dpatch
• unnamed

Back to you, Petr (this should probably be automated).

Looks like Alexey was right about there being a chance of this being in
2.5 after all :-)

Hi,

Add --http flag for optimize
----------------------------

> hunk ./src/Darcs/Arguments.lhs 89
>                           networkOptions, noCache,
>                           allowUnrelatedRepos,
>                           checkOrRepair, justThisRepo, optimizePristine,
> -                         getOutput
> +                         optimizeHTTP, getOutput
>                        ) where
>  import System.Console.GetOpt
>  import System.Directory ( doesDirectoryExist )
> hunk ./src/Darcs/Arguments.lhs 320
>  getContent Repair = NoContent
>  getContent JustThisRepo = NoContent
>  getContent OptimizePristine = NoContent
> +getContent OptimizeHTTP = NoContent
>  
>  getContentString :: DarcsFlag -> Maybe String
>  getContentString f =
> hunk ./src/Darcs/Arguments.lhs 1611
>  optimizePristine :: DarcsOption
>  optimizePristine = DarcsNoArgOption [] ["pristine"] OptimizePristine
>                            "optimize hashed pristine layout"
> +
> +optimizeHTTP :: DarcsOption
> +optimizeHTTP = DarcsNoArgOption [] ["http"] OptimizeHTTP
> +                          "optimize repository for getting over network"
>  \end{code}
>  \begin{options}
>  --umask
> hunk ./src/Darcs/Flags.hs 92
>                 | UseFormat2
>                 | PristinePlain | PristineNone | NoUpdateWorking
>                 | Sibling AbsolutePath | Relink | RelinkPristine | NoLinks
> -               | OptimizePristine
> +               | OptimizePristine | OptimizeHTTP
>                 | UpgradeFormat
>                 | Files | NoFiles | Directories | NoDirectories
>                 | Pending | NoPending
Ok.

Refactor Darcs.Repository.copyInventory (consistent naming)
-----------------------------------------------------------

> hunk ./src/Darcs/Repository.hs 100
>  import Darcs.Witnesses.Ordered ( FL(..), RL(..), bunchFL, mapFL, mapRL
>                                 , reverseRL ,lengthRL, (+>+) )
>  import Darcs.Patch.Info ( PatchInfo )
> -import Darcs.Repository.Format ( RepoProperty ( HashedInventory ),
> +import Darcs.Repository.Format ( RepoProperty ( HashedInventory ), RepoFormat,
>                                   createRepoFormat, formatHas, writeRepoFormat )
>  import Darcs.Repository.Prefs ( writeDefaultPrefs )
>  import Darcs.Repository.Pristine ( createPristine, flagsToPristine, createPristineFromWorking )
> hunk ./src/Darcs/Repository.hs 158
>  
>  data RepoSort = Hashed | Old
>  
> +repoSort :: RepoFormat -> RepoSort
> +repoSort f
> +  | formatHas HashedInventory f = Hashed
> +  | otherwise = Old
> +
>  copyInventory :: forall p C(r u t). RepoPatch p => Repository p C(r u t) -> IO ()
> hunk ./src/Darcs/Repository.hs 164
> -copyInventory fromrepo@(Repo fromdir opts rf (DarcsRepository _ cremote)) = do
> -  repo@(Repo todir xx rf2 (DarcsRepository yy c)) <- identifyRepositoryFor fromrepo "."
> -  newcache <- unionRemoteCaches c cremote fromdir
> -  let newrepo :: Repository p C(r u t)
> -      newrepo = Repo todir xx rf2 (DarcsRepository yy newcache)
> -      copyHashedHashed = HashedRepo.copyRepo newrepo opts fromdir
> -      copyAnythingToOld r = withCurrentDirectory todir $ readRepo r >>=
> +copyInventory fromRepo@(Repo fromDir opts fromFormat (DarcsRepository _ fromCache)) = do
> +  toRepo@(Repo toDir opts' toFormat (DarcsRepository toPristine toCache)) <-
> +    identifyRepositoryFor fromRepo "."
> +  toCache2 <- unionRemoteCaches toCache fromCache fromDir
> +  let toRepo2 :: Repository p C(r u t)
> +      toRepo2 = Repo toDir opts' toFormat $ DarcsRepository toPristine toCache2
It's more common to use ' (prime) as a suffix in Haskell than 2 (the
latter usually means 2-argument, like liftM2...)

> +      copyHashedHashed = HashedRepo.copyRepo toRepo2 opts fromDir
> +      copyAnythingToOld r = withCurrentDirectory toDir $ readRepo r >>=
>                              DarcsRepo.writeInventoryAndPatches opts
I'd say copyAnyToOld is a better name than copyAnythingToOld. (But now I
see this is not a name you introduced -- you can still rename it if you
are amending or extending this, though...)

> hunk ./src/Darcs/Repository.hs 173
> -      repoSort rfx | formatHas HashedInventory rfx = Hashed
> -                   | otherwise = Old
> -  case repoSort rf2 of
> -    Hashed ->
> -        if formatHas HashedInventory rf
> -        then copyHashedHashed
> -        else withCurrentDirectory todir $
> -             do HashedRepo.revertTentativeChanges
> -                patches <- readRepo fromrepo
> +  case repoSort fromFormat of
> +    Hashed -> case repoSort toFormat of
> +      Hashed -> copyHashedHashed
> +      Old -> copyAnythingToOld fromRepo
> +    Old -> case repoSort toFormat of
> +      Hashed -> withCurrentDirectory toDir $ do
> +                HashedRepo.revertTentativeChanges
> +                patches <- readRepo fromRepo
>                  let k = "Copying patch"
>                  beginTedious k
>                  tediousSize k (lengthRL $ newset2RL patches)
> hunk ./src/Darcs/Repository.hs 185
>                  let patches' = progressPatchSet k patches
> -                HashedRepo.writeTentativeInventory c (compression opts) patches'
> +                HashedRepo.writeTentativeInventory toCache {- toCache2? -} (compression opts) patches'

I think toCache is OK, since it's what the original code did.

>                  endTedious k
> hunk ./src/Darcs/Repository.hs 187
> -                HashedRepo.finalizeTentativeChanges repo (compression opts)
> -    Old -> case repoSort rf of
> -           Hashed -> copyAnythingToOld fromrepo
> -           _ -> copyOldrepoPatches opts fromrepo todir
> +                HashedRepo.finalizeTentativeChanges toRepo {- toRepo2? -} (compression opts)
> +      Old -> copyOldrepoPatches opts fromRepo toDir
Again, toRepo should be OK.

Create a function for lazy fetching files
-----------------------------------------

(maybe fix the patch title here to say "fetching of files"?)

> hunk ./src/Darcs/External.hs 7
>      backupByRenaming, backupByCopying,
>      copyFileOrUrl, speculateFileOrUrl, copyFilesOrUrls, copyLocal, cloneFile,
>      cloneTree, cloneTreeExcept, clonePartialsTree, clonePaths,
> -    fetchFilePS, gzFetchFilePS,
> +    fetchFilePS, fetchFileLazyPS, gzFetchFilePS,
>      sendEmail, generateEmail, sendEmailDoc, resendEmail,
>      signString, verifyPS,
>      execDocPipe, execPipeIgnoreError,
> hunk ./src/Darcs/External.hs 64
>              ,hGetContents, writeFile, hPut, length
>              ,take, concat, drop, isPrefixOf, singleton, append)
>  import qualified Data.ByteString.Char8 as BC (unpack, pack)
> +import qualified Data.ByteString.Lazy as BL
>  
>  import Darcs.Lock ( withTemp, withOpenTemp, tempdirLoc, removeFileMayNotExist )
>  import CommandLine ( parseCmd, addUrlencoded )
> hunk ./src/Darcs/External.hs 138
>                                              copyFileOrUrl opts fou t cache
>                                              B.readFile t
>  
> +fetchFileLazyPS :: String -> Cachable -> IO BL.ByteString
> +fetchFileLazyPS fou _ | isFile fou = BL.readFile fou
> +fetchFileLazyPS fou cache = withTemp $ \t -> do let opts = [] -- FIXME: no network flags
> +                                                copyFileOrUrl opts fou t cache
> +                                                BL.readFile t
> +
>  gzFetchFilePS :: String -> Cachable -> IO B.ByteString
>  gzFetchFilePS fou _ | isFile fou = gzReadFilePS fou
>  gzFetchFilePS fou cache = withTemp $ \t-> do let opts = [] -- FIXME: no network flags
Ok, although it should be noted that the lazy readFile may constitute a
resource (fd) leak -- a haddock explaining that would be certainly
appropriate. (I.e. this behaves the same as Prelude.readFile -- see
contrib/darcs-errors.hlint in your darcs source tree for explanation.)

Implement darcs optimize --http
-------------------------------

Ok, the main patch...

> hunk ./src/Darcs/Commands/Optimize.lhs 24
>  {-# LANGUAGE CPP #-}
>  
>  module Darcs.Commands.Optimize ( optimize ) where
> +import Control.Applicative ( (<$>) )
: - )

>  import Control.Monad ( when, unless )
>  import Data.Maybe ( isJust )
>  import System.Directory ( getDirectoryContents, doesDirectoryExist, doesFileExist )
> hunk ./src/Darcs/Commands/Optimize.lhs 29
>  import qualified Data.ByteString.Char8 as BS
> +import qualified Data.ByteString.Lazy as BL
>  
>  import Storage.Hashed.Darcs( decodeDarcsSize )
>  
> hunk ./src/Darcs/Commands/Optimize.lhs 38
>  import Darcs.Arguments ( DarcsFlag( UpgradeFormat, UseHashedInventory,
>                                      Compress, UnCompress,
>                                      NoCompress, Reorder,
> -                                    Relink, RelinkPristine, OptimizePristine ),
> +                                    Relink, RelinkPristine, OptimizePristine,
> +                                    OptimizeHTTP ),
>                          reorderPatches,
>                          uncompressNocompress,
>                          relink, relinkPristine, sibling,
> hunk ./src/Darcs/Commands/Optimize.lhs 45
>                          flagsToSiblings,
>                          upgradeFormat,
> -                        workingRepoDir, umaskOption, optimizePristine
> +                        workingRepoDir, umaskOption, optimizePristine,
> +                        optimizeHTTP
>                        )
>  import Darcs.Repository.Prefs ( getPreflist )
>  import Darcs.Repository ( Repository,
> hunk ./src/Darcs/Commands/Optimize.lhs 91
>  import Storage.Hashed.Plain( readPlainTree )
>  import Storage.Hashed.Darcs( writeDarcsHashed )
>  
> +import Codec.Archive.Tar ( write )
> +import Codec.Archive.Tar.Entry ( fileEntry, toTarPath )
> +import Codec.Compression.GZip ( compress )
> +
>  #include "gadts.h"
>  
>  optimizeDescription :: String
> hunk ./src/Darcs/Commands/Optimize.lhs 138
>                                                   sibling, relink,
>                                                   relinkPristine,
>                                                    upgradeFormat,
> -                                                 optimizePristine]}
> +                                                 optimizePristine,
> +                                                 optimizeHTTP]}
>  
>  optimizeCmd :: [DarcsFlag] -> [String] -> IO ()
>  optimizeCmd origopts _ = do
> hunk ./src/Darcs/Commands/Optimize.lhs 145
>      when (UpgradeFormat `elem` origopts) optimizeUpgradeFormat
>      withRepoLock opts $- \repository -> do
> +    when (OptimizeHTTP `elem` origopts) doOptimizeHTTP
>      if (OptimizePristine `elem` opts)
>         then doOptimizePristine repository
>         else do cleanRepository repository
So far so good.

> hunk ./src/Darcs/Commands/Optimize.lhs 368
>      withCurrentDirectory dir $ do
>        gzs <- filter ((== ".gz") . takeExtension) `fmap` getDirectoryContents "."
>        mapM_ removeFile gzs
> +
> +doOptimizeHTTP :: IO ()
> +doOptimizeHTTP = do
> +  rf <- either fail return =<< identifyRepoFormat "."
> +  unless (formatHas HashedInventory rf) $ fail
> +    "Unsupported repository format"
The error message should explicitly say what was expected: "Only hashed
repositories can be optimized for HTTP" or something in that vein.

> +  createDirectoryIfMissing False packsDir
> +  i <- fileEntry' $ darcsdir </> "hashed_inventory"
> +  is <- tarDarcsDir "inventories"
> +  pr <- tarDarcsDir "pristine.hashed"
> +  BL.writeFile (packsDir </> "basic.tar.gz") . compress $ write (i : (is ++ pr))
> +  ps <- tarDarcsDir' "patches" $ \x -> all (x /=) ["unrevert", "pending",
> +    "pending.tentative"]
> +  BL.writeFile (packsDir </> "patches.tar.gz") . compress $ write ps
> + where
> +  packsDir = darcsdir </> "packs"
> +  fileEntry' x = do
> +    content <- BL.fromChunks . return <$> gzReadFilePS x
> +    tp <- either fail return $ toTarPath False x
> +    return $ fileEntry tp content
> +  dirContents d f = map (d </>) . filter (\x -> head x /= '.' && f x) <$>
> +    getDirectoryContents d
> +  tarDarcsDir d = tarDarcsDir' d $ const True
> +  tarDarcsDir' d f = mapM fileEntry' =<< dirContents (darcsdir </> d) f
>  \end{code}
Looks OK, although I would like to hear from you about memory behaviour
of the code, as discussed before (IIRC). :)

> hunk ./src/Darcs/Repository.hs 48
[SNIP pile of import wibbling]

> hunk ./src/Darcs/Repository.hs 131
> +import qualified Data.ByteString.Lazy as BL
>  
>  #include "impossible.h"
>  
> hunk ./src/Darcs/Repository.hs 235
>             return IsPartial
>  
>  copyFullRepository :: forall p C(r u t). RepoPatch p => Repository p C(r u t) -> IO ()
> -copyFullRepository fromrepository@(Repo fromdir opts rffrom _) = do
> -  copyInventory fromrepository
> +copyFullRepository fromRepo@(Repo fromDir opts _ _) = do
>    debugMessage "Copying prefs"
> hunk ./src/Darcs/Repository.hs 237
> -  copyFileOrUrl opts (fromdir++"/"++darcsdir++"/prefs/prefs") (darcsdir++"/prefs/prefs") (MaxAge 600)
> -                     `catchall` return ()
> +  copyFileOrUrl opts (fromDir ++ "/" ++ darcsdir ++ "/prefs/prefs")
> +    (darcsdir ++ "/prefs/prefs") (MaxAge 600) `catchall` return ()
(about reformatting: I am not complaining about how it looks now, but it
helps review to do formatting changes in separate patch that says it's
just formatting)

> +  b <- (Just <$> fetchFileLazyPS (fromDir ++ "/" ++ darcsdir ++
> +    "/packs/basic.tar.gz") Uncachable) `catchall` return Nothing
> +  case b of
> +    Nothing -> copyNotPackedRepository fromRepo
> +    Just b' -> copyPackedRepository fromRepo b'
> +
> +copyNotPackedRepository :: forall p C(r u t). RepoPatch p => Repository p C(r u t) -> IO ()
> +copyNotPackedRepository fromrepository@(Repo _ opts rffrom _) = do
The "NotPacked" in the name is a bit edgy, but I can't think of anything
better that's also clear enough, so keep it as it is.

> +  copyInventory fromrepository
>    debugMessage "Grabbing lock in new repository..."

> hunk ./src/Darcs/Repository.hs 249
> -  withRepoLock opts $- \torepository@(Repo _ _ rfto (DarcsRepository _ c)) ->
> +  withRepoLock opts $- \torepository@(Repo _ _ rfto _) ->
>        if formatHas HashedInventory rffrom && formatHas HashedInventory rfto
>        then do debugMessage "Writing working directory contents..."
>                createPristineDirectoryTree torepository "."
Is this just a warning fix?

> hunk ./src/Darcs/Repository.hs 268
>                     debugMessage "Writing the pristine"
>                     pristineFromWorking torepository

> +copyPackedRepository :: forall p C(r u t). RepoPatch p =>
> +  Repository p C(r u t) -> BL.ByteString -> IO ()
> +copyPackedRepository fromRepo@(Repo fromDir opts _ (DarcsRepository _ fromCache)) b = do
> +  Repo toDir _ toFormat (DarcsRepository toPristine toCache) <-
> +    identifyRepositoryFor fromRepo "."
> +  toCache2 <- unionRemoteCaches toCache fromCache fromDir
> +  let toRepo :: Repository p C(r u t)
> +      toRepo = Repo toDir opts toFormat $ DarcsRepository toPristine toCache2
> +      fromPacksDir = fromDir ++ "/" ++ darcsdir ++ "/packs/"
> +  createDirectoryIfMissing False $ toDir </> darcsdir </> "inventories"
> +  createDirectoryIfMissing False $ toDir </> darcsdir </> "pristine.hashed"
> +  createDirectoryIfMissing False $ toDir </> darcsdir </> "patches"
> +  copySources toRepo fromDir
> +  -- unpack inventory & pristine cache
> +  writeCompressed . Tar.read $ decompress b
> +  createPristineDirectoryTree toRepo "."
For all I can tell, this function is a complete misnomer: what this does
is copy the existing pristine into the working copy. (!) It is out of
scope for this patch, but I am noting down that it needs to be audited
and renamed.

> +  -- pull new patches
> +  us <- readRepo toRepo
> +  them <- readRepo fromRepo
> +  comm :\/: unc <- return $ findCommonAndUncommon us them
Hm, this is my sin, but the findCommonAndUncommon function actually does
not return any "common" patches. I will rename it later... You probably
want to rename "comm" and "unc" to "us'" and "them'".

> +  revertTentativeChanges
This might be redundant, but let's keep it in for a good measure.

> +  Sealed pw <- tentativelyMergePatches toRepo "get" opts comm unc
us' them' (due to above)

> +  invalidateIndex toRepo
> +  withGutsOf toRepo $ do
> +    finalizeRepositoryChanges toRepo
> +    applyToWorking toRepo opts pw
> +    return ()
Ok.

> +  -- get old patches
> +  writeCompressed . Tar.read . decompress =<< fetchFileLazyPS (fromPacksDir ++
> +    "patches.tar.gz") Uncachable
Great. We should also make this interruptible later, like normal "get"
is, with the result of getting a lazy repository. You can do this in a
followup patch and I won't hold up pushing this just for that.

> + where
> +  writeCompressed Tar.Done = return ()
> +  writeCompressed (Tar.Next x xs) = case Tar.entryContent x of
> +    Tar.NormalFile x' _ -> do
> +      let p = Tar.entryPath x
> +      BL.writeFile p $ if "hashed_inventory" `isSuffixOf` p
> +        then x'
> +        else compress x'
> +      writeCompressed xs
> +    _ -> fail "Unexpected non-file tar entry"
> +  writeCompressed (Tar.Fail e) = fail e
OK.

>  -- | writePatchSet is like patchSetToRepository, except that it doesn't
>  -- touch the working directory or pristine cache.
>  writePatchSet :: RepoPatch p => PatchSet p C(Origin x) -> [DarcsFlag] -> IO (Repository p C(r u t))
> hunk ./src/Darcs/Repository.hs 411
>          withCurrentDirectory dir $ readWorking >>= replacePristine repo
>  pristineFromWorking (Repo dir _ _ (DarcsRepository p _)) =
>    withCurrentDirectory dir $ createPristineFromWorking p
> +
> hunk ./src/Darcs/Repository/HashedRepo.hs 29
>                                       addToTentativeInventory, removeFromTentativeInventory,
>                                       readRepo, readTentativeRepo, writeAndReadPatch,
>                                       writeTentativeInventory, copyRepo,
> -                                     readHashedPristineRoot, pris2inv
> +                                     readHashedPristineRoot, pris2inv, copySources
>                                     ) where
>  
>  import System.Directory ( createDirectoryIfMissing )
> hunk ./src/Darcs/Repository/HashedRepo.hs 293
>      createDirectoryIfMissing False (outr++"/"++darcsdir++"/inventories")
>      copyFileOrUrl opts (inr++"/"++darcsdir++"/hashed_inventory") (outr++"/"++darcsdir++"/hashed_inventory")
>                    Uncachable -- no need to copy anything but hashed_inventory!
> +    copySources repo inr
> +    debugMessage "Done copying hashed inventory."
> +
> +copySources :: RepoPatch p => Repository p C(r u t) -> String -> IO ()
> +copySources repo@(Repo outr _ _ _) inr = do
>      let repoCache = extractCache $ modifyCache repo dropGlobalCaches
>      appendBinFile (outr++"/"++darcsdir++"/prefs/sources") (show $ repo2cache inr `unionCaches` repoCache )
> hunk ./src/Darcs/Repository/HashedRepo.hs 300
> -    debugMessage "Done copying hashed inventory."
>    where
>      dropGlobalCaches (Ca cache) = Ca $ filter notGlobalCache cache
>      notGlobalCache xs = case xs of

Split off copySources from copyRepo. Makes sense. Does not change
copyRepo semantics.

So, there's some minor wibbling to do still, but other than that,
awesome. I guess nothing of the mentioned issues warrants amending -- if
you run into dependencies, just record new patch(es) on top. I will hold
off pushing this till Thursday evening -- at that point, unless I run
into bugs, I can push. Please try to address my comments by then -- if
not, I will take care of the most pressing ones and will expect you to
post followup patches to fix the rest.

Thanks!

Yours,
   Petr.

> It's more common to use ' (prime) as a suffix in Haskell than 2 (the
> latter usually means 2-argument, like liftM2...)

Using prime here breaks the build:

src/Darcs/Repository.hs:173:30:
    Not in scope: type constructor or class `C'

It seems that some preprocessor magic doesn't work with primes well.

> I'd say copyAnyToOld is a better name than copyAnythingToOld. (But now I
> see this is not a name you introduced -- you can still rename it if you
> are amending or extending this, though...)

Done.

> I think toCache is OK, since it's what the original code did.
> …
> Again, toRepo should be OK.

OK, leaving the original version.


> Create a function for lazy fetching files
> -----------------------------------------
>
> (maybe fix the patch title here to say "fetching of files"?)

Fixed.

> Ok, although it should be noted that the lazy readFile may constitute a
> resource (fd) leak -- a haddock explaining that would be certainly
> appropriate. (I.e. this behaves the same as Prelude.readFile -- see
> contrib/darcs-errors.hlint in your darcs source tree for explanation.)

Done.

>> +import Control.Applicative ( (<$>) )
> : - )

That one should definetely go to Prelude (-:

> The error message should explicitly say what was expected: "Only hashed
> repositories can be optimized for HTTP" or something in that vein.

Done.

> (about reformatting: I am not complaining about how it looks now, but it
> helps review to do formatting changes in separate patch that says it's
> just formatting)

I had to touch that line anyway, because of variable renaming.

>> hunk ./src/Darcs/Repository.hs 249
>> -  withRepoLock opts $- \torepository@(Repo _ _ rfto (DarcsRepository _ c)) ->
>> +  withRepoLock opts $- \torepository@(Repo _ _ rfto _) ->
>>        if formatHas HashedInventory rffrom && formatHas HashedInventory rfto
>>        then do debugMessage "Writing working directory contents..."
>>                createPristineDirectoryTree torepository "."
> Is this just a warning fix?

Yes, I moved it to separate patch for clarity.

> Hm, this is my sin, but the findCommonAndUncommon function actually does
> not return any "common" patches. I will rename it later... You probably
> want to rename "comm" and "unc" to "us'" and "them'".

Done.

>> +  revertTentativeChanges
> This might be redundant, but let's keep it in for a good measure.

Darcs crashes if it's not there, so yes, let's keep it :)

> Great. We should also make this interruptible later, like normal "get"
> is, with the result of getting a lazy repository. You can do this in a
> followup patch and I won't hold up pushing this just for that.

I'll do this in another patch.


5 patches for repository http://darcs.net/:

Thu Jun  3 14:59:00 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Add --http flag for optimize

Thu Jun 24 20:28:22 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Refactor Darcs.Repository.copyInventory (consistent naming)

Thu Jun 24 21:01:46 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Create a function for lazy fetching of files

Thu Jun 24 21:38:11 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Implement darcs optimize --http

Thu Jun 24 21:39:10 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Fix warning in Darcs.Repository

Attachments

• add-__http-flag-for-optimize.dpatch
• unnamed

3 patches for repository http://darcs.net/:

Thu Jun 24 20:28:22 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Refactor Darcs.Repository.copyInventory (consistent naming)

Thu Jun 24 21:38:11 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Implement darcs optimize --http

Fri Jun 25 05:12:31 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Decrease memory consumption while packing a repo

Attachments

• refactor-darcs_repository_copyinventory-_consistent-naming_.dpatch
• unnamed

Hi,

Alexey Levan <bugs@darcs.net> writes:
> Alexey Levan <exlevan@gmail.com> added the comment:
>
>> It's more common to use ' (prime) as a suffix in Haskell than 2 (the
>> latter usually means 2-argument, like liftM2...)
>
> Using prime here breaks the build:
>
> src/Darcs/Repository.hs:173:30:
>     Not in scope: type constructor or class `C'
>
> It seems that some preprocessor magic doesn't work with primes well.
Ah, OK, of course CPP breaks. I keep forgetting about that...

> Thu Jun  3 14:59:00 EEST 2010  Alexey Levan <exlevan@gmail.com>
>   * Add --http flag for optimize
>
> Thu Jun 24 20:28:22 EEST 2010  Alexey Levan <exlevan@gmail.com>
>   * Refactor Darcs.Repository.copyInventory (consistent naming)
>
> Thu Jun 24 21:01:46 EEST 2010  Alexey Levan <exlevan@gmail.com>
>   * Create a function for lazy fetching of files
>
> Thu Jun 24 21:38:11 EEST 2010  Alexey Levan <exlevan@gmail.com>
>   * Implement darcs optimize --http
>
> Thu Jun 24 21:39:10 EEST 2010  Alexey Levan <exlevan@gmail.com>
>   * Fix warning in Darcs.Repository

About these, I am almost ready to push them -- if tests pass, I'll shove
them in (I'll deliberate on that unsafeInterleaveIO from your other
bundle). In the meantime, you should try to get some work done on
testing the code automatically.

This should go under tests/network (you can look around there to see how
things are usually done). You will need a repository somewhere on an
http server with the tarballs: you should probably host it somewhere
yourself while you are playing with things, eventually I can upload the
repository to darcs.net for you, alongside other test repos that live
there.

I can think of two more things: first, make sure that local get does not
use the packs -- this would be just extra overhead without getting us
anything. Second, we should also copy over any unpacked hashed files
into cache and if possible hardlink them with pre-existing copies. It
may be not completely trivial, but I would appreciate if you could look
into that. If you don't feel like you have enough time on this stage for
this latter change, you can file it in bugs.darcs.net so it's not
forgotten.

Hopefully, I'll be able to push this bundle today evening (I have to run
now and would prefer to not break anything in a haste).

Thanks,
   Petr.

Hi,

one more thing occurred to me...

Alexey Levan <bugs@darcs.net> writes:

> +doOptimizeHTTP :: IO ()
> +doOptimizeHTTP = do
> +  rf <- either fail return =<< identifyRepoFormat "."
> +  unless (formatHas HashedInventory rf) . fail $
> +    "Unsupported repository format:\n" ++
> +    "  only hashed repositories can be optimized for HTTP"
> +  createDirectoryIfMissing False packsDir
> +  let i = darcsdir </> "hashed_inventory"
> +  is <- dirContents "inventories"
> +  pr <- dirContents "pristine.hashed"
> +  BL.writeFile (packsDir </> "basic.tar.gz") . compress . write =<<
> +    mapM fileEntry' (i : (is ++ pr))
> +  ps <- dirContents' "patches" $ \x -> all (x /=) ["unrevert", "pending",
> +    "pending.tentative"]
> +  BL.writeFile (packsDir </> "patches.tar.gz") . compress . write =<<
> +    mapM fileEntry' ps
Writing the tarballs like this can disrupt gets that were middle of
getting them: you could end up with messed up tarball. You may need to
write them atomically -- write in a temporary file and move over the
existing one: there's some functionality in Darcs.Lock to achieve that,
although it may need to be extended to cover lazy ByteStrings.

Presumably, it does not matter if you get different versions of the
basic tarball and the patches tarball: the extra patches just get
pre-cached for the subsequent pull. No big deal...

Please don't amend this patch though, I'll take it as it is -- just make
sure to post a followup (on a new patch ticket, even).

> + where
> +  packsDir = darcsdir </> "packs"
> +  fileEntry' x = do
> +    content <- BL.fromChunks . return <$> gzReadFilePS x
> +    tp <- either fail return $ toTarPath False x
> +    return $ fileEntry tp content
> +  dirContents d = dirContents' d $ const True
> +  dirContents' d f = map ((darcsdir </> d) </>) . filter (\x ->
> +    head x /= '.' && f x) <$> getDirectoryContents (darcsdir </> d)

Thanks,
   Petr.

This patch bundle (with 3 patches) was just applied to the repository http://darcs.net/.
This message was brought to you by DarcsWatch
http://darcswatch.nomeata.de/repo_http:__darcs.net_.html#bundle-427991781ba18e5f2e3b2f8b884c2fa30a498cdf

This patch bundle (with 5 patches) was just applied to the repository http://darcs.net/.
This message was brought to you by DarcsWatch
http://darcswatch.nomeata.de/repo_http:__darcs.net_.html#bundle-9d6794b14c7ac3ca28555152e69b39c66a198f18

This patch bundle (with 3 patches) was just applied to the repository http://darcs.net/reviewed.
This message was brought to you by DarcsWatch
http://darcswatch.nomeata.de/repo_http:__darcs.net_reviewed.html#bundle-427991781ba18e5f2e3b2f8b884c2fa30a498cdf

This patch bundle (with 5 patches) was just applied to the repository http://darcs.net/reviewed.
This message was brought to you by DarcsWatch
http://darcswatch.nomeata.de/repo_http:__darcs.net_reviewed.html#bundle-9d6794b14c7ac3ca28555152e69b39c66a198f18