{-|
License : GPL-2

Packs are an optimization that enable faster repository cloning over HTTP.
A pack is actually a @tar.gz@ file that contains many files that would otherwise
have to be transfered one by one (which is much slower over HTTP).

Two packs are created at the same time by 'createPacks':

  1. The basic pack, contains the pristine tree.
  2. The patches pack, contains the set of patches of the repository.

The paths of these files are @_darcs\/packs\/basic.tar.gz@ and
@_darcs\/packs\/patches.tar.gz@. There is also @_darcs\/packs\/pristine@ which
indicates the pristine hash at the moment of the creation of the packs. This
last file is useful to determine whether the basic pack is in sync with the
current pristine of the repository.
-}

module Darcs.Repository.Packs
    ( fetchAndUnpackBasic
    , fetchAndUnpackPatches
    , packsDir
    , createPacks
    ) where

import qualified Codec.Archive.Tar as Tar
import Codec.Archive.Tar.Entry ( fileEntry, toTarPath )
import Codec.Compression.GZip as GZ ( compress, decompress )
import Control.Concurrent.Async ( withAsync )
import Control.Exception ( Exception, IOException, throwIO, catch, finally )
import Control.Monad ( forM_, when )
import System.IO.Error ( isAlreadyExistsError )
import System.IO.Unsafe ( unsafeInterleaveIO )

import qualified Data.ByteString.Lazy.Char8 as BLC
import Data.List ( isPrefixOf, sort )

import System.Directory ( createDirectoryIfMissing
                        , renameFile
                        , removeFile
                        , doesFileExist
                        , getModificationTime
                        , listDirectory
                        )
import System.FilePath ( (</>)
                       , (<.>)
                       , takeFileName
                       , splitPath
                       , joinPath
                       , takeDirectory
                       )
import System.Posix.Files ( createLink )

import Darcs.Prelude

import Darcs.Util.ByteString ( gzReadFilePS )
import Darcs.Util.Cache
    ( Cache
    , bucketFolder
    , closestWritableDirectory
    , fetchFileUsingCache
    )
import Darcs.Util.File ( Cachable(..), fetchFileLazyPS, withTemp )
import Darcs.Util.Global ( darcsdir )
import Darcs.Util.Progress ( debugMessage, progressList )
import Darcs.Util.ValidHash ( InventoryHash, PatchHash, encodeValidHash )

import Darcs.Patch ( RepoPatch )
import Darcs.Patch.PatchInfoAnd ( extractHash )
import Darcs.Patch.Progress ( progressFL )
import Darcs.Patch.Witnesses.Ordered ( mapFL )
import Darcs.Patch.Set ( patchSet2FL )

import Darcs.Repository.Traverse ( listInventories )
import Darcs.Repository.InternalTypes ( Repository, AccessType(RW), withRepoDir )
import Darcs.Repository.Hashed ( readPatches )
import Darcs.Repository.Paths
    ( hashedInventoryPath
    , inventoriesDirPath
    , patchesDirPath
    , pristineDirPath
    )
import Darcs.Repository.Pristine ( readHashedPristineRoot )

packsDir, basicPack, patchesPack :: String
packsDir :: String
packsDir     = String
"packs"
basicPack :: String
basicPack    = String
"basic.tar.gz"
patchesPack :: String
patchesPack  = String
"patches.tar.gz"

fetchAndUnpack :: FilePath
               -> Cache
               -> FilePath
               -> IO ()
fetchAndUnpack :: String -> Cache -> String -> IO ()
fetchAndUnpack String
filename Cache
cache String
remote = do
  Cache -> Entries FormatError -> IO ()
forall e. Exception e => Cache -> Entries e -> IO ()
unpackTar Cache
cache (Entries FormatError -> IO ())
-> (ByteString -> Entries FormatError) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Entries FormatError
Tar.read (ByteString -> Entries FormatError)
-> (ByteString -> ByteString) -> ByteString -> Entries FormatError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
GZ.decompress (ByteString -> IO ()) -> IO ByteString -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
    String -> Cachable -> IO ByteString
fetchFileLazyPS (String
remote String -> String -> String
</> String
darcsdir String -> String -> String
</> String
packsDir String -> String -> String
</> String
filename) Cachable
Uncachable

fetchAndUnpackPatches :: [InventoryHash] -> [PatchHash] -> Cache -> FilePath -> IO ()
fetchAndUnpackPatches :: [InventoryHash] -> [PatchHash] -> Cache -> String -> IO ()
fetchAndUnpackPatches [InventoryHash]
ihs [PatchHash]
phs Cache
cache String
remote =
  -- Patches pack can miss some new patches of the repository.
  -- So we download pack asynchonously and always do a complete pass
  -- of individual patch and inventory files.
  IO () -> (Async () -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (String -> Cache -> String -> IO ()
fetchAndUnpack String
patchesPack Cache
cache String
remote) ((Async () -> IO ()) -> IO ()) -> (Async () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async ()
_ -> do
    [InventoryHash]
-> (InventoryHash -> IO (String, ByteString)) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [InventoryHash]
ihs (Cache -> InventoryHash -> IO (String, ByteString)
forall h. ValidHash h => Cache -> h -> IO (String, ByteString)
fetchFileUsingCache Cache
cache)
    [PatchHash] -> (PatchHash -> IO (String, ByteString)) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [PatchHash]
phs (Cache -> PatchHash -> IO (String, ByteString)
forall h. ValidHash h => Cache -> h -> IO (String, ByteString)
fetchFileUsingCache Cache
cache)

fetchAndUnpackBasic :: Cache -> FilePath -> IO ()
fetchAndUnpackBasic :: Cache -> String -> IO ()
fetchAndUnpackBasic = String -> Cache -> String -> IO ()
fetchAndUnpack String
basicPack

unpackTar :: Exception e => Cache -> Tar.Entries e -> IO ()
unpackTar :: forall e. Exception e => Cache -> Entries e -> IO ()
unpackTar Cache
_ GenEntries TarPath LinkTarget e
Tar.Done = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
unpackTar Cache
_ (Tar.Fail e
e) = e -> IO ()
forall e a. Exception e => e -> IO a
throwIO e
e
unpackTar Cache
c (Tar.Next GenEntry TarPath LinkTarget
e GenEntries TarPath LinkTarget e
es) = case GenEntry TarPath LinkTarget -> GenEntryContent LinkTarget
forall tarPath linkTarget.
GenEntry tarPath linkTarget -> GenEntryContent linkTarget
Tar.entryContent GenEntry TarPath LinkTarget
e of
  Tar.NormalFile ByteString
bs FileSize
_ -> do
    let p :: String
p = GenEntry TarPath LinkTarget -> String
forall linkTarget. GenEntry TarPath linkTarget -> String
Tar.entryPath GenEntry TarPath LinkTarget
e
    if String
"meta-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String -> String
takeFileName String
p
      then Cache -> GenEntries TarPath LinkTarget e -> IO ()
forall e. Exception e => Cache -> Entries e -> IO ()
unpackTar Cache
c GenEntries TarPath LinkTarget e
es -- just ignore them
      else do
        Bool
ex <- String -> IO Bool
doesFileExist String
p
        if Bool
ex
          then String -> IO ()
debugMessage (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"TAR thread: exists " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\nStopping TAR thread."
          else do
            if String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
hashedInventoryPath
              then Maybe String -> String -> ByteString -> IO ()
writeFile' Maybe String
forall a. Maybe a
Nothing String
p ByteString
bs
              else Maybe String -> String -> ByteString -> IO ()
writeFile' (Cache -> Maybe String
closestWritableDirectory Cache
c) String
p (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
GZ.compress ByteString
bs
            String -> IO ()
debugMessage (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"TAR thread: GET " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p
            Cache -> GenEntries TarPath LinkTarget e -> IO ()
forall e. Exception e => Cache -> Entries e -> IO ()
unpackTar Cache
c GenEntries TarPath LinkTarget e
es
  GenEntryContent LinkTarget
_ -> String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected non-file tar entry"
 where
  writeFile' :: Maybe String -> String -> ByteString -> IO ()
writeFile' Maybe String
Nothing String
path ByteString
content = (String -> IO ()) -> IO ()
forall a. (String -> IO a) -> IO a
withTemp ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
tmp -> do
    String -> ByteString -> IO ()
BLC.writeFile String
tmp ByteString
content
    String -> String -> IO ()
renameFile String
tmp String
path
  writeFile' (Just String
ca) String
path ByteString
content = do
    let fileFullPath :: String
fileFullPath = case String -> [String]
splitPath String
path of
          String
_:String
hDir:String
hFile:[String]
_  -> [String] -> String
joinPath [String
ca, String
hDir, String -> String
bucketFolder String
hFile, String
hFile]
          [String]
_               -> String -> String
forall a. String -> [a]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected file path"
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
path
    String -> String -> IO ()
createLink String
fileFullPath String
path IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(IOException
ex :: IOException) -> do
      if IOException -> Bool
isAlreadyExistsError IOException
ex then
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- so much the better
      else
        -- ignore cache if we cannot link
        Maybe String -> String -> ByteString -> IO ()
writeFile' Maybe String
forall a. Maybe a
Nothing String
path ByteString
content)

-- | Create packs from the current recorded version of the repository.
createPacks :: RepoPatch p => Repository 'RW p wU wR -> IO ()
createPacks :: forall (p :: * -> * -> *) wU wR.
RepoPatch p =>
Repository 'RW p wU wR -> IO ()
createPacks Repository 'RW p wU wR
repo =
 Repository 'RW p wU wR -> IO () -> IO ()
forall (rt :: AccessType) (p :: * -> * -> *) wU wR a.
Repository rt p wU wR -> IO a -> IO a
withRepoDir Repository 'RW p wU wR
repo (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
  (IO () -> IO () -> IO ()) -> IO () -> IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
finally ((String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
removeFileIfExists
  [ String
darcsdir String -> String -> String
</> String
"meta-filelist-inventories"
  , String
darcsdir String -> String -> String
</> String
"meta-filelist-pristine"
  , String
basicTar String -> String -> String
<.> String
"part"
  , String
patchesTar String -> String -> String
<.> String
"part"
  ]) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  -- pristine hash
  PristineHash
hash <- Repository 'RW p wU wR -> IO PristineHash
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> IO PristineHash
readHashedPristineRoot Repository 'RW p wU wR
repo
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
False (String
darcsdir String -> String -> String
</> String
packsDir)
  String -> String -> IO ()
writeFile ( String
darcsdir String -> String -> String
</> String
packsDir String -> String -> String
</> String
"pristine" ) (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ PristineHash -> String
forall h. ValidHash h => h -> String
encodeValidHash PristineHash
hash
  -- pack patchesTar
  [String]
ps <- (forall wW wZ. PatchInfoAnd p wW wZ -> String)
-> FL (PatchInfoAnd p) Origin wR -> [String]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL PatchInfoAndG (Named p) wW wZ -> String
forall wW wZ. PatchInfoAnd p wW wZ -> String
forall {p :: * -> * -> *} {wA} {wB}.
PatchInfoAndG p wA wB -> String
hashedPatchFileName (FL (PatchInfoAnd p) Origin wR -> [String])
-> (PatchSet p Origin wR -> FL (PatchInfoAnd p) Origin wR)
-> PatchSet p Origin wR
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> FL (PatchInfoAnd p) Origin wR -> FL (PatchInfoAnd p) Origin wR
forall (a :: * -> * -> *) wX wY. String -> FL a wX wY -> FL a wX wY
progressFL String
"Packing patches" (FL (PatchInfoAnd p) Origin wR -> FL (PatchInfoAnd p) Origin wR)
-> (PatchSet p Origin wR -> FL (PatchInfoAnd p) Origin wR)
-> PatchSet p Origin wR
-> FL (PatchInfoAnd p) Origin wR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchSet p Origin wR -> FL (PatchInfoAnd p) Origin wR
forall (p :: * -> * -> *) wStart wX.
PatchSet p wStart wX -> FL (PatchInfoAnd p) wStart wX
patchSet2FL (PatchSet p Origin wR -> [String])
-> IO (PatchSet p Origin wR) -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Repository 'RW p wU wR -> IO (PatchSet p Origin wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> IO (PatchSet p Origin wR)
readPatches Repository 'RW p wU wR
repo
  [String]
is <- (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
inventoriesDirPath String -> String -> String
</>) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String]
listInventories
  String -> String -> IO ()
writeFile (String
darcsdir String -> String -> String
</> String
"meta-filelist-inventories") (String -> IO ()) -> ([String] -> String) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
    (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
takeFileName [String]
is
  -- Note: tinkering with zlib's compression parameters does not make
  -- any noticeable difference in generated archive size;
  -- switching to bzip2 would provide ~25% gain OTOH.
  String -> ByteString -> IO ()
BLC.writeFile (String
patchesTar String -> String -> String
<.> String
"part") (ByteString -> IO ())
-> ([GenEntry TarPath LinkTarget] -> ByteString)
-> [GenEntry TarPath LinkTarget]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
GZ.compress (ByteString -> ByteString)
-> ([GenEntry TarPath LinkTarget] -> ByteString)
-> [GenEntry TarPath LinkTarget]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenEntry TarPath LinkTarget] -> ByteString
Tar.write ([GenEntry TarPath LinkTarget] -> IO ())
-> IO [GenEntry TarPath LinkTarget] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
    (String -> IO (GenEntry TarPath LinkTarget))
-> [String] -> IO [GenEntry TarPath LinkTarget]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO (GenEntry TarPath LinkTarget)
forall {linkTarget}. String -> IO (GenEntry TarPath linkTarget)
fileEntry' ((String
darcsdir String -> String -> String
</> String
"meta-filelist-inventories") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
ps [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
forall a. [a] -> [a]
reverse [String]
is)
  String -> String -> IO ()
renameFile (String
patchesTar String -> String -> String
<.> String
"part") String
patchesTar
  -- pack basicTar
  [String]
pr <- [String] -> IO [String]
sortByMTime ([String] -> IO [String]) -> IO [String] -> IO [String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO [String]
dirContents String
pristineDirPath
  String -> String -> IO ()
writeFile (String
darcsdir String -> String -> String
</> String
"meta-filelist-pristine") (String -> IO ()) -> ([String] -> String) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
    (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
takeFileName [String]
pr
  String -> ByteString -> IO ()
BLC.writeFile (String
basicTar String -> String -> String
<.> String
"part") (ByteString -> IO ())
-> ([GenEntry TarPath LinkTarget] -> ByteString)
-> [GenEntry TarPath LinkTarget]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
GZ.compress (ByteString -> ByteString)
-> ([GenEntry TarPath LinkTarget] -> ByteString)
-> [GenEntry TarPath LinkTarget]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenEntry TarPath LinkTarget] -> ByteString
Tar.write ([GenEntry TarPath LinkTarget] -> IO ())
-> IO [GenEntry TarPath LinkTarget] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String -> IO (GenEntry TarPath LinkTarget))
-> [String] -> IO [GenEntry TarPath LinkTarget]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO (GenEntry TarPath LinkTarget)
forall {linkTarget}. String -> IO (GenEntry TarPath linkTarget)
fileEntry' (
    [ String
darcsdir String -> String -> String
</> String
"meta-filelist-pristine"
    -- unclean: we should not access the non-tentative version here;
    -- will work because we do not modify the tentative state
    , String
hashedInventoryPath
    ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String] -> [String]
forall a. String -> [a] -> [a]
progressList String
"Packing pristine" ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
pr))
  String -> String -> IO ()
renameFile (String
basicTar String -> String -> String
<.> String
"part") String
basicTar
 where
  basicTar :: String
basicTar = String
darcsdir String -> String -> String
</> String
packsDir String -> String -> String
</> String
basicPack
  patchesTar :: String
patchesTar = String
darcsdir String -> String -> String
</> String
packsDir String -> String -> String
</> String
patchesPack
  fileEntry' :: String -> IO (GenEntry TarPath linkTarget)
fileEntry' String
x = IO (GenEntry TarPath linkTarget)
-> IO (GenEntry TarPath linkTarget)
forall a. IO a -> IO a
unsafeInterleaveIO (IO (GenEntry TarPath linkTarget)
 -> IO (GenEntry TarPath linkTarget))
-> IO (GenEntry TarPath linkTarget)
-> IO (GenEntry TarPath linkTarget)
forall a b. (a -> b) -> a -> b
$ do
    ByteString
content <- [ByteString] -> ByteString
BLC.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
gzReadFilePS String
x
    TarPath
tp <- (String -> IO TarPath)
-> (TarPath -> IO TarPath) -> Either String TarPath -> IO TarPath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO TarPath
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail TarPath -> IO TarPath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String TarPath -> IO TarPath)
-> Either String TarPath -> IO TarPath
forall a b. (a -> b) -> a -> b
$ Bool -> String -> Either String TarPath
toTarPath Bool
False String
x
    GenEntry TarPath linkTarget -> IO (GenEntry TarPath linkTarget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenEntry TarPath linkTarget -> IO (GenEntry TarPath linkTarget))
-> GenEntry TarPath linkTarget -> IO (GenEntry TarPath linkTarget)
forall a b. (a -> b) -> a -> b
$ TarPath -> ByteString -> GenEntry TarPath linkTarget
forall tarPath linkTarget.
tarPath -> ByteString -> GenEntry tarPath linkTarget
fileEntry TarPath
tp ByteString
content
  dirContents :: String -> IO [String]
dirContents String
dir = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
dir String -> String -> String
</>) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
listDirectory String
dir
  hashedPatchFileName :: PatchInfoAndG p wA wB -> String
hashedPatchFileName PatchInfoAndG p wA wB
x = case PatchInfoAndG p wA wB -> Either (p wA wB) PatchHash
forall (p :: * -> * -> *) wA wB.
PatchInfoAndG p wA wB -> Either (p wA wB) PatchHash
extractHash PatchInfoAndG p wA wB
x of
    Left p wA wB
_ -> String -> String
forall a. String -> [a]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected unhashed patch"
    Right PatchHash
h -> String
patchesDirPath String -> String -> String
</> PatchHash -> String
forall h. ValidHash h => h -> String
encodeValidHash PatchHash
h
  sortByMTime :: [String] -> IO [String]
sortByMTime [String]
xs = ((UTCTime, String) -> String) -> [(UTCTime, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (UTCTime, String) -> String
forall a b. (a, b) -> b
snd ([(UTCTime, String)] -> [String])
-> ([(UTCTime, String)] -> [(UTCTime, String)])
-> [(UTCTime, String)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(UTCTime, String)] -> [(UTCTime, String)]
forall a. Ord a => [a] -> [a]
sort ([(UTCTime, String)] -> [String])
-> IO [(UTCTime, String)] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO (UTCTime, String))
-> [String] -> IO [(UTCTime, String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\String
x -> (\UTCTime
t -> (UTCTime
t, String
x)) (UTCTime -> (UTCTime, String))
-> IO UTCTime -> IO (UTCTime, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    String -> IO UTCTime
getModificationTime String
x) [String]
xs
  removeFileIfExists :: String -> IO ()
removeFileIfExists String
x = do
    Bool
ex <- String -> IO Bool
doesFileExist String
x
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ex (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeFile String
x