{-|
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 latest recorded version of the working 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 ( void, when, unless )
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.Lock ( withTemp )
import Darcs.Util.External ( Cachable(..), fetchFileLazyPS )
import Darcs.Util.Global ( darcsdir )
import Darcs.Util.Progress ( debugMessage, progressList )

import Darcs.Patch ( IsRepoType, 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 )
import Darcs.Repository.Hashed ( readRepo )
import Darcs.Repository.Inventory ( getValidHash )
import Darcs.Repository.Format
    ( identifyRepoFormat, formatHas, RepoProperty ( HashedInventory ) )
import Darcs.Repository.Cache ( fetchFileUsingCache
                              , HashedDir(..)
                              , Cache
                              , closestWritableDirectory
                              , hashedDir
                              , bucketFolder
                              )
import Darcs.Repository.Old ( oldRepoFailMsg )
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
               -> HashedDir
               -> Cache
               -> FilePath
               -> IO ()
fetchAndUnpack :: String -> HashedDir -> Cache -> String -> IO ()
fetchAndUnpack String
filename HashedDir
dir Cache
cache String
remote = do
  Cache -> HashedDir -> Entries FormatError -> IO ()
forall e. Exception e => Cache -> HashedDir -> Entries e -> IO ()
unpackTar Cache
cache HashedDir
dir (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 :: [String] -> Cache -> FilePath -> IO ()
fetchAndUnpackPatches :: [String] -> Cache -> String -> IO ()
fetchAndUnpackPatches [String]
paths Cache
cache String
remote =
  -- Patches pack can miss some new patches of the repository.
  -- So we download pack asynchonously and alway do a complete pass
  -- of individual patch files.
  IO () -> (Async () -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (String -> HashedDir -> Cache -> String -> IO ()
fetchAndUnpack String
patchesPack HashedDir
HashedInventoriesDir Cache
cache String
remote) ((Async () -> IO ()) -> IO ()) -> (Async () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async ()
_ -> do
  Cache -> HashedDir -> [String] -> IO ()
fetchFilesUsingCache Cache
cache HashedDir
HashedPatchesDir [String]
paths

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

unpackTar :: Exception e => Cache -> HashedDir -> Tar.Entries e -> IO ()
unpackTar :: Cache -> HashedDir -> Entries e -> IO ()
unpackTar Cache
_ HashedDir
_   Entries e
Tar.Done = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
unpackTar Cache
_ HashedDir
_   (Tar.Fail e
e) = e -> IO ()
forall e a. Exception e => e -> IO a
throwIO e
e
unpackTar Cache
c HashedDir
dir (Tar.Next Entry
e Entries e
es) = case Entry -> EntryContent
Tar.entryContent Entry
e of
  Tar.NormalFile ByteString
bs FileSize
_ -> do
    let p :: String
p = Entry -> String
Tar.entryPath Entry
e
    if String
"meta-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String -> String
takeFileName String
p
      then Cache -> HashedDir -> Entries e -> IO ()
forall e. Exception e => Cache -> HashedDir -> Entries e -> IO ()
unpackTar Cache
c HashedDir
dir Entries 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
darcsdir String -> String -> String
</> String
"hashed_inventory"
              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 -> HashedDir -> Entries e -> IO ()
forall e. Exception e => Cache -> HashedDir -> Entries e -> IO ()
unpackTar Cache
c HashedDir
dir Entries e
es
  EntryContent
_ -> String -> IO ()
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 (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 (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)

-- | Similar to @'mapM_' ('void' 'fetchFileUsingCache')@, exepts
-- it stops execution if file it's going to fetch already exists.
fetchFilesUsingCache :: Cache -> HashedDir -> [FilePath] -> IO ()
fetchFilesUsingCache :: Cache -> HashedDir -> [String] -> IO ()
fetchFilesUsingCache Cache
cache HashedDir
dir = (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
go where
  go :: String -> IO ()
go String
path = do
    Bool
ex <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
darcsdir String -> String -> String
</> HashedDir -> String
hashedDir HashedDir
dir String -> String -> String
</> String
path
    if Bool
ex
     then String -> IO ()
debugMessage (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"FILE thread: exists " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path
     else IO (String, ByteString) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (String, ByteString) -> IO ())
-> IO (String, ByteString) -> IO ()
forall a b. (a -> b) -> a -> b
$ Cache -> HashedDir -> String -> IO (String, ByteString)
fetchFileUsingCache Cache
cache HashedDir
dir String
path

-- | Create packs from the current recorded version of the repository.
createPacks :: (IsRepoType rt, RepoPatch p)
            => Repository rt p wR wU wT -> IO ()
createPacks :: Repository rt p wR wU wT -> IO ()
createPacks Repository rt p wR wU wT
repo = (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
  RepoFormat
rf <- String -> IO RepoFormat
identifyRepoFormat String
"."
  -- function is exposed in API so could be called on non-hashed repo
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
HashedInventory RepoFormat
rf) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
oldRepoFailMsg
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
False (String
darcsdir String -> String -> String
</> String
packsDir)
  -- pristine hash
  Just PristineHash
hash <- Repository rt p wR wU wT -> IO (Maybe PristineHash)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO (Maybe PristineHash)
readHashedPristineRoot Repository rt p wR wU wT
repo
  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 a. ValidHash a => a -> String
getValidHash PristineHash
hash
  -- pack patchesTar
  [String]
ps <- (forall wW wZ. PatchInfoAnd rt p wW wZ -> String)
-> FL (PatchInfoAnd rt p) Origin wR -> [String]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall wW wZ. PatchInfoAnd rt p wW wZ -> String
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> String
hashedPatchFileName (FL (PatchInfoAnd rt p) Origin wR -> [String])
-> (PatchSet rt p Origin wR -> FL (PatchInfoAnd rt p) Origin wR)
-> PatchSet rt p Origin wR
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> FL (PatchInfoAnd rt p) Origin wR
-> FL (PatchInfoAnd rt p) Origin wR
forall (a :: * -> * -> *) wX wY. String -> FL a wX wY -> FL a wX wY
progressFL String
"Packing patches" (FL (PatchInfoAnd rt p) Origin wR
 -> FL (PatchInfoAnd rt p) Origin wR)
-> (PatchSet rt p Origin wR -> FL (PatchInfoAnd rt p) Origin wR)
-> PatchSet rt p Origin wR
-> FL (PatchInfoAnd rt p) Origin wR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchSet rt p Origin wR -> FL (PatchInfoAnd rt p) Origin wR
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> FL (PatchInfoAnd rt p) wStart wX
patchSet2FL (PatchSet rt p Origin wR -> [String])
-> IO (PatchSet rt p Origin wR) -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wT
repo
  [String]
is <- (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
darcsdir String -> String -> String
</> String
"inventories") 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 ())
-> ([Entry] -> ByteString) -> [Entry] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
GZ.compress (ByteString -> ByteString)
-> ([Entry] -> ByteString) -> [Entry] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Entry] -> ByteString
Tar.write ([Entry] -> IO ()) -> IO [Entry] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
    (String -> IO Entry) -> [String] -> IO [Entry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO Entry
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
darcsdir String -> String -> String
</> String
"pristine.hashed")
  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 ())
-> ([Entry] -> ByteString) -> [Entry] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
GZ.compress (ByteString -> ByteString)
-> ([Entry] -> ByteString) -> [Entry] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Entry] -> ByteString
Tar.write ([Entry] -> IO ()) -> IO [Entry] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String -> IO Entry) -> [String] -> IO [Entry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO Entry
fileEntry' (
    [ String
darcsdir String -> String -> String
</> String
"meta-filelist-pristine"
    , String
darcsdir String -> String -> String
</> String
"hashed_inventory"
    ] [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 Entry
fileEntry' String
x = IO Entry -> IO Entry
forall a. IO a -> IO a
unsafeInterleaveIO (IO Entry -> IO Entry) -> IO Entry -> IO Entry
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 (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 (m :: * -> *) a. MonadFail m => String -> m a
fail TarPath -> IO TarPath
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
    Entry -> IO Entry
forall (m :: * -> *) a. Monad m => a -> m a
return (Entry -> IO Entry) -> Entry -> IO Entry
forall a b. (a -> b) -> a -> b
$ TarPath -> ByteString -> Entry
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 rt p wA wB -> String
hashedPatchFileName PatchInfoAndG rt p wA wB
x = case PatchInfoAndG rt p wA wB -> Either (p wA wB) String
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> Either (p wA wB) String
extractHash PatchInfoAndG rt p wA wB
x of
    Left p wA wB
_ -> String -> String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected unhashed patch"
    Right String
h -> String
darcsdir String -> String -> String
</> String
"patches" String -> String -> String
</> String
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)
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