A couple of fixes for getting packes repositories.

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

Fri Aug 20 00:03:55 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Replace tmp- prefixes with meta- in packs

A change of prefix in meta-files in packs to better reflect their purpose.
Currently, there're 2 such files in packs, meta-filelist-pristine and
meta-filelist-inventories, which contain list of pack contents for optimized
parallel get.


Wed Oct  6 06:36:20 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Perform cleanup on exceptions in doOptimizeHTTP

Moved cleanup part of 'optimize --http' into finally block.


Wed Oct  6 07:30:35 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Remove warnings about name shadowing

What the patch name said.  (Mentioned warning is actually introduced by the
following patch).


Wed Oct  6 07:33:45 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Improve getting of packed repositories

In this patch the big (~ 100 lines) where clause of copyPackedRepository was
splitted into a bunch of top-level definitions.  Some of them were renamed to
be more meaningful without context.

Also, I wrote a general unpackTar function, which accepts meta- files anywhere
in tarball, calling provided meta-handler function.  It accepts a (stopCond ::
FilePath -> Bool) argument, and stops unpacking if stop condition is True.
This is made to make lazy get more efficient, as the inventory files in the
basic tarball actually don't needed for lazy repo.

This patch may resolve issue1910 (I haven't seen error messages for a while
after writing this patch).  This needs additional checking, though.


Sat Oct  9 12:16:40 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Make gzipped inventories parse correctly in readInventoryPrivate

A small fix to read all inventories during 'optimize --http'.  Without this
change, readInventoryPrivate doesn't uncompress inventory files and stops
reading them after the first one.


Sat Oct  9 12:54:53 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Moved inventories to patches tarball

To make lazy getting of optimized repositories simpler, 'optimize --http'
creates two tarballs: basic.tar.gz, with inventory and pristine files, and
patches.tar.gz, which contains patches.  The idea was that to get lazy
repository, you only need to download the basic tarball.  It appears that for
lazy repository, inventory files not needed, except of hashed_inventory.  In
this patch, optimize --http was changed to pack inventories into patches
tarball instead, and getting functions were modified accordingly.  Also,
unpackTar was simplified: it no longer accept stop condition, as there's no
need to stop unpacking in the middle anymore.


Sat Oct  9 14:10:21 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Use custom HTTP request for fetchFileLazyPS

fetchFileLazyPS, now with real laziness. (At cost of some code duplication).


Sat Oct  9 15:02:09 EEST 2010  Alexey Levan <exlevan@gmail.com>
  * Add flag for using repository packs

Two new flags for 'darcs get', --packs and --no-packs [DEFAULT].

Attachments

• replace-tmp_-prefixes-with-meta_-in-packs.dpatch
• unnamed

On Sat, 09 Oct 2010 12:58:00 +0000
Alexey Levan <bugs@darcs.net> wrote:

> To make lazy getting of optimized repositories simpler, 'optimize
> --http' creates two tarballs: basic.tar.gz, with inventory and
> pristine files, and patches.tar.gz, which contains patches.

Aren't patches already gzipped, /always/? If so, maybe there could be
a gain (both in processing time and eventually size) in downloading a
plain patches.tar?

just a few cents,
thanks&bye,
lele.
-- 
nickname: Lele Gaifax    | Quando vivrò di quello che ho pensato ieri
real: Emanuele Gaifas    | comincerò ad aver paura di chi mi copia.
lele@nautilus.homeip.net |                 -- Fortunato Depero, 1929.

2010/10/9 Lele Gaifax <lele@nautilus.homeip.net>:
> On Sat, 09 Oct 2010 12:58:00 +0000
> Alexey Levan <bugs@darcs.net> wrote:
>
>> To make lazy getting of optimized repositories simpler, 'optimize
>> --http' creates two tarballs: basic.tar.gz, with inventory and
>> pristine files, and patches.tar.gz, which contains patches.
>
> Aren't patches already gzipped, /always/? If so, maybe there could be
> a gain (both in processing time and eventually size) in downloading a
> plain patches.tar?

To reduce size, during optimisation each patch is decompressed, then
archived into the tarball and the resulting archive is compressed
again.  For patches packed this way, the size of tarball is smaller
than gzipped patches in a plain tar.

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.

Alexey Levan <bugs@darcs.net> writes:

> Wed Oct  6 07:33:45 EEST 2010  Alexey Levan <exlevan@gmail.com>
>   * Improve getting of packed repositories
>
> In this patch the big (~ 100 lines) where clause of copyPackedRepository was
> splitted into a bunch of top-level definitions.  Some of them were renamed to
> be more meaningful without context.
>
> Also, I wrote a general unpackTar function, which accepts meta- files anywhere
> in tarball, calling provided meta-handler function.  It accepts a (stopCond ::
> FilePath -> Bool) argument, and stops unpacking if stop condition is True.
> This is made to make lazy get more efficient, as the inventory files in the
> basic tarball actually don't needed for lazy repo.
>
> This patch may resolve issue1910 (I haven't seen error messages for a while
> after writing this patch).  This needs additional checking, though.

Presumably, this could still happen with full (as opposed to lazy) get,
but only in the rare circumstance that the cache thread beats the tar
thread even though not everything is cached (at least the missing
inventory file must not be in the cache for the error to happen).

> Sat Oct  9 12:16:40 EEST 2010  Alexey Levan <exlevan@gmail.com>
>   * Make gzipped inventories parse correctly in readInventoryPrivate
>
> A small fix to read all inventories during 'optimize --http'.  Without this
> change, readInventoryPrivate doesn't uncompress inventory files and stops
> reading them after the first one.
>
>
> Sat Oct  9 12:54:53 EEST 2010  Alexey Levan <exlevan@gmail.com>
>   * Moved inventories to patches tarball
>
> To make lazy getting of optimized repositories simpler, 'optimize --http'
> creates two tarballs: basic.tar.gz, with inventory and pristine files, and
> patches.tar.gz, which contains patches.  The idea was that to get lazy
> repository, you only need to download the basic tarball.  It appears that for
> lazy repository, inventory files not needed, except of hashed_inventory.  In
> this patch, optimize --http was changed to pack inventories into patches
> tarball instead, and getting functions were modified accordingly.  Also,
> unpackTar was simplified: it no longer accept stop condition, as there's no
> need to stop unpacking in the middle anymore.
>
>
> Sat Oct  9 14:10:21 EEST 2010  Alexey Levan <exlevan@gmail.com>
>   * Use custom HTTP request for fetchFileLazyPS
>
> fetchFileLazyPS, now with real laziness. (At cost of some code duplication).
>
>
> Sat Oct  9 15:02:09 EEST 2010  Alexey Levan <exlevan@gmail.com>
>   * Add flag for using repository packs
>
> Two new flags for 'darcs get', --packs and --no-packs [DEFAULT].
>

Improve getting of packed repositories
--------------------------------------

> hunk ./src/Darcs/Repository.hs 90
>  import Control.Applicative ( (<$>) )
>  import Control.Exception ( finally )
>  import Control.Concurrent ( forkIO )
> -import Control.Concurrent.MVar ( newEmptyMVar, putMVar, takeMVar )
> +import Control.Concurrent.MVar ( MVar, newMVar, putMVar, takeMVar )
>  import Control.Monad ( unless, when )
>  import System.Directory ( createDirectory, renameDirectory,
>                            createDirectoryIfMissing, renameFile,
> hunk ./src/Darcs/Repository.hs 304
>    Repo _ _ _ (DarcsRepository _ toCache3) <-
>      identifyRepositoryFor toRepo "."
>    -- unpack inventory & pristine cache
> +  let isLazy = any (`elem` opts) [Partial, Lazy, Ephemeral]
>    cleanDir "pristine.hashed"
> hunk ./src/Darcs/Repository.hs 306
> -  procBasic toCache3 . Tar.read $ decompress b
> +  removeFile $ darcsdir </> "hashed_inventory"
> +  unpackBasic isLazy toCache3 . Tar.read $ decompress b
>    createPristineDirectoryTree toRepo "."
>    -- pull new patches
>    us <- readRepo toRepo
> hunk ./src/Darcs/Repository.hs 321
>      applyToWorking toRepo opts pw
>      return ()
>    -- get old patches
> -  (do
> +  unless isLazy $ (do
>      cleanDir "patches"
> hunk ./src/Darcs/Repository.hs 323
> -    unless (any (`elem` opts) [Partial, Lazy, Ephemeral]) $ do
> -      putInfo opts $ text "Copying patches, to get lazy repository hit ctrl-C..."
> -      mv <- newEmptyMVar
> -      _ <- forkIO . flip finally (putMVar mv ()) .
> -        fetchFiles toCache3 HashedPatchesDir . mapFL hashedPatchFileName $
> -        newset2FL us
> -      procPatches toCache3 . Tar.read . decompress =<<
> -        fetchFileLazyPS (fromPacksDir ++ "patches.tar.gz") Uncachable
> -      takeMVar mv) `catchInterrupt` (putInfo opts $ text "Using lazy repository.")
> +    putInfo opts $ text "Copying patches, to get lazy repository hit ctrl-C..."
> +    unpackPatches toCache3 (mapFL hashedPatchFileName $ newset2FL us) .
> +      Tar.read . decompress =<< fetchFileLazyPS (fromPacksDir ++
> +      "patches.tar.gz") Uncachable
> +    ) `catchInterrupt` (putInfo opts $ text "Using lazy repository.")
>   where
> hunk ./src/Darcs/Repository.hs 329
> -  procBasic = procHashedInv
> -  procPatches ca = procFiles $ cacheDir ca
> -  procHashedInv _ Tar.Done = fail
> -    "Unexpected end of file; hashed_inventory expected"
> -  procHashedInv ca (Tar.Next x xs) = withTarFile x $ \p c ->
> -    if "hashed_inventory" == takeFileName p
> -      then do
> -        writeFile' Nothing p c
> -        procTmp ca xs
> -      else fail $ "Unexpected file: " ++ takeFileName p ++
> -        "\nhashed_inventory expected"
> -  procHashedInv _ (Tar.Fail e) = fail e
> -  procTmp _ Tar.Done = return ()
> -  procTmp ca xxs@(Tar.Next x xs) = withTarFile x $ \p c ->
> +  cleanDir d = mapM_ (\x -> removeFile $ darcsdir </> d </> x) .
> +    filter (\x -> head x /= '.') =<< getDirectoryContents (darcsdir </> d)
> +

> +withControlMVar :: (MVar () -> IO ()) -> IO ()
> +withControlMVar f = do
> +  mv <- newMVar ()
> +  f mv
> +  takeMVar mv
> +
> +forkWithControlMVar :: MVar () -> IO () -> IO ()
> +forkWithControlMVar mv f = do
> +  takeMVar mv
> +  _ <- forkIO $ flip finally (putMVar mv ()) f
> +  return ()

Could these two go into some more general place? And, more importantly,
get some haddocks?  : - )

> +removeMetaFiles :: IO ()
> +removeMetaFiles = mapM_ (removeFile . (darcsdir </>)) .
> +  filter ("meta-" `isPrefixOf`) =<< getDirectoryContents darcsdir
> +
> +unpackBasic :: Bool -> Cache -> Tar.Entries -> IO ()
> +unpackBasic isLazy c x = do
> +  withControlMVar $ \mv -> unpackTar (\y -> isLazy && (darcsdir </>
> +    "inventories") `isPrefixOf` y) c (basicMetaHandler isLazy c mv) x
> +  removeMetaFiles
> +
> +unpackPatches :: Cache -> [String] -> Tar.Entries -> IO ()
> +unpackPatches c ps x = do
> +  withControlMVar $ \mv -> do
> +    forkWithControlMVar mv $ fetchFilesUsingCache c HashedPatchesDir ps
> +    unpackTar (const False) c (return ()) x
> +  removeMetaFiles
> +
> +unpackTar :: (FilePath -> Bool) -> Cache -> IO () -> Tar.Entries -> IO ()
> +unpackTar _ _ _ Tar.Done = return ()
> +unpackTar _ _ _ (Tar.Fail e)= fail e
> +unpackTar stopCond c mh (Tar.Next x xs) = case Tar.entryContent x of
> +  Tar.NormalFile x' _ -> do
> +    let p = Tar.entryPath x
>      if "meta-" `isPrefixOf` takeFileName p
>        then do
> hunk ./src/Darcs/Repository.hs 369
> -        BL.writeFile p c
> -        procTmp ca xs
> -      else do
> -        ex <- and <$> mapM doesFileExist
> -          [ darcsdir </> "meta-filelist-pristine"
> -          , darcsdir </> "meta-filelist-inventories"
> -          ]
> +        BL.writeFile p x'
> +        mh
> +        unpackTar stopCond c mh xs
> +      else when (not $ stopCond p) $ do
> +        ex <- doesFileExist p
>          if ex
> hunk ./src/Darcs/Repository.hs 375
> -          then do
> -            mv <- newEmptyMVar
> -            _ <- forkIO . flip finally (putMVar mv ()) $ do
> -              fetchFiles ca HashedInventoriesDir . lines =<<
> -                readFile (darcsdir </> "meta-filelist-inventories")
> -              fetchFiles ca HashedPristineDir . lines =<<
> -                readFile (darcsdir </> "meta-filelist-pristine")
> -            procFiles (cacheDir ca) xxs
> -            takeMVar mv
> -          else procFiles (cacheDir ca) xxs
> -        mapM_ removeFile . (map (darcsdir </>)) .
> -          filter (("meta-" `isPrefixOf`) . takeFileName) =<<
> -          getDirectoryContents darcsdir
> -  procTmp _ (Tar.Fail e) = fail e
> -  procFiles _ Tar.Done = return ()
> -  procFiles ca (Tar.Next x xs) = withTarFile x $ \p c -> do
> -    ex <- doesFileExist p
> -    if ex
> -      then debugMessage $ "Tar thread: STOP " ++ p
> -      else do
> -        writeFile' ca p $ compress c
> -        debugMessage $ "Tar thread: GET " ++ p
> -        procFiles ca xs
> -  procFiles _ (Tar.Fail e) = fail e
> -  withTarFile x f = case Tar.entryContent x of
> -    Tar.NormalFile x' _ -> f (Tar.entryPath x) x'
> -    _ -> fail "Unexpected non-file tar entry"
> +          then debugMessage $ "Tar thread: STOP " ++ p
> +          else do
> +            if p == darcsdir </> "hashed_inventory"
> +              then writeFile' Nothing p x'
> +              else writeFile' (cacheDir c) p $ compress x'
> +            debugMessage $ "Tar thread: GET " ++ p
> +            unpackTar stopCond c mh xs
> +  _ -> fail "Unexpected non-file tar entry"
> + where
>    writeFile' Nothing z y = withTemp $ \x' -> do
>      BL.writeFile x' y
>      renameFile x' z
> hunk ./src/Darcs/Repository.hs 399
>    createLink' z y = do
>      createDirectoryIfMissing True $ takeDirectory y
>      createLink z y `catchall` return ()
> -  fetchFiles _ _ [] = return ()
> -  fetchFiles c d (f:fs) = do
> -    ex <- doesFileExist $ darcsdir </> hashedDir d </> f
> -    if ex
> -      then debugMessage $ "Cache thread: STOP " ++
> -        (darcsdir </> hashedDir d </> f)
> -      else do
> -        debugMessage $ "Cache thread: GET " ++
> -          (darcsdir </> hashedDir d </> f)
> -        fetchFileUsingCache c d f
> -        fetchFiles c d fs
> -  hashedPatchFileName x = case extractHash x of
> -    Left _ -> fail "unexpected unhashed patch"
> -    Right h -> h
> -  cacheDir (Ca cs) = let
> -    cs' = catMaybes . flip map cs $ \x -> case x of
> -      Cache Directory Writable x' -> Just x'
> -      _ -> Nothing
> -   in
> -    if not (null cs') then Just (head cs') else Nothing
> -  cleanDir d = mapM_ (\x -> removeFile $ darcsdir </> d </> x) .
> -    filter (\x -> head x /= '.') =<< getDirectoryContents (darcsdir </> d)
> +
> +basicMetaHandler :: Bool -> Cache -> MVar () -> IO ()
> +basicMetaHandler isLazy ca mv = do
> +  ex <- and <$> mapM doesFileExist
> +    [ darcsdir </> "meta-filelist-pristine"
> +    , darcsdir </> "meta-filelist-inventories"
> +    ]
> +  when ex . forkWithControlMVar mv $ do
> +    unless isLazy $ fetchFilesUsingCache ca HashedInventoriesDir . lines =<<
> +      readFile (darcsdir </> "meta-filelist-inventories")
> +    fetchFilesUsingCache ca HashedPristineDir . lines =<<
> +      readFile (darcsdir </> "meta-filelist-pristine")
> +  return ()
> +

> +cacheDir :: Cache -> Maybe String
> +cacheDir (Ca cs) = safeHead . catMaybes .flip map cs $ \x -> case x of
> +  Cache Directory Writable x' -> Just x'
> +  _ -> Nothing
> +
> +safeHead :: [a] -> Maybe a
> +safeHead [] = Nothing
> +safeHead (x:_) = Just x
Another two candidates for lifting out of the module.

> +hashedPatchFileName :: PatchInfoAnd p C(a b) -> String
> +hashedPatchFileName x = case extractHash x of
> +  Left _ -> fail "unexpected unhashed patch"
> +  Right h -> h
And maybe another, although I'm not sure where it would go...

> hunk ./src/Darcs/Repository.hs 427
> + -- | fetchFilesUsingCache is similar to mapM fetchFileUsingCache, exepts
> + -- it stops execution if file it's going to fetch already exists.
> +fetchFilesUsingCache :: Cache -> HashedDir -> [FilePath] -> IO ()
> +fetchFilesUsingCache _ _ [] = return ()
> +fetchFilesUsingCache c d (f:fs) = do
> +  ex <- doesFileExist $ darcsdir </> hashedDir d </> f
> +  if ex
> +    then debugMessage $ "Cache thread: STOP " ++
> +      (darcsdir </> hashedDir d </> f)
> +    else do
> +      debugMessage $ "Cache thread: GET " ++
> +        (darcsdir </> hashedDir d </> f)
> +      fetchFileUsingCache c d f
> +      fetchFilesUsingCache c d fs

OK.

Make gzipped inventories parse correctly in readInventoryPrivate
----------------------------------------------------------------

> hunk ./src/Darcs/Repository/HashedRepo.hs 74
>  import Printer ( Doc, hcat, (<>), ($$), renderString, renderPS, text, invisiblePS )
>  import Darcs.ColorPrinter () -- for instance Show Doc
>  import Crypt.SHA256 ( sha256sum )
> -import Darcs.External ( copyFileOrUrl, cloneFile, fetchFilePS, Cachable( Uncachable ) )
> +import Darcs.External ( copyFileOrUrl, cloneFile, fetchFilePS, gzFetchFilePS,
> +    Cachable( Uncachable ) )
>  import Darcs.Lock ( writeBinFile, writeDocBinFile, writeAtomicFilePS, appendBinFile, appendDocBinFile )
>  import Darcs.Utils ( withCurrentDirectory )
>  import Progress ( beginTedious, endTedious, debugMessage, finishedOneIO )
> hunk ./src/Darcs/Repository/HashedRepo.hs 383
>  
>  readInventoryPrivate :: Cache -> String -> String -> IO (Maybe String, [(PatchInfo, String)])
>  readInventoryPrivate _ d iname = do
> -    i <- skipPristine `fmap` fetchFilePS (d </> iname) Uncachable
> +    i <- skipPristine `fmap` gzFetchFilePS (d </> iname) Uncachable
>      (rest,str) <- case BC.break ((==)'\n') i of
>                    (swt,pistr) | swt == BC.pack "Starting with inventory:" ->
>                      case BC.break ((==)'\n') $ B.tail pistr of

Ack.

Moved inventories to patches tarball
------------------------------------

> hunk ./src/Darcs/Commands/Optimize.lhs 385
>      "Unsupported repository format:\n" ++
>      "  only hashed repositories can be optimized for HTTP"
>    createDirectoryIfMissing False packsDir
> +  -- pack patchesTar
>    ps <- mapRL hashedPatchFileName . newset2RL <$> readRepo repo
> hunk ./src/Darcs/Commands/Optimize.lhs 387
> -  BL.writeFile (patchesTar <.> "part") . compress . write =<<
> -    mapM fileEntry' ps
> -  renameFile (patchesTar <.> "part") patchesTar
>    is <- map ((darcsdir </> "inventories") </>) <$> HashedRepo.listInventories
>    writeFile (darcsdir </> "meta-filelist-inventories") . unlines $
>      map takeFileName is
> hunk ./src/Darcs/Commands/Optimize.lhs 390
> +  BL.writeFile (patchesTar <.> "part") . compress . write =<<
> +    mapM fileEntry' ((darcsdir </> "meta-filelist-inventories") : ps ++
> +    reverse is)
> +  renameFile (patchesTar <.> "part") patchesTar
> +  -- pack basicTar
>    pr <- sortByMTime =<< dirContents "pristine.hashed"
>    writeFile (darcsdir </> "meta-filelist-pristine") . unlines $
>      map takeFileName pr
> hunk ./src/Darcs/Commands/Optimize.lhs 399
>    BL.writeFile (basicTar <.> "part") . compress . write =<< mapM fileEntry' (
> -    [ darcsdir </> "hashed_inventory"
> -    , darcsdir </> "meta-filelist-pristine"
> -    , darcsdir </> "meta-filelist-inventories"
> -    ] ++ reverse pr ++ reverse is)
> +    [ darcsdir </> "meta-filelist-pristine"
> +    , darcsdir </> "hashed_inventory"
> +    ] ++ reverse pr)
>    renameFile (basicTar <.> "part") basicTar
>   where
>    packsDir = darcsdir </> "packs"
> hunk ./src/Darcs/Repository.hs 307
>    let isLazy = any (`elem` opts) [Partial, Lazy, Ephemeral]
>    cleanDir "pristine.hashed"
>    removeFile $ darcsdir </> "hashed_inventory"
> -  unpackBasic isLazy toCache3 . Tar.read $ decompress b
> +  unpackBasic toCache3 . Tar.read $ decompress b
>    createPristineDirectoryTree toRepo "."
>    -- pull new patches
>    us <- readRepo toRepo
> hunk ./src/Darcs/Repository.hs 348
>  removeMetaFiles = mapM_ (removeFile . (darcsdir </>)) .
>    filter ("meta-" `isPrefixOf`) =<< getDirectoryContents darcsdir
>  
> -unpackBasic :: Bool -> Cache -> Tar.Entries -> IO ()
> -unpackBasic isLazy c x = do
> -  withControlMVar $ \mv -> unpackTar (\y -> isLazy && (darcsdir </>
> -    "inventories") `isPrefixOf` y) c (basicMetaHandler isLazy c mv) x
> +unpackBasic :: Cache -> Tar.Entries -> IO ()
> +unpackBasic c x = do
> +  withControlMVar $ \mv -> unpackTar c (basicMetaHandler c mv) x
>    removeMetaFiles
>  
>  unpackPatches :: Cache -> [String] -> Tar.Entries -> IO ()
> hunk ./src/Darcs/Repository.hs 355
>  unpackPatches c ps x = do
> -  withControlMVar $ \mv -> do
> -    forkWithControlMVar mv $ fetchFilesUsingCache c HashedPatchesDir ps
> -    unpackTar (const False) c (return ()) x
> +  withControlMVar $ \mv -> unpackTar c (patchesMetaHandler c ps mv) x
>    removeMetaFiles
>  
> hunk ./src/Darcs/Repository.hs 358
> -unpackTar :: (FilePath -> Bool) -> Cache -> IO () -> Tar.Entries -> IO ()
> -unpackTar _ _ _ Tar.Done = return ()
> -unpackTar _ _ _ (Tar.Fail e)= fail e
> -unpackTar stopCond c mh (Tar.Next x xs) = case Tar.entryContent x of
> +unpackTar :: Cache -> IO () -> Tar.Entries -> IO ()
> +unpackTar  _ _ Tar.Done = return ()
> +unpackTar  _ _ (Tar.Fail e)= fail e
> +unpackTar c mh (Tar.Next x xs) = case Tar.entryContent x of
>    Tar.NormalFile x' _ -> do
>      let p = Tar.entryPath x
>      if "meta-" `isPrefixOf` takeFileName p
> hunk ./src/Darcs/Repository.hs 368
>        then do
>          BL.writeFile p x'
>          mh
> -        unpackTar stopCond c mh xs
> -      else when (not $ stopCond p) $ do
> +        unpackTar c mh xs
> +      else do
>          ex <- doesFileExist p
>          if ex
>            then debugMessage $ "Tar thread: STOP " ++ p
> hunk ./src/Darcs/Repository.hs 378
>                then writeFile' Nothing p x'
>                else writeFile' (cacheDir c) p $ compress x'
>              debugMessage $ "Tar thread: GET " ++ p
> -            unpackTar stopCond c mh xs
> +            unpackTar c mh xs
>    _ -> fail "Unexpected non-file tar entry"
>   where
>    writeFile' Nothing z y = withTemp $ \x' -> do
> hunk ./src/Darcs/Repository.hs 397
>      createDirectoryIfMissing True $ takeDirectory y
>      createLink z y `catchall` return ()
>  
> -basicMetaHandler :: Bool -> Cache -> MVar () -> IO ()
> -basicMetaHandler isLazy ca mv = do
> -  ex <- and <$> mapM doesFileExist
> -    [ darcsdir </> "meta-filelist-pristine"
> -    , darcsdir </> "meta-filelist-inventories"
> -    ]
> -  when ex . forkWithControlMVar mv $ do
> -    unless isLazy $ fetchFilesUsingCache ca HashedInventoriesDir . lines =<<
> -      readFile (darcsdir </> "meta-filelist-inventories")
> +basicMetaHandler :: Cache -> MVar () -> IO ()
> +basicMetaHandler ca mv = do
> +  ex <- doesFileExist $ darcsdir </> "meta-filelist-pristine"
> +  when ex . forkWithControlMVar mv $
>      fetchFilesUsingCache ca HashedPristineDir . lines =<<
>        readFile (darcsdir </> "meta-filelist-pristine")
>    return ()
> hunk ./src/Darcs/Repository.hs 404
> +
> +patchesMetaHandler :: Cache -> [String] -> MVar () -> IO ()
> +patchesMetaHandler ca ps mv = do
> +  ex <- doesFileExist $ darcsdir </> "meta-filelist-inventories"
> +  when ex $ do
> +    forkWithControlMVar mv $ fetchFilesUsingCache ca HashedPristineDir .
> +      lines =<< readFile (darcsdir </> "meta-filelist-inventories")
> +    forkWithControlMVar mv $ fetchFilesUsingCache ca HashedPatchesDir ps
> +  return ()
>  
>  cacheDir :: Cache -> Maybe String
>  cacheDir (Ca cs) = safeHead . catMaybes .flip map cs $ \x -> case x of

Looks OK to me.

Use custom HTTP request for fetchFileLazyPS
-------------------------------------------

> hunk ./src/Darcs/External.hs 78
>                   simplePrinters,
>                   text, empty, packedString, vcat, renderString )
>  import Darcs.Email ( formatHeader )
> +import Network.Browser ( browse, request, setErrHandler, setOutHandler
> +    , setAllowRedirects )
> +import Network.HTTP ( RequestMethod(GET), rspCode, rspBody, rspReason
> +    , mkRequest )
> +import Network.URI ( parseURI, uriScheme )
>  
>  sendmailPath :: IO String
>  sendmailPath = do
> hunk ./src/Darcs/External.hs 154
>  -- make sure to force consumption of file contents to avoid that. See
>  -- "fetchFilePS" for details.
>  fetchFileLazyPS :: String -> Cachable -> IO BL.ByteString
> -fetchFileLazyPS = copyAndReadFile BL.readFile
> +fetchFileLazyPS x c = case parseURI x of
> +  Just x' | uriScheme x' == "http:" -> do
> +    rsp <- fmap snd . browse $ do
> +      setErrHandler . const $ return ()
> +      setOutHandler . const $ return ()
> +      setAllowRedirects True
> +      request $ mkRequest GET x'
> +    if rspCode rsp /= (2, 0, 0)
> +      then fail $ "fetchFileLazyPS: " ++ rspReason rsp
> +      else return $ rspBody rsp
> +  _ -> copyAndReadFile BL.readFile x c

Looks OK. Hooray for real laziness here (should make get with --packs
behave a lot better).

Add flag for using repository packs
-----------------------------------

Would it be better to have --use-packs instead of just --packs? Sounds a
bit clearer to me, although I am not quite sure. Eric?

> hunk ./src/Darcs/Arguments.lhs 88
>                           networkOptions, noCache,
>                           allowUnrelatedRepos,
>                           checkOrRepair, justThisRepo, optimizePristine,
> -                         optimizeHTTP, getOutput, makeScriptsExecutable
> +                         optimizeHTTP, getOutput, makeScriptsExecutable,
> +                         usePacks
>                        ) where
>  import System.Console.GetOpt
>  import System.Directory ( doesDirectoryExist )
> hunk ./src/Darcs/Arguments.lhs 311
>  getContent StoreInMemory = NoContent
>  getContent ApplyOnDisk = NoContent
>  getContent NoHTTPPipelining = NoContent
> +getContent Packs = NoContent
> +getContent NoPacks = NoContent
>  getContent NoCache = NoContent
>  getContent NullFlag = NoContent
>  getContent (PrehookCmd s) = StringContent s
> hunk ./src/Darcs/Arguments.lhs 1718
>  optimizeHTTP = DarcsSingleOption $
>    DarcsNoArgOption [] ["http"] OptimizeHTTP
>                            "optimize repository for getting over network"
> +
> +usePacks :: DarcsOption
> +usePacks = DarcsMultipleChoiceOption
> +  [ DarcsNoArgOption [] ["packs"] Packs "use repository packs"
> +  , DarcsNoArgOption [] ["no-packs"] NoPacks
> +      "don't use repository packs [DEFAULT]"
> +  ]
>  \end{code}
>  \begin{options}
>  --umask
> hunk ./src/Darcs/Commands/Get.lhs 38
>                          getContext, getInventoryChoices,
>                          partial, reponame,
>                          matchOneContext, setDefault, setScriptsExecutableOption,
> -                        networkOptions, makeScriptsExecutable )
> +                        networkOptions, makeScriptsExecutable, usePacks )
>  import Darcs.Repository ( Repository, withRepository, ($-), withRepoLock, identifyRepositoryFor, readRepo,
>                            createPristineDirectoryTree,
>                            tentativelyRemovePatches, patchSetToRepository,
> hunk ./src/Darcs/Commands/Get.lhs 130
>                      commandPrereq = contextExists,
>                      commandGetArgPossibilities = return [],
>                      commandArgdefaults = nodefaults,
> -                    commandAdvancedOptions = networkOptions ++
> +                    commandAdvancedOptions = networkOptions ++ usePacks :
>                                                 commandAdvancedOptions initialize,
>                      commandBasicOptions = [reponame,
>                                              partial,
> hunk ./src/Darcs/Flags.hs 104
>                 | UMask String
>                 | StoreInMemory | ApplyOnDisk
>                 | NoHTTPPipelining
> +               | Packs | NoPacks
>                 | NoCache
>                 | AllowUnrelatedRepos
>                 | Check | Repair | JustThisRepo
> hunk ./src/Darcs/Repository.hs 128
>  import Darcs.Witnesses.Sealed ( Sealed(..), FlippedSeal(..), flipSeal, mapFlipped )
>  
>  import Darcs.Flags ( DarcsFlag( Quiet, Partial, Lazy, Ephemeral, Complete,
> -                                AllowUnrelatedRepos, NoUpdateWorking )
> +                                AllowUnrelatedRepos, NoUpdateWorking,
> +                                Packs, NoPacks )
>                     , compression, UseIndex(..), ScanKnown(..), remoteDarcs )
>  import Darcs.Global ( darcsdir )
>  import Darcs.URL ( isFile )
> hunk ./src/Darcs/Repository.hs 255
>    debugMessage "Copying prefs"
>    copyFileOrUrl (remoteDarcs opts) (fromDir ++ "/" ++ darcsdir ++ "/prefs/prefs")
>      (darcsdir ++ "/prefs/prefs") (MaxAge 600) `catchall` return ()
> -  if isFile fromDir
> +  if isFile fromDir && Packs `elem` opts && NoPacks `notElem` opts

This *might* be a bit overshooting it. We nub the options, so that only
one of Packs or NoPacks might end up there, so only checking for Packs
should (in theory) work. I haven't checked though. This is probably
safe, if a bit bulky.

>      then copyNotPackedRepository fromRepo
>      else do
>        b <- (Just <$> fetchFileLazyPS (fromDir ++ "/" ++ darcsdir ++
> hunk ./tests/get-http-packed.sh 27
>  cd ..
>  
>  serve_http # sets baseurl
> -darcs get $baseurl/R S
> +darcs get --packs $baseurl/R S
>  cd S
>  rm _darcs/prefs/sources # avoid any further contact with the original repository
>  darcs check

OK.

Yours,
   Petr.

This patch bundle (with 8 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-5db73b4eae2bf86c1369b5bf6159de38623b15e4

> Add flag for using repository packs
> -----------------------------------
> 
> Would it be better to have --use-packs instead of just --packs? Sounds a
> bit clearer to me, although I am not quite sure. Eric?

I'm guessing not for consistency.  If we were to do that, we'd also want
to change --cache to --use-cache, --ssh-cm to --use-ssh-cm

Anyway, something to think about when the command line stuff gets
overhauled.

-- 
Eric Kow <http://www.nltg.brighton.ac.uk/home/Eric.Kow>
For a faster response, try +44 (0)1273 64 2905 or
xmpp:kowey@jabber.fr (Jabber or Google Talk only)

This patch bundle (with 8 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-5db73b4eae2bf86c1369b5bf6159de38623b15e4