-- Copyright (C) 2006-2007 David Roundy
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2, or (at your option)
-- any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program; if not, write to the Free Software Foundation,
-- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

module Darcs.Repository.Hashed
    ( inventoriesDir
    , inventoriesDirPath
    , pristineDir
    , pristineDirPath
    , patchesDir
    , patchesDirPath
    , hashedInventory
    , hashedInventoryPath

    , revertTentativeChanges
    , revertRepositoryChanges
    , finalizeTentativeChanges
    , cleanPristine
    , filterDirContents
    , cleanInventories
    , cleanPatches
    , copyPristine
    , copyPartialsPristine
    , applyToTentativePristine
    , applyToTentativePristineCwd
    , addToTentativeInventory
    , readRepo
    , readRepoHashed
    , readTentativeRepo
    , writeAndReadPatch
    , writeTentativeInventory
    , copyHashedInventory
    , readHashedPristineRoot
    , pokePristineHash
    , peekPristineHash
    , listInventories
    , listInventoriesLocal
    , listInventoriesRepoDir
    , listPatchesLocalBucketed
    , writePatchIfNecessary
    , diffHashLists
    , withRecorded
    , withTentative
    , tentativelyAddPatch
    , tentativelyRemovePatches
    , tentativelyRemovePatches_
    , tentativelyAddPatch_
    , tentativelyAddPatches_
    , tentativelyReplacePatches
    , finalizeRepositoryChanges
    , unrevertUrl
    , createPristineDirectoryTree
    , createPartialsPristineDirectoryTree
    , reorderInventory
    , cleanRepository
    , UpdatePristine(..)
    , repoXor
    ) where

import Prelude ()
import Darcs.Prelude

import Control.Arrow ( (&&&) )
import Control.Exception ( catch, IOException )
import Darcs.Util.Exception ( catchall )
import Control.Monad ( when, unless, void )
import Data.Maybe
import Data.List( foldl' )

import qualified Data.ByteString as B ( empty, readFile, append )
import qualified Data.ByteString.Char8 as BC ( unpack, pack )
import qualified Data.Set as Set

import Darcs.Util.Hash( encodeBase16, Hash(..), SHA1, sha1Xor, sha1zero )
import Darcs.Util.Prompt ( promptYorn )
import Darcs.Util.Tree( treeHash, Tree )
import Darcs.Util.Tree.Hashed( hashedTreeIO, readDarcsHashedNosize,
                             readDarcsHashed, writeDarcsHashed,
                             decodeDarcsHash, decodeDarcsSize )
import Darcs.Util.SignalHandler ( withSignalsBlocked )

import System.Directory ( createDirectoryIfMissing, getDirectoryContents
                        , doesFileExist, doesDirectoryExist )
import System.FilePath.Posix( (</>) )
import System.IO.Unsafe ( unsafeInterleaveIO )
import System.IO ( stderr, hPutStrLn )

import Darcs.Util.External
    ( copyFileOrUrl
    , cloneFile
    , fetchFilePS
    , gzFetchFilePS
    , Cachable( Uncachable )
    )
import Darcs.Repository.Flags ( Compression, RemoteDarcs, remoteDarcs
    , Verbosity(..), UpdateWorking (..), WithWorkingDir (WithWorkingDir) )

import Darcs.Repository.Format ( RepoProperty( HashedInventory ), formatHas )
import Darcs.Repository.Pending
    ( readPending
    , pendingName
    , tentativelyRemoveFromPending
    , finalizePending
    , setTentativePending
    , prepend
    )
import Darcs.Repository.PatchIndex ( createOrUpdatePatchIndexDisk, doesPatchIndexExist )
import Darcs.Repository.State ( readRecorded, updateIndex )

import Darcs.Util.Global ( darcsdir )
import Darcs.Util.Lock
    ( writeBinFile
    , writeDocBinFile
    , writeAtomicFilePS
    , appendDocBinFile
    , removeFileMayNotExist
    )
import Darcs.Patch.Set ( PatchSet(..), Tagged(..)
                       , SealedPatchSet, Origin
                       , patchSet2RL
                       )

import Darcs.Patch.Show ( ShowPatch, ShowPatchFor(..) )
import Darcs.Patch.PatchInfoAnd
    ( PatchInfoAnd, Hopefully, patchInfoAndPatch, info
    , extractHash, createHashed, hopefully )
import Darcs.Patch ( IsRepoType, RepoPatch, showPatch, apply
                   , description
                   , commuteRL
                   , readPatch
                   , effect
                   , invert
                   )

import Darcs.Patch.Apply ( Apply, ApplyState )

import Darcs.Patch.Bundle ( scanBundle
                          , makeBundleN
                          )
import Darcs.Patch.Named.Wrapped ( namedIsInternal )
import Darcs.Patch.Read ( ReadPatch )
import Darcs.Patch.Depends ( removeFromPatchSet, slightlyOptimizePatchset
                           , mergeThem, splitOnTag )
import Darcs.Patch.Info
    ( PatchInfo, displayPatchInfo, isTag, makePatchname )
import Darcs.Util.Path ( FilePathLike, ioAbsoluteOrRemote, toPath
                       , AbsolutePath, toFilePath )
import Darcs.Repository.Cache ( Cache(..), fetchFileUsingCache,
                                speculateFilesUsingCache, writeFileUsingCache,
                                HashedDir(..), hashedDir, peekInCache, bucketFolder )
import Darcs.Repository.HashedIO ( copyHashed, copyPartialsHashed,
                                   cleanHashdir )
import Darcs.Repository.Inventory
import Darcs.Repository.InternalTypes
    ( Repository
    , repoCache
    , repoFormat
    , repoLocation
    , withRepoLocation
    , coerceT )
import qualified Darcs.Repository.Old as Old ( readOldRepo, oldRepoFailMsg )
import Darcs.Util.File ( withCurrentDirectory )
import Darcs.Patch.Witnesses.Ordered
    ( (+<+), FL(..), RL(..), mapRL, foldFL_M
    , (:>)(..), lengthFL, filterOutFLFL
    , reverseFL, reverseRL )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), seal, unseal, mapSeal )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )

import Darcs.Util.ByteString ( gzReadFilePS )
import Darcs.Util.Printer.Color ( showDoc )
import Darcs.Util.Printer
    ( Doc, hcat, ($$), renderString, renderPS, text, putDocLn, (<+>) )
import Darcs.Util.Progress ( beginTedious, endTedious, debugMessage, finishedOneIO )
import Darcs.Patch.Progress (progressFL)
import Darcs.Util.Workaround ( renameFile )
import Darcs.Repository.Prefs ( globalCacheDir )


makeDarcsdirPath :: String -> String
makeDarcsdirPath :: String -> String
makeDarcsdirPath name :: String
name = String
darcsdir String -> String -> String
</> String
name

-- TODO rename xyzPath to xyzLocal to make it clear that it is
-- relative to the local darcsdir

-- Location of the (one and only) head inventory.
hashedInventory, hashedInventoryPath :: String
hashedInventory :: String
hashedInventory = "hashed_inventory"
hashedInventoryPath :: String
hashedInventoryPath = String -> String
makeDarcsdirPath String
hashedInventory

-- Location of the (one and only) tentative head inventory.
tentativeHashedInventory, tentativeHashedInventoryPath :: String
tentativeHashedInventory :: String
tentativeHashedInventory = "tentative_hashed_inventory"
tentativeHashedInventoryPath :: String
tentativeHashedInventoryPath = String -> String
makeDarcsdirPath String
tentativeHashedInventory

-- Location of parent inventories.
inventoriesDir, inventoriesDirPath :: String
inventoriesDir :: String
inventoriesDir = "inventories"
inventoriesDirPath :: String
inventoriesDirPath = String -> String
makeDarcsdirPath String
inventoriesDir

-- Location of pristine trees.
pristineDir, tentativePristinePath, pristineDirPath :: String
tentativePristinePath :: String
tentativePristinePath = String -> String
makeDarcsdirPath "tentative_pristine"
pristineDir :: String
pristineDir = "pristine.hashed"
pristineDirPath :: String
pristineDirPath = String -> String
makeDarcsdirPath String
pristineDir

-- Location of patches.
patchesDir, patchesDirPath :: String
patchesDir :: String
patchesDir = "patches"
patchesDirPath :: String
patchesDirPath = String -> String
makeDarcsdirPath String
patchesDir

-- | The way patchfiles, inventories, and pristine trees are stored.
-- 'PlainLayout' means all files are in the same directory. 'BucketedLayout'
-- means we create a second level of subdirectories, such that all files whose
-- hash starts with the same two letters are in the same directory.
data DirLayout = PlainLayout | BucketedLayout

-- | 'applyToHashedPristine' takes a root hash, a patch @p@ and attempts to
-- apply the patch to the 'Tree' identified by @h@. If we encounter an old,
-- size-prefixed pristine, we first convert it to the non-size-prefixed format,
-- then apply the patch.
applyToHashedPristine :: (Apply p, ApplyState p ~ Tree) => String -> p wX wY
                      -> IO String
applyToHashedPristine :: String -> p wX wY -> IO String
applyToHashedPristine h :: String
h p :: p wX wY
p = IO String
applyOrConvertOldPristineAndApply
  where
    applyOrConvertOldPristineAndApply :: IO String
applyOrConvertOldPristineAndApply =
        Hash -> IO String
tryApply Hash
hash IO String -> (IOException -> IO String) -> IO String
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOException
_ :: IOException) -> IO String
handleOldPristineAndApply

    hash :: Hash
hash = ByteString -> Hash
decodeDarcsHash (ByteString -> Hash) -> ByteString -> Hash
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BC.pack String
h

    failOnMalformedRoot :: Hash -> m ()
failOnMalformedRoot (SHA256 _) = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    failOnMalformedRoot root :: Hash
root = String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "Cannot handle hash: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Hash -> String
forall a. Show a => a -> String
show Hash
root

    hash2root :: Hash -> String
hash2root = ByteString -> String
BC.unpack (ByteString -> String) -> (Hash -> ByteString) -> Hash -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> ByteString
encodeBase16

    tryApply :: Hash -> IO String
    tryApply :: Hash -> IO String
tryApply root :: Hash
root = do
        Hash -> IO ()
forall (m :: * -> *). MonadFail m => Hash -> m ()
failOnMalformedRoot Hash
root
        -- Read a non-size-prefixed pristine, failing if we encounter one.
        Tree IO
tree <- String -> Hash -> IO (Tree IO)
readDarcsHashedNosize String
pristineDirPath Hash
root
        (_, updatedTree :: Tree IO
updatedTree) <- TreeIO () -> Tree IO -> String -> IO ((), Tree IO)
forall a. TreeIO a -> Tree IO -> String -> IO (a, Tree IO)
hashedTreeIO (p wX wY -> TreeIO ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply p wX wY
p) Tree IO
tree String
pristineDirPath
        String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> (Hash -> String) -> Hash -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> String
hash2root (Hash -> IO String) -> Hash -> IO String
forall a b. (a -> b) -> a -> b
$ Tree IO -> Hash
forall (m :: * -> *). Tree m -> Hash
treeHash Tree IO
updatedTree

    warn :: String
warn = "WARNING: Doing a one-time conversion of pristine format.\n"
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ "This may take a while. The new format is backwards-compatible."

    handleOldPristineAndApply :: IO String
handleOldPristineAndApply = do
        Handle -> String -> IO ()
hPutStrLn Handle
stderr String
warn
        ByteString
inv <- String -> IO ByteString
gzReadFilePS String
hashedInventoryPath
        let oldroot :: ByteString
oldroot = String -> ByteString
BC.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> String
peekPristineHash ByteString
inv
            oldrootSizeandHash :: (Maybe Int, Hash)
oldrootSizeandHash = (ByteString -> Maybe Int
decodeDarcsSize (ByteString -> Maybe Int)
-> (ByteString -> Hash) -> ByteString -> (Maybe Int, Hash)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ByteString -> Hash
decodeDarcsHash) ByteString
oldroot
        -- Read the old size-prefixed pristine tree
        Tree IO
old <- String -> (Maybe Int, Hash) -> IO (Tree IO)
readDarcsHashed String
pristineDirPath (Maybe Int, Hash)
oldrootSizeandHash
        -- Write out the pristine tree as a non-size-prefixed pristine.
        Hash
root <- Tree IO -> String -> IO Hash
writeDarcsHashed Tree IO
old String
pristineDirPath
        let newroot :: String
newroot = Hash -> String
hash2root Hash
root
        -- Write out the new inventory.
        String -> Doc -> IO ()
forall p. FilePathLike p => p -> Doc -> IO ()
writeDocBinFile String
hashedInventoryPath (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> Doc
pokePristineHash String
newroot ByteString
inv
        Cache -> HashedDir -> [String] -> IO ()
cleanHashdir ([CacheLoc] -> Cache
Ca []) HashedDir
HashedPristineDir [String
newroot]
        Handle -> String -> IO ()
hPutStrLn Handle
stderr "Pristine conversion done..."
        -- Retry applying the patch, which should now succeed.
        Hash -> IO String
tryApply Hash
root

-- |revertTentativeChanges swaps the tentative and "real" hashed inventory
-- files, and then updates the tentative pristine with the "real" inventory
-- hash.
revertTentativeChanges :: IO ()
revertTentativeChanges :: IO ()
revertTentativeChanges = do
    String -> String -> IO ()
cloneFile String
hashedInventoryPath String
tentativeHashedInventoryPath
    ByteString
i <- String -> IO ByteString
gzReadFilePS String
hashedInventoryPath
    String -> ByteString -> IO ()
forall p. FilePathLike p => p -> ByteString -> IO ()
writeBinFile String
tentativePristinePath (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
B.append ByteString
pristineName (String -> ByteString
BC.pack (ByteString -> String
peekPristineHash ByteString
i))

-- |finalizeTentativeChanges trys to atomically swap the tentative
-- inventory/pristine pointers with the "real" pointers; it first re-reads the
-- inventory to optimize it, presumably to take account of any new tags, and
-- then writes out the new tentative inventory, and finally does the atomic
-- swap. In general, we can't clean the pristine cache at the same time, since
-- a simultaneous get might be in progress.
finalizeTentativeChanges :: (IsRepoType rt, RepoPatch p)
                         => Repository rt p wR wU wT -> Compression -> IO ()
finalizeTentativeChanges :: Repository rt p wR wU wT -> Compression -> IO ()
finalizeTentativeChanges r :: Repository rt p wR wU wT
r compr :: Compression
compr = do
    String -> IO ()
debugMessage "Optimizing the inventory..."
    -- Read the tentative patches
    PatchSet rt p Origin wT
ps <- Repository rt p wR wU wT -> String -> IO (PatchSet rt p Origin wT)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> String -> IO (PatchSet rt p Origin wT)
readTentativeRepo Repository rt p wR wU wT
r "."
    Cache -> Compression -> PatchSet rt p Origin wT -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
Cache -> Compression -> PatchSet rt p Origin wX -> IO ()
writeTentativeInventory (Repository rt p wR wU wT -> Cache
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p wR wU wT
r) Compression
compr PatchSet rt p Origin wT
ps
    ByteString
i <- String -> IO ByteString
gzReadFilePS String
tentativeHashedInventoryPath
    ByteString
p <- String -> IO ByteString
gzReadFilePS String
tentativePristinePath
    -- Write out the "optimised" tentative inventory.
    String -> Doc -> IO ()
forall p. FilePathLike p => p -> Doc -> IO ()
writeDocBinFile String
tentativeHashedInventoryPath (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> Doc
pokePristineHash (ByteString -> String
peekPristineHash ByteString
p) ByteString
i
    -- Atomically swap.
    String -> String -> IO ()
renameFile String
tentativeHashedInventoryPath String
hashedInventoryPath

-- |readHashedPristineRoot attempts to read the pristine hash from the current
-- inventory, returning Nothing if it cannot do so.
readHashedPristineRoot :: Repository rt p wR wU wT -> IO (Maybe String)
readHashedPristineRoot :: Repository rt p wR wU wT -> IO (Maybe String)
readHashedPristineRoot r :: Repository rt p wR wU wT
r = Repository rt p wR wU wT -> IO (Maybe String) -> IO (Maybe String)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT a.
Repository rt p wR wU wT -> IO a -> IO a
withRepoLocation Repository rt p wR wU wT
r (IO (Maybe String) -> IO (Maybe String))
-> IO (Maybe String) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ do
    Maybe ByteString
i <- (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
gzReadFilePS String
hashedInventoryPath)
         IO (Maybe ByteString)
-> (IOException -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(IOException
_ :: IOException) -> Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing)
    Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ ByteString -> String
peekPristineHash (ByteString -> String) -> Maybe ByteString -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
i

-- |cleanPristine removes any obsolete (unreferenced) entries in the pristine
-- cache.
cleanPristine :: Repository rt p wR wU wT -> IO ()
cleanPristine :: Repository rt p wR wU wT -> IO ()
cleanPristine r :: Repository rt p wR wU wT
r = Repository rt p wR wU wT -> IO () -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT a.
Repository rt p wR wU wT -> IO a -> IO a
withRepoLocation Repository rt p wR wU wT
r (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    String -> IO ()
debugMessage "Cleaning out the pristine cache..."
    ByteString
i <- String -> IO ByteString
gzReadFilePS String
hashedInventoryPath
    Cache -> HashedDir -> [String] -> IO ()
cleanHashdir (Repository rt p wR wU wT -> Cache
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p wR wU wT
r) HashedDir
HashedPristineDir [ByteString -> String
peekPristineHash ByteString
i]

-- |filterDirContents returns the contents of the directory @d@
-- except files whose names begin with '.' (directories . and ..,
-- hidden files) and files whose names are filtered by the function @f@, if
-- @dir@ is empty, no paths are returned.
filterDirContents :: FilePath -> (FilePath -> Bool) -> IO [FilePath]
filterDirContents :: String -> (String -> Bool) -> IO [String]
filterDirContents d :: String
d f :: String -> Bool
f = do
    let realPath :: String
realPath = String -> String
makeDarcsdirPath String
d
    Bool
exists <- String -> IO Bool
doesDirectoryExist String
realPath
    if Bool
exists
        then (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\x :: String
x -> String -> Char
forall a. [a] -> a
head String
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '.' Bool -> Bool -> Bool
&& String -> Bool
f String
x) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            String -> IO [String]
getDirectoryContents String
realPath
        else [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | Set difference between two lists of hashes.
diffHashLists :: [String] -> [String] -> [String]
diffHashLists :: [String] -> [String] -> [String]
diffHashLists xs :: [String]
xs ys :: [String]
ys = Set ByteString -> [String]
from_set (Set ByteString -> [String]) -> Set ByteString -> [String]
forall a b. (a -> b) -> a -> b
$ ([String] -> Set ByteString
to_set [String]
xs) Set ByteString -> Set ByteString -> Set ByteString
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` ([String] -> Set ByteString
to_set [String]
ys)
  where
    to_set :: [String] -> Set ByteString
to_set = [ByteString] -> Set ByteString
forall a. Ord a => [a] -> Set a
Set.fromList ([ByteString] -> Set ByteString)
-> ([String] -> [ByteString]) -> [String] -> Set ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ByteString) -> [String] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map String -> ByteString
BC.pack
    from_set :: Set ByteString -> [String]
from_set = (ByteString -> String) -> [ByteString] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> String
BC.unpack ([ByteString] -> [String])
-> (Set ByteString -> [ByteString]) -> Set ByteString -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ByteString -> [ByteString]
forall a. Set a -> [a]
Set.toList

-- |cleanInventories removes any obsolete (unreferenced) files in the
-- inventories directory.
cleanInventories :: Repository rt p wR wU wT -> IO ()
cleanInventories :: Repository rt p wR wU wT -> IO ()
cleanInventories _ = do
    String -> IO ()
debugMessage "Cleaning out inventories..."
    [String]
hs <- IO [String]
listInventoriesLocal
    [String]
fs <- String -> (String -> Bool) -> IO [String]
filterDirContents String
inventoriesDir (Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
True)
    (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
forall p. FilePathLike p => p -> IO ()
removeFileMayNotExist (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
inventoriesDirPath String -> String -> String
</>))
        ([String] -> [String] -> [String]
diffHashLists [String]
fs [String]
hs)

-- FIXME this is ugly, these files should be directly under _darcs
-- since they are not hashed. And 'unrevert' isn't even a real patch but
-- a patch bundle.
-- |specialPatches list of special patch files that may exist in the directory
-- _darcs/patches/.
specialPatches :: [FilePath]
specialPatches :: [String]
specialPatches = ["unrevert", "pending", "pending.tentative"]

-- |cleanPatches removes any obsolete (unreferenced) files in the
-- patches directory.
cleanPatches :: Repository rt p wR wU wT -> IO ()
cleanPatches :: Repository rt p wR wU wT -> IO ()
cleanPatches _ = do
    String -> IO ()
debugMessage "Cleaning out patches..."
    [String]
hs <- DirLayout -> String -> String -> IO [String]
listPatchesLocal DirLayout
PlainLayout String
darcsdir String
darcsdir
    [String]
fs <- String -> (String -> Bool) -> IO [String]
filterDirContents String
patchesDir (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
specialPatches)
    (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
forall p. FilePathLike p => p -> IO ()
removeFileMayNotExist (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
patchesDirPath String -> String -> String
</>))
        ([String] -> [String] -> [String]
diffHashLists [String]
fs [String]
hs)


-- |addToSpecificInventory adds a patch to a specific inventory file, and
-- returns the FilePath whichs corresponds to the written-out patch.
addToSpecificInventory :: RepoPatch p => String -> Cache -> Compression
                       -> PatchInfoAnd rt p wX wY -> IO FilePath
addToSpecificInventory :: String
-> Cache -> Compression -> PatchInfoAnd rt p wX wY -> IO String
addToSpecificInventory invPath :: String
invPath c :: Cache
c compr :: Compression
compr p :: PatchInfoAnd rt p wX wY
p = do
    let invFile :: String
invFile = String -> String
makeDarcsdirPath String
invPath
    PatchHash
hash <- (PatchInfo, PatchHash) -> PatchHash
forall a b. (a, b) -> b
snd ((PatchInfo, PatchHash) -> PatchHash)
-> IO (PatchInfo, PatchHash) -> IO PatchHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cache
-> Compression
-> PatchInfoAnd rt p wX wY
-> IO (PatchInfo, PatchHash)
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
Cache
-> Compression
-> PatchInfoAnd rt p wX wY
-> IO (PatchInfo, PatchHash)
writePatchIfNecessary Cache
c Compression
compr PatchInfoAnd rt p wX wY
p
    String -> Doc -> IO ()
forall p. FilePathLike p => p -> Doc -> IO ()
appendDocBinFile String
invFile (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
      (PatchInfo, PatchHash) -> Doc
showInventoryEntry (PatchInfoAnd rt p wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wX wY
p, PatchHash
hash)
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
patchesDirPath String -> String -> String
</> PatchHash -> String
forall a. ValidHash a => a -> String
getValidHash PatchHash
hash

-- | Warning: this allows to add any arbitrary patch! Used by convert import.
addToTentativeInventory :: RepoPatch p => Cache -> Compression
                        -> PatchInfoAnd rt p wX wY -> IO FilePath
addToTentativeInventory :: Cache -> Compression -> PatchInfoAnd rt p wX wY -> IO String
addToTentativeInventory = String
-> Cache -> Compression -> PatchInfoAnd rt p wX wY -> IO String
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
String
-> Cache -> Compression -> PatchInfoAnd rt p wX wY -> IO String
addToSpecificInventory String
tentativeHashedInventory

-- | Attempt to remove an FL of patches from the tentative inventory.
-- This is used for commands that wish to modify already-recorded patches.
--
-- Precondition: it must be possible to remove the patches, i.e.
--
-- * the patches are in the repository
--
-- * any necessary commutations will succeed
removeFromTentativeInventory :: (IsRepoType rt, RepoPatch p)
                             => Repository rt p wR wU wT -> Compression
                             -> FL (PatchInfoAnd rt p) wX wT -> IO ()
removeFromTentativeInventory :: Repository rt p wR wU wT
-> Compression -> FL (PatchInfoAnd rt p) wX wT -> IO ()
removeFromTentativeInventory repo :: Repository rt p wR wU wT
repo compr :: Compression
compr to_remove :: FL (PatchInfoAnd rt p) wX wT
to_remove = do
    String -> IO ()
debugMessage (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Start removeFromTentativeInventory"
    PatchSet rt p Origin wT
allpatches <- Repository rt p wR wU wT -> String -> IO (PatchSet rt p Origin wT)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> String -> IO (PatchSet rt p Origin wT)
readTentativeRepo Repository rt p wR wU wT
repo "."
    PatchSet rt p Origin wX
remaining <- case FL (PatchInfoAnd rt p) wX wT
-> PatchSet rt p Origin wT -> Maybe (PatchSet rt p Origin wX)
forall (p :: * -> * -> *) (rt :: RepoType) wX wY wStart.
Commute p =>
FL (PatchInfoAnd rt p) wX wY
-> PatchSet rt p wStart wY -> Maybe (PatchSet rt p wStart wX)
removeFromPatchSet FL (PatchInfoAnd rt p) wX wT
to_remove PatchSet rt p Origin wT
allpatches of
        Nothing -> String -> IO (PatchSet rt p Origin wX)
forall a. String -> a
bug "Hashed.removeFromTentativeInventory: precondition violated"
        Just r :: PatchSet rt p Origin wX
r -> PatchSet rt p Origin wX -> IO (PatchSet rt p Origin wX)
forall (m :: * -> *) a. Monad m => a -> m a
return PatchSet rt p Origin wX
r
    Cache -> Compression -> PatchSet rt p Origin wX -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
Cache -> Compression -> PatchSet rt p Origin wX -> IO ()
writeTentativeInventory (Repository rt p wR wU wT -> Cache
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p wR wU wT
repo) Compression
compr PatchSet rt p Origin wX
remaining
    String -> IO ()
debugMessage (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Done removeFromTentativeInventory"

-- |writeHashFile takes a Doc and writes it as a hash-named file, returning the
-- filename that the contents were written to.
writeHashFile :: Cache -> Compression -> HashedDir -> Doc -> IO String
writeHashFile :: Cache -> Compression -> HashedDir -> Doc -> IO String
writeHashFile c :: Cache
c compr :: Compression
compr subdir :: HashedDir
subdir d :: Doc
d = do
    String -> IO ()
debugMessage (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Writing hash file to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HashedDir -> String
hashedDir HashedDir
subdir
    Cache -> Compression -> HashedDir -> ByteString -> IO String
writeFileUsingCache Cache
c Compression
compr HashedDir
subdir (ByteString -> IO String) -> ByteString -> IO String
forall a b. (a -> b) -> a -> b
$ Doc -> ByteString
renderPS Doc
d

-- |readRepo returns the "current" repo patchset.
readRepoHashed :: (IsRepoType rt, RepoPatch p) => Repository rt p wR wU wT
               -> String -> IO (PatchSet rt p Origin wR)
readRepoHashed :: Repository rt p wR wU wT -> String -> IO (PatchSet rt p Origin wR)
readRepoHashed = String
-> Repository rt p wR wU wT
-> String
-> IO (PatchSet rt p Origin wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wS.
(IsRepoType rt, RepoPatch p) =>
String
-> Repository rt p wR wU wT
-> String
-> IO (PatchSet rt p Origin wS)
readRepoUsingSpecificInventory String
hashedInventory

-- |readRepo returns the tentative repo patchset.
readTentativeRepo :: (IsRepoType rt, RepoPatch p)
                  => Repository rt p wR wU wT -> String
                  -> IO (PatchSet rt p Origin wT)
readTentativeRepo :: Repository rt p wR wU wT -> String -> IO (PatchSet rt p Origin wT)
readTentativeRepo = String
-> Repository rt p wR wU wT
-> String
-> IO (PatchSet rt p Origin wT)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wS.
(IsRepoType rt, RepoPatch p) =>
String
-> Repository rt p wR wU wT
-> String
-> IO (PatchSet rt p Origin wS)
readRepoUsingSpecificInventory String
tentativeHashedInventory

-- |readRepoUsingSpecificInventory uses the inventory at @invPath@ to read the
-- repository @repo@.
readRepoUsingSpecificInventory :: (IsRepoType rt, RepoPatch p)
                               => String -> Repository rt p wR wU wT
                               -> String -> IO (PatchSet rt p Origin wS)
readRepoUsingSpecificInventory :: String
-> Repository rt p wR wU wT
-> String
-> IO (PatchSet rt p Origin wS)
readRepoUsingSpecificInventory invPath :: String
invPath repo :: Repository rt p wR wU wT
repo dir :: String
dir = do
    String
realdir <- AbsoluteOrRemotePath -> String
forall a. FilePathOrURL a => a -> String
toPath (AbsoluteOrRemotePath -> String)
-> IO AbsoluteOrRemotePath -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO AbsoluteOrRemotePath
ioAbsoluteOrRemote String
dir
    Sealed ps :: PatchSet rt p Origin wX
ps <- Cache -> String -> String -> IO (Sealed (PatchSet rt p Origin))
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, RepoPatch p) =>
Cache -> String -> String -> IO (SealedPatchSet rt p Origin)
readRepoPrivate (Repository rt p wR wU wT -> Cache
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p wR wU wT
repo) String
realdir String
invPath
                 IO (Sealed (PatchSet rt p Origin))
-> (IOException -> IO (Sealed (PatchSet rt p Origin)))
-> IO (Sealed (PatchSet rt p Origin))
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \e :: IOException
e -> do
                     Handle -> String -> IO ()
hPutStrLn Handle
stderr ("Invalid repository: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
realdir)
                     IOException -> IO (Sealed (PatchSet rt p Origin))
forall a. IOException -> IO a
ioError IOException
e
    PatchSet rt p Origin wS -> IO (PatchSet rt p Origin wS)
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchSet rt p Origin wS -> IO (PatchSet rt p Origin wS))
-> PatchSet rt p Origin wS -> IO (PatchSet rt p Origin wS)
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wX -> PatchSet rt p Origin wS
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP PatchSet rt p Origin wX
ps
  where
    readRepoPrivate :: (IsRepoType rt, RepoPatch p) => Cache -> FilePath
                    -> FilePath -> IO (SealedPatchSet rt p Origin)
    readRepoPrivate :: Cache -> String -> String -> IO (SealedPatchSet rt p Origin)
readRepoPrivate cache :: Cache
cache d :: String
d iname :: String
iname = do
      Inventory
inventory <- String -> IO Inventory
readInventoryPrivate (String
d String -> String -> String
</> String
darcsdir String -> String -> String
</> String
iname)
      Cache -> Inventory -> IO (SealedPatchSet rt p Origin)
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, RepoPatch p) =>
Cache -> Inventory -> IO (SealedPatchSet rt p Origin)
readRepoFromInventoryList Cache
cache Inventory
inventory

-- | Read a 'PatchSet' from the repository (assumed to be located at the
-- current working directory) by following the chain of 'Inventory's, starting
-- with the given one. The 'Cache' parameter is used to locate patches and parent
-- inventories, since not all of them need be present inside the current repo.
readRepoFromInventoryList
  :: (IsRepoType rt, RepoPatch p)
  => Cache
  -> Inventory
  -> IO (SealedPatchSet rt p Origin)
readRepoFromInventoryList :: Cache -> Inventory -> IO (SealedPatchSet rt p Origin)
readRepoFromInventoryList cache :: Cache
cache = Inventory -> IO (SealedPatchSet rt p Origin)
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, RepoPatch p) =>
Inventory -> IO (SealedPatchSet rt p Origin)
parseInv
  where
    parseInv :: (IsRepoType rt, RepoPatch p)
             => Inventory
             -> IO (SealedPatchSet rt p Origin)
    parseInv :: Inventory -> IO (SealedPatchSet rt p Origin)
parseInv (Inventory Nothing ris :: [(PatchInfo, PatchHash)]
ris) =
        (forall wX.
 RL (PatchInfoAnd rt p) Origin wX -> PatchSet rt p Origin wX)
-> Sealed (RL (PatchInfoAnd rt p) Origin)
-> SealedPatchSet rt p Origin
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal (RL (Tagged rt p) Origin Origin
-> RL (PatchInfoAnd rt p) Origin wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) Origin Origin
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL) (Sealed (RL (PatchInfoAnd rt p) Origin)
 -> SealedPatchSet rt p Origin)
-> IO (Sealed (RL (PatchInfoAnd rt p) Origin))
-> IO (SealedPatchSet rt p Origin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PatchInfo, PatchHash)]
-> IO (Sealed (RL (PatchInfoAnd rt p) Origin))
forall (rt :: RepoType) (p :: * -> * -> *) wX.
(IsRepoType rt, RepoPatch p) =>
[(PatchInfo, PatchHash)] -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
read_patches ([(PatchInfo, PatchHash)] -> [(PatchInfo, PatchHash)]
forall a. [a] -> [a]
reverse [(PatchInfo, PatchHash)]
ris)
    parseInv (Inventory (Just h :: InventoryHash
h) []) =
        -- TODO could be more tolerant and create a larger PatchSet
        String -> IO (SealedPatchSet rt p Origin)
forall a. String -> a
bug (String -> IO (SealedPatchSet rt p Origin))
-> String -> IO (SealedPatchSet rt p Origin)
forall a b. (a -> b) -> a -> b
$ "bad inventory " String -> String -> String
forall a. [a] -> [a] -> [a]
++ InventoryHash -> String
forall a. ValidHash a => a -> String
getValidHash InventoryHash
h String -> String -> String
forall a. [a] -> [a] -> [a]
++ " (no tag) in parseInv!"
    parseInv (Inventory (Just h :: InventoryHash
h) (t :: (PatchInfo, PatchHash)
t : ris :: [(PatchInfo, PatchHash)]
ris)) = do
        Sealed ts :: RL (Tagged rt p) Origin wX
ts <- (forall wX.
 RL (Tagged rt p) Origin wX -> Sealed (RL (Tagged rt p) Origin))
-> Sealed (RL (Tagged rt p) Origin)
-> Sealed (RL (Tagged rt p) Origin)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall wX.
RL (Tagged rt p) Origin wX -> Sealed (RL (Tagged rt p) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Sealed (RL (Tagged rt p) Origin)
 -> Sealed (RL (Tagged rt p) Origin))
-> IO (Sealed (RL (Tagged rt p) Origin))
-> IO (Sealed (RL (Tagged rt p) Origin))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Sealed (RL (Tagged rt p) Origin))
-> IO (Sealed (RL (Tagged rt p) Origin))
forall a. IO a -> IO a
unsafeInterleaveIO ((PatchInfo, PatchHash)
-> InventoryHash -> IO (Sealed (RL (Tagged rt p) Origin))
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, RepoPatch p) =>
(PatchInfo, PatchHash)
-> InventoryHash -> IO (Sealed (RL (Tagged rt p) Origin))
read_ts (PatchInfo, PatchHash)
t InventoryHash
h)
        Sealed ps :: RL (PatchInfoAnd rt p) wX wX
ps <- (forall wX.
 RL (PatchInfoAnd rt p) wX wX -> Sealed (RL (PatchInfoAnd rt p) wX))
-> Sealed (RL (PatchInfoAnd rt p) wX)
-> Sealed (RL (PatchInfoAnd rt p) wX)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall wX.
RL (PatchInfoAnd rt p) wX wX -> Sealed (RL (PatchInfoAnd rt p) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Sealed (RL (PatchInfoAnd rt p) wX)
 -> Sealed (RL (PatchInfoAnd rt p) wX))
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                        IO (Sealed (RL (PatchInfoAnd rt p) wX))
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall a. IO a -> IO a
unsafeInterleaveIO ([(PatchInfo, PatchHash)] -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall (rt :: RepoType) (p :: * -> * -> *) wX.
(IsRepoType rt, RepoPatch p) =>
[(PatchInfo, PatchHash)] -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
read_patches ([(PatchInfo, PatchHash)]
 -> IO (Sealed (RL (PatchInfoAnd rt p) wX)))
-> [(PatchInfo, PatchHash)]
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall a b. (a -> b) -> a -> b
$ [(PatchInfo, PatchHash)] -> [(PatchInfo, PatchHash)]
forall a. [a] -> [a]
reverse [(PatchInfo, PatchHash)]
ris)
        SealedPatchSet rt p Origin -> IO (SealedPatchSet rt p Origin)
forall (m :: * -> *) a. Monad m => a -> m a
return (SealedPatchSet rt p Origin -> IO (SealedPatchSet rt p Origin))
-> SealedPatchSet rt p Origin -> IO (SealedPatchSet rt p Origin)
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wX -> SealedPatchSet rt p Origin
forall (a :: * -> *) wX. a wX -> Sealed a
seal (PatchSet rt p Origin wX -> SealedPatchSet rt p Origin)
-> PatchSet rt p Origin wX -> SealedPatchSet rt p Origin
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) Origin wX
ts RL (PatchInfoAnd rt p) wX wX
ps

    read_patches :: (IsRepoType rt, RepoPatch p) => [InventoryEntry]
                 -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
    read_patches :: [(PatchInfo, PatchHash)] -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
read_patches [] = Sealed (RL (PatchInfoAnd rt p) wX)
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (RL (PatchInfoAnd rt p) wX)
 -> IO (Sealed (RL (PatchInfoAnd rt p) wX)))
-> Sealed (RL (PatchInfoAnd rt p) wX)
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall a b. (a -> b) -> a -> b
$ RL (PatchInfoAnd rt p) wX wX -> Sealed (RL (PatchInfoAnd rt p) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal RL (PatchInfoAnd rt p) wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
    read_patches allis :: [(PatchInfo, PatchHash)]
allis@((i1 :: PatchInfo
i1, h1 :: PatchHash
h1) : is1 :: [(PatchInfo, PatchHash)]
is1) =
        (forall wY wZ.
 Hopefully (WrappedNamed rt p) wY wZ
 -> RL (PatchInfoAnd rt p) wX wY -> RL (PatchInfoAnd rt p) wX wZ)
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
-> (forall wB. IO (Sealed (Hopefully (WrappedNamed rt p) wB)))
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall (q :: * -> * -> *) (p :: * -> * -> *) wX (r :: * -> * -> *).
(forall wY wZ. q wY wZ -> p wX wY -> r wX wZ)
-> IO (Sealed (p wX))
-> (forall wB. IO (Sealed (q wB)))
-> IO (Sealed (r wX))
lift2Sealed (\p :: Hopefully (WrappedNamed rt p) wY wZ
p rest :: RL (PatchInfoAnd rt p) wX wY
rest -> RL (PatchInfoAnd rt p) wX wY
rest RL (PatchInfoAnd rt p) wX wY
-> PatchInfoAnd rt p wY wZ -> RL (PatchInfoAnd rt p) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfo
i1 PatchInfo
-> Hopefully (WrappedNamed rt p) wY wZ -> PatchInfoAnd rt p wY wZ
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfo
-> Hopefully (WrappedNamed rt p) wA wB -> PatchInfoAnd rt p wA wB
`patchInfoAndPatch` Hopefully (WrappedNamed rt p) wY wZ
p) ([(PatchInfo, PatchHash)] -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall (rt :: RepoType) (p :: * -> * -> *) wX.
(IsRepoType rt, RepoPatch p) =>
[(PatchInfo, PatchHash)] -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
rp [(PatchInfo, PatchHash)]
is1)
                    (PatchHash
-> (PatchHash -> IO (Sealed (WrappedNamed rt p wB)))
-> IO (Sealed (Hopefully (WrappedNamed rt p) wB))
forall (a :: * -> * -> *) wX.
PatchHash
-> (PatchHash -> IO (Sealed (a wX)))
-> IO (Sealed (Hopefully a wX))
createValidHashed PatchHash
h1 (IO (Sealed (WrappedNamed rt p wB))
-> PatchHash -> IO (Sealed (WrappedNamed rt p wB))
forall a b. a -> b -> a
const (IO (Sealed (WrappedNamed rt p wB))
 -> PatchHash -> IO (Sealed (WrappedNamed rt p wB)))
-> IO (Sealed (WrappedNamed rt p wB))
-> PatchHash
-> IO (Sealed (WrappedNamed rt p wB))
forall a b. (a -> b) -> a -> b
$ PatchHash
-> [(PatchInfo, PatchHash)]
-> PatchInfo
-> IO (Sealed (WrappedNamed rt p wB))
forall (p :: * -> * -> *) wX.
ReadPatch p =>
PatchHash
-> [(PatchInfo, PatchHash)] -> PatchInfo -> IO (Sealed (p wX))
speculateAndParse PatchHash
h1 [(PatchInfo, PatchHash)]
allis PatchInfo
i1))
      where
        rp :: (IsRepoType rt, RepoPatch p) => [InventoryEntry]
           -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
        rp :: [(PatchInfo, PatchHash)] -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
rp [] = Sealed (RL (PatchInfoAnd rt p) wX)
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (RL (PatchInfoAnd rt p) wX)
 -> IO (Sealed (RL (PatchInfoAnd rt p) wX)))
-> Sealed (RL (PatchInfoAnd rt p) wX)
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall a b. (a -> b) -> a -> b
$ RL (PatchInfoAnd rt p) wX wX -> Sealed (RL (PatchInfoAnd rt p) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal RL (PatchInfoAnd rt p) wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
        rp [(i :: PatchInfo
i, h :: PatchHash
h), (il :: PatchInfo
il, hl :: PatchHash
hl)] =
            (forall wY wZ.
 Hopefully (WrappedNamed rt p) wY wZ
 -> RL (PatchInfoAnd rt p) wX wY -> RL (PatchInfoAnd rt p) wX wZ)
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
-> (forall wB. IO (Sealed (Hopefully (WrappedNamed rt p) wB)))
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall (q :: * -> * -> *) (p :: * -> * -> *) wX (r :: * -> * -> *).
(forall wY wZ. q wY wZ -> p wX wY -> r wX wZ)
-> IO (Sealed (p wX))
-> (forall wB. IO (Sealed (q wB)))
-> IO (Sealed (r wX))
lift2Sealed (\p :: Hopefully (WrappedNamed rt p) wY wZ
p rest :: RL (PatchInfoAnd rt p) wX wY
rest -> RL (PatchInfoAnd rt p) wX wY
rest RL (PatchInfoAnd rt p) wX wY
-> PatchInfoAnd rt p wY wZ -> RL (PatchInfoAnd rt p) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfo
i PatchInfo
-> Hopefully (WrappedNamed rt p) wY wZ -> PatchInfoAnd rt p wY wZ
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfo
-> Hopefully (WrappedNamed rt p) wA wB -> PatchInfoAnd rt p wA wB
`patchInfoAndPatch` Hopefully (WrappedNamed rt p) wY wZ
p)
                        ([(PatchInfo, PatchHash)] -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall (rt :: RepoType) (p :: * -> * -> *) wX.
(IsRepoType rt, RepoPatch p) =>
[(PatchInfo, PatchHash)] -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
rp [(PatchInfo
il, PatchHash
hl)])
                        (PatchHash
-> (PatchHash -> IO (Sealed (WrappedNamed rt p wB)))
-> IO (Sealed (Hopefully (WrappedNamed rt p) wB))
forall (a :: * -> * -> *) wX.
PatchHash
-> (PatchHash -> IO (Sealed (a wX)))
-> IO (Sealed (Hopefully a wX))
createValidHashed PatchHash
h
                            (IO (Sealed (WrappedNamed rt p wB))
-> PatchHash -> IO (Sealed (WrappedNamed rt p wB))
forall a b. a -> b -> a
const (IO (Sealed (WrappedNamed rt p wB))
 -> PatchHash -> IO (Sealed (WrappedNamed rt p wB)))
-> IO (Sealed (WrappedNamed rt p wB))
-> PatchHash
-> IO (Sealed (WrappedNamed rt p wB))
forall a b. (a -> b) -> a -> b
$ PatchHash
-> [(PatchInfo, PatchHash)]
-> PatchInfo
-> IO (Sealed (WrappedNamed rt p wB))
forall (p :: * -> * -> *) wX.
ReadPatch p =>
PatchHash
-> [(PatchInfo, PatchHash)] -> PatchInfo -> IO (Sealed (p wX))
speculateAndParse PatchHash
h ([(PatchInfo, PatchHash)] -> [(PatchInfo, PatchHash)]
forall a. [a] -> [a]
reverse [(PatchInfo, PatchHash)]
allis) PatchInfo
i))
        rp ((i :: PatchInfo
i, h :: PatchHash
h) : is :: [(PatchInfo, PatchHash)]
is) =
            (forall wY wZ.
 Hopefully (WrappedNamed rt p) wY wZ
 -> RL (PatchInfoAnd rt p) wX wY -> RL (PatchInfoAnd rt p) wX wZ)
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
-> (forall wB. IO (Sealed (Hopefully (WrappedNamed rt p) wB)))
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall (q :: * -> * -> *) (p :: * -> * -> *) wX (r :: * -> * -> *).
(forall wY wZ. q wY wZ -> p wX wY -> r wX wZ)
-> IO (Sealed (p wX))
-> (forall wB. IO (Sealed (q wB)))
-> IO (Sealed (r wX))
lift2Sealed (\p :: Hopefully (WrappedNamed rt p) wY wZ
p rest :: RL (PatchInfoAnd rt p) wX wY
rest -> RL (PatchInfoAnd rt p) wX wY
rest RL (PatchInfoAnd rt p) wX wY
-> PatchInfoAnd rt p wY wZ -> RL (PatchInfoAnd rt p) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfo
i PatchInfo
-> Hopefully (WrappedNamed rt p) wY wZ -> PatchInfoAnd rt p wY wZ
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfo
-> Hopefully (WrappedNamed rt p) wA wB -> PatchInfoAnd rt p wA wB
`patchInfoAndPatch` Hopefully (WrappedNamed rt p) wY wZ
p)
                        ([(PatchInfo, PatchHash)] -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall (rt :: RepoType) (p :: * -> * -> *) wX.
(IsRepoType rt, RepoPatch p) =>
[(PatchInfo, PatchHash)] -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
rp [(PatchInfo, PatchHash)]
is)
                        (PatchHash
-> (PatchHash -> IO (Sealed (WrappedNamed rt p wB)))
-> IO (Sealed (Hopefully (WrappedNamed rt p) wB))
forall (a :: * -> * -> *) wX.
PatchHash
-> (PatchHash -> IO (Sealed (a wX)))
-> IO (Sealed (Hopefully a wX))
createValidHashed PatchHash
h (PatchInfo -> PatchHash -> IO (Sealed (WrappedNamed rt p wB))
forall (p :: * -> * -> *) wX.
ReadPatch p =>
PatchInfo -> PatchHash -> IO (Sealed (p wX))
parse PatchInfo
i))

    lift2Sealed :: (forall wY wZ . q wY wZ -> p wX wY -> r wX wZ)
                -> IO (Sealed (p wX))
                -> (forall wB . IO (Sealed (q wB)))
                -> IO (Sealed (r wX))
    lift2Sealed :: (forall wY wZ. q wY wZ -> p wX wY -> r wX wZ)
-> IO (Sealed (p wX))
-> (forall wB. IO (Sealed (q wB)))
-> IO (Sealed (r wX))
lift2Sealed f :: forall wY wZ. q wY wZ -> p wX wY -> r wX wZ
f iox :: IO (Sealed (p wX))
iox ioy :: forall wB. IO (Sealed (q wB))
ioy = do
        Sealed x :: p wX wX
x <- (forall wX. p wX wX -> Sealed (p wX))
-> Sealed (p wX) -> Sealed (p wX)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall wX. p wX wX -> Sealed (p wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Sealed (p wX) -> Sealed (p wX))
-> IO (Sealed (p wX)) -> IO (Sealed (p wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Sealed (p wX)) -> IO (Sealed (p wX))
forall a. IO a -> IO a
unsafeInterleaveIO IO (Sealed (p wX))
iox
        Sealed y :: q wX wX
y <- (forall wX. q wX wX -> Sealed (q wX))
-> Sealed (q wX) -> Sealed (q wX)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall wX. q wX wX -> Sealed (q wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Sealed (q wX) -> Sealed (q wX))
-> IO (Sealed (q wX)) -> IO (Sealed (q wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Sealed (q wX)) -> IO (Sealed (q wX))
forall a. IO a -> IO a
unsafeInterleaveIO IO (Sealed (q wX))
forall wB. IO (Sealed (q wB))
ioy
        Sealed (r wX) -> IO (Sealed (r wX))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (r wX) -> IO (Sealed (r wX)))
-> Sealed (r wX) -> IO (Sealed (r wX))
forall a b. (a -> b) -> a -> b
$ r wX wX -> Sealed (r wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (r wX wX -> Sealed (r wX)) -> r wX wX -> Sealed (r wX)
forall a b. (a -> b) -> a -> b
$ q wX wX -> p wX wX -> r wX wX
forall wY wZ. q wY wZ -> p wX wY -> r wX wZ
f q wX wX
y p wX wX
x

    speculateAndParse :: PatchHash
-> [(PatchInfo, PatchHash)] -> PatchInfo -> IO (Sealed (p wX))
speculateAndParse h :: PatchHash
h is :: [(PatchInfo, PatchHash)]
is i :: PatchInfo
i = PatchHash -> [(PatchInfo, PatchHash)] -> IO ()
speculate PatchHash
h [(PatchInfo, PatchHash)]
is IO () -> IO (Sealed (p wX)) -> IO (Sealed (p wX))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PatchInfo -> PatchHash -> IO (Sealed (p wX))
forall (p :: * -> * -> *) wX.
ReadPatch p =>
PatchInfo -> PatchHash -> IO (Sealed (p wX))
parse PatchInfo
i PatchHash
h

    speculate :: PatchHash -> [InventoryEntry] -> IO ()
    speculate :: PatchHash -> [(PatchInfo, PatchHash)] -> IO ()
speculate h :: PatchHash
h is :: [(PatchInfo, PatchHash)]
is = do
        Bool
already_got_one <- Cache -> HashedDir -> String -> IO Bool
peekInCache Cache
cache HashedDir
HashedPatchesDir (PatchHash -> String
forall a. ValidHash a => a -> String
getValidHash PatchHash
h)
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
already_got_one (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            Cache -> HashedDir -> [String] -> IO ()
speculateFilesUsingCache Cache
cache HashedDir
HashedPatchesDir (((PatchInfo, PatchHash) -> String)
-> [(PatchInfo, PatchHash)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (PatchHash -> String
forall a. ValidHash a => a -> String
getValidHash (PatchHash -> String)
-> ((PatchInfo, PatchHash) -> PatchHash)
-> (PatchInfo, PatchHash)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PatchInfo, PatchHash) -> PatchHash
forall a b. (a, b) -> b
snd) [(PatchInfo, PatchHash)]
is)

    parse :: ReadPatch p => PatchInfo -> PatchHash -> IO (Sealed (p wX))
    parse :: PatchInfo -> PatchHash -> IO (Sealed (p wX))
parse i :: PatchInfo
i h :: PatchHash
h = do
        String -> IO ()
debugMessage ("Reading patch file: "String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc -> String
showDoc (PatchInfo -> Doc
displayPatchInfo PatchInfo
i))
        (fn :: String
fn, ps :: ByteString
ps) <- Cache -> HashedDir -> String -> IO (String, ByteString)
fetchFileUsingCache Cache
cache HashedDir
HashedPatchesDir (PatchHash -> String
forall a. ValidHash a => a -> String
getValidHash PatchHash
h)
        case ByteString -> Maybe (Sealed (p wX))
forall (p :: * -> * -> *) wX.
ReadPatch p =>
ByteString -> Maybe (Sealed (p wX))
readPatch ByteString
ps of
            Just p :: Sealed (p wX)
p -> Sealed (p wX) -> IO (Sealed (p wX))
forall (m :: * -> *) a. Monad m => a -> m a
return Sealed (p wX)
p
            Nothing -> String -> IO (Sealed (p wX))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO (Sealed (p wX))) -> String -> IO (Sealed (p wX))
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ "Couldn't parse file " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fn
                                      , "which is patch"
                                      , Doc -> String
renderString (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ PatchInfo -> Doc
displayPatchInfo PatchInfo
i ]

    read_ts :: (IsRepoType rt, RepoPatch p) => InventoryEntry
            -> InventoryHash -> IO (Sealed (RL (Tagged rt p) Origin))
    read_ts :: (PatchInfo, PatchHash)
-> InventoryHash -> IO (Sealed (RL (Tagged rt p) Origin))
read_ts tag0 :: (PatchInfo, PatchHash)
tag0 h0 :: InventoryHash
h0 = do
        Inventory
contents <- IO Inventory -> IO Inventory
forall a. IO a -> IO a
unsafeInterleaveIO (IO Inventory -> IO Inventory) -> IO Inventory -> IO Inventory
forall a b. (a -> b) -> a -> b
$ String -> IO Inventory
readTaggedInventoryFromHash (InventoryHash -> String
forall a. ValidHash a => a -> String
getValidHash InventoryHash
h0)
        let is :: [(PatchInfo, PatchHash)]
is = [(PatchInfo, PatchHash)] -> [(PatchInfo, PatchHash)]
forall a. [a] -> [a]
reverse ([(PatchInfo, PatchHash)] -> [(PatchInfo, PatchHash)])
-> [(PatchInfo, PatchHash)] -> [(PatchInfo, PatchHash)]
forall a b. (a -> b) -> a -> b
$ case Inventory
contents of
                               (Inventory (Just _) (_ : ris0 :: [(PatchInfo, PatchHash)]
ris0)) -> [(PatchInfo, PatchHash)]
ris0
                               (Inventory Nothing ris0 :: [(PatchInfo, PatchHash)]
ris0) -> [(PatchInfo, PatchHash)]
ris0
                               (Inventory (Just _) []) -> String -> [(PatchInfo, PatchHash)]
forall a. String -> a
bug "inventory without tag!"
        Sealed ts :: RL (Tagged rt p) Origin wX
ts <- (forall wX.
 RL (Tagged rt p) Origin wX -> Sealed (RL (Tagged rt p) Origin))
-> Sealed (RL (Tagged rt p) Origin)
-> Sealed (RL (Tagged rt p) Origin)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall wX.
RL (Tagged rt p) Origin wX -> Sealed (RL (Tagged rt p) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Sealed (RL (Tagged rt p) Origin)
 -> Sealed (RL (Tagged rt p) Origin))
-> IO (Sealed (RL (Tagged rt p) Origin))
-> IO (Sealed (RL (Tagged rt p) Origin))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         IO (Sealed (RL (Tagged rt p) Origin))
-> IO (Sealed (RL (Tagged rt p) Origin))
forall a. IO a -> IO a
unsafeInterleaveIO
                            (case Inventory
contents of
                                 (Inventory (Just h' :: InventoryHash
h') (t' :: (PatchInfo, PatchHash)
t' : _)) -> (PatchInfo, PatchHash)
-> InventoryHash -> IO (Sealed (RL (Tagged rt p) Origin))
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, RepoPatch p) =>
(PatchInfo, PatchHash)
-> InventoryHash -> IO (Sealed (RL (Tagged rt p) Origin))
read_ts (PatchInfo, PatchHash)
t' InventoryHash
h'
                                 (Inventory (Just _) []) -> String -> IO (Sealed (RL (Tagged rt p) Origin))
forall a. String -> a
bug "inventory without tag!"
                                 (Inventory Nothing _) -> Sealed (RL (Tagged rt p) Origin)
-> IO (Sealed (RL (Tagged rt p) Origin))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (RL (Tagged rt p) Origin)
 -> IO (Sealed (RL (Tagged rt p) Origin)))
-> Sealed (RL (Tagged rt p) Origin)
-> IO (Sealed (RL (Tagged rt p) Origin))
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) Origin Origin -> Sealed (RL (Tagged rt p) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal RL (Tagged rt p) Origin Origin
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL)
        Sealed ps :: RL (PatchInfoAnd rt p) wX wX
ps <- (forall wX.
 RL (PatchInfoAnd rt p) wX wX -> Sealed (RL (PatchInfoAnd rt p) wX))
-> Sealed (RL (PatchInfoAnd rt p) wX)
-> Sealed (RL (PatchInfoAnd rt p) wX)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall wX.
RL (PatchInfoAnd rt p) wX wX -> Sealed (RL (PatchInfoAnd rt p) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Sealed (RL (PatchInfoAnd rt p) wX)
 -> Sealed (RL (PatchInfoAnd rt p) wX))
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Sealed (RL (PatchInfoAnd rt p) wX))
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall a. IO a -> IO a
unsafeInterleaveIO ([(PatchInfo, PatchHash)] -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall (rt :: RepoType) (p :: * -> * -> *) wX.
(IsRepoType rt, RepoPatch p) =>
[(PatchInfo, PatchHash)] -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
read_patches [(PatchInfo, PatchHash)]
is)
        Sealed tag00 :: PatchInfoAnd rt p wX wX
tag00 <- (PatchInfo, PatchHash) -> IO (Sealed (PatchInfoAnd rt p wX))
forall (rt :: RepoType) (p :: * -> * -> *) wX.
(IsRepoType rt, RepoPatch p) =>
(PatchInfo, PatchHash) -> IO (Sealed (PatchInfoAnd rt p wX))
read_tag (PatchInfo, PatchHash)
tag0
        Sealed (RL (Tagged rt p) Origin)
-> IO (Sealed (RL (Tagged rt p) Origin))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (RL (Tagged rt p) Origin)
 -> IO (Sealed (RL (Tagged rt p) Origin)))
-> Sealed (RL (Tagged rt p) Origin)
-> IO (Sealed (RL (Tagged rt p) Origin))
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) Origin wX -> Sealed (RL (Tagged rt p) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (RL (Tagged rt p) Origin wX -> Sealed (RL (Tagged rt p) Origin))
-> RL (Tagged rt p) Origin wX -> Sealed (RL (Tagged rt p) Origin)
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) Origin wX
ts RL (Tagged rt p) Origin wX
-> Tagged rt p wX wX -> RL (Tagged rt p) Origin wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wX wX
-> Maybe String
-> RL (PatchInfoAnd rt p) wX wX
-> Tagged rt p wX wX
forall (rt :: RepoType) (p :: * -> * -> *) wY wZ wX.
PatchInfoAnd rt p wY wZ
-> Maybe String
-> RL (PatchInfoAnd rt p) wX wY
-> Tagged rt p wX wZ
Tagged PatchInfoAnd rt p wX wX
tag00 (String -> Maybe String
forall a. a -> Maybe a
Just (InventoryHash -> String
forall a. ValidHash a => a -> String
getValidHash InventoryHash
h0)) RL (PatchInfoAnd rt p) wX wX
ps

    read_tag :: (IsRepoType rt, RepoPatch p) => InventoryEntry
             -> IO (Sealed (PatchInfoAnd rt p wX))
    read_tag :: (PatchInfo, PatchHash) -> IO (Sealed (PatchInfoAnd rt p wX))
read_tag (i :: PatchInfo
i, h :: PatchHash
h) =
        (forall wX.
 Hopefully (WrappedNamed rt p) wX wX -> PatchInfoAnd rt p wX wX)
-> Sealed (Hopefully (WrappedNamed rt p) wX)
-> Sealed (PatchInfoAnd rt p wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal (PatchInfo
-> Hopefully (WrappedNamed rt p) wX wX -> PatchInfoAnd rt p wX wX
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfo
-> Hopefully (WrappedNamed rt p) wA wB -> PatchInfoAnd rt p wA wB
patchInfoAndPatch PatchInfo
i) (Sealed (Hopefully (WrappedNamed rt p) wX)
 -> Sealed (PatchInfoAnd rt p wX))
-> IO (Sealed (Hopefully (WrappedNamed rt p) wX))
-> IO (Sealed (PatchInfoAnd rt p wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PatchHash
-> (PatchHash -> IO (Sealed (WrappedNamed rt p wX)))
-> IO (Sealed (Hopefully (WrappedNamed rt p) wX))
forall (a :: * -> * -> *) wX.
PatchHash
-> (PatchHash -> IO (Sealed (a wX)))
-> IO (Sealed (Hopefully a wX))
createValidHashed PatchHash
h (PatchInfo -> PatchHash -> IO (Sealed (WrappedNamed rt p wX))
forall (p :: * -> * -> *) wX.
ReadPatch p =>
PatchInfo -> PatchHash -> IO (Sealed (p wX))
parse PatchInfo
i)

    readTaggedInventoryFromHash :: String
                                -> IO Inventory
    readTaggedInventoryFromHash :: String -> IO Inventory
readTaggedInventoryFromHash invHash :: String
invHash = do
        (fileName :: String
fileName, pristineAndInventory :: ByteString
pristineAndInventory) <-
            Cache -> HashedDir -> String -> IO (String, ByteString)
fetchFileUsingCache Cache
cache HashedDir
HashedInventoriesDir String
invHash
        case ByteString -> Maybe Inventory
parseInventory ByteString
pristineAndInventory of
          Just r :: Inventory
r -> Inventory -> IO Inventory
forall (m :: * -> *) a. Monad m => a -> m a
return Inventory
r
          Nothing -> String -> IO Inventory
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO Inventory) -> String -> IO Inventory
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords ["parse error in file", String
fileName]

-- | Read an inventory from a file. Fails with an error message if
-- file is not there or cannot be parsed.
readInventoryPrivate :: FilePath
                     -> IO Inventory
readInventoryPrivate :: String -> IO Inventory
readInventoryPrivate path :: String
path = do
    ByteString
inv <- ByteString -> ByteString
skipPristineHash (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Cachable -> IO ByteString
gzFetchFilePS String
path Cachable
Uncachable
    case ByteString -> Maybe Inventory
parseInventory ByteString
inv of
      Just r :: Inventory
r -> Inventory -> IO Inventory
forall (m :: * -> *) a. Monad m => a -> m a
return Inventory
r
      Nothing -> String -> IO Inventory
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO Inventory) -> String -> IO Inventory
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords ["parse error in file", String
path]

-- |copyRepo copies the hashed inventory of @repo@ to the repository located at
-- @remote@.
copyHashedInventory :: Repository rt p wR wU wT -> RemoteDarcs -> String -> IO ()
copyHashedInventory :: Repository rt p wR wU wT -> RemoteDarcs -> String -> IO ()
copyHashedInventory outrepo :: Repository rt p wR wU wT
outrepo rdarcs :: RemoteDarcs
rdarcs inloc :: String
inloc | String
remote <- RemoteDarcs -> String
remoteDarcs RemoteDarcs
rdarcs = do
    let outloc :: String
outloc = Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
repoLocation Repository rt p wR wU wT
outrepo
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
False (String
outloc String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
inventoriesDirPath)
    String -> String -> String -> Cachable -> IO ()
copyFileOrUrl String
remote (String
inloc String -> String -> String
</> String
hashedInventoryPath)
                         (String
outloc String -> String -> String
</> String
hashedInventoryPath)
                  Cachable
Uncachable -- no need to copy anything but hashed_inventory!
    String -> IO ()
debugMessage "Done copying hashed inventory."

-- |writeAndReadPatch makes a patch lazy, by writing it out to disk (thus
-- forcing it), and then re-reads the patch lazily.
writeAndReadPatch :: (IsRepoType rt, RepoPatch p) => Cache -> Compression
                  -> PatchInfoAnd rt p wX wY -> IO (PatchInfoAnd rt p wX wY)
writeAndReadPatch :: Cache
-> Compression
-> PatchInfoAnd rt p wX wY
-> IO (PatchInfoAnd rt p wX wY)
writeAndReadPatch c :: Cache
c compr :: Compression
compr p :: PatchInfoAnd rt p wX wY
p = do
    (i :: PatchInfo
i, h :: PatchHash
h) <- Cache
-> Compression
-> PatchInfoAnd rt p wX wY
-> IO (PatchInfo, PatchHash)
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
Cache
-> Compression
-> PatchInfoAnd rt p wX wY
-> IO (PatchInfo, PatchHash)
writePatchIfNecessary Cache
c Compression
compr PatchInfoAnd rt p wX wY
p
    IO (PatchInfoAnd rt p wX wY) -> IO (PatchInfoAnd rt p wX wY)
forall a. IO a -> IO a
unsafeInterleaveIO (IO (PatchInfoAnd rt p wX wY) -> IO (PatchInfoAnd rt p wX wY))
-> IO (PatchInfoAnd rt p wX wY) -> IO (PatchInfoAnd rt p wX wY)
forall a b. (a -> b) -> a -> b
$ PatchHash -> PatchInfo -> IO (PatchInfoAnd rt p wX wY)
forall (p :: * -> * -> *) (rt :: RepoType) wA wB.
(PrimPatchBase p, FromPrim p, Effect p, IsRepoType rt, ReadPatch p,
 PatchListFormat p) =>
PatchHash -> PatchInfo -> IO (PatchInfoAnd rt p wA wB)
readp PatchHash
h PatchInfo
i
  where
    parse :: PatchInfo -> a -> IO (Sealed (p wX))
parse i :: PatchInfo
i h :: a
h = do
        String -> IO ()
debugMessage ("Rereading patch file: "String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc -> String
showDoc (PatchInfo -> Doc
displayPatchInfo PatchInfo
i))
        (fn :: String
fn, ps :: ByteString
ps) <- Cache -> HashedDir -> String -> IO (String, ByteString)
fetchFileUsingCache Cache
c HashedDir
HashedPatchesDir (a -> String
forall a. ValidHash a => a -> String
getValidHash a
h)
        case ByteString -> Maybe (Sealed (p wX))
forall (p :: * -> * -> *) wX.
ReadPatch p =>
ByteString -> Maybe (Sealed (p wX))
readPatch ByteString
ps of
            Just x :: Sealed (p wX)
x -> Sealed (p wX) -> IO (Sealed (p wX))
forall (m :: * -> *) a. Monad m => a -> m a
return Sealed (p wX)
x
            Nothing -> String -> IO (Sealed (p wX))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO (Sealed (p wX))) -> String -> IO (Sealed (p wX))
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ "Couldn't parse patch file " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fn
                                      , "which is"
                                      , Doc -> String
renderString (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ PatchInfo -> Doc
displayPatchInfo PatchInfo
i]

    readp :: PatchHash -> PatchInfo -> IO (PatchInfoAnd rt p wA wB)
readp h :: PatchHash
h i :: PatchInfo
i = do Sealed x :: Hopefully (WrappedNamed rt p) Any wX
x <- PatchHash
-> (PatchHash -> IO (Sealed (WrappedNamed rt p Any)))
-> IO (Sealed (Hopefully (WrappedNamed rt p) Any))
forall (a :: * -> * -> *) wX.
PatchHash
-> (PatchHash -> IO (Sealed (a wX)))
-> IO (Sealed (Hopefully a wX))
createValidHashed PatchHash
h (PatchInfo -> PatchHash -> IO (Sealed (WrappedNamed rt p Any))
forall a (p :: * -> * -> *) wX.
(ValidHash a, ReadPatch p) =>
PatchInfo -> a -> IO (Sealed (p wX))
parse PatchInfo
i)
                   PatchInfoAnd rt p wA wB -> IO (PatchInfoAnd rt p wA wB)
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchInfoAnd rt p wA wB -> IO (PatchInfoAnd rt p wA wB))
-> (Hopefully (WrappedNamed rt p) wA wB -> PatchInfoAnd rt p wA wB)
-> Hopefully (WrappedNamed rt p) wA wB
-> IO (PatchInfoAnd rt p wA wB)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfo
-> Hopefully (WrappedNamed rt p) wA wB -> PatchInfoAnd rt p wA wB
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfo
-> Hopefully (WrappedNamed rt p) wA wB -> PatchInfoAnd rt p wA wB
patchInfoAndPatch PatchInfo
i (Hopefully (WrappedNamed rt p) wA wB
 -> IO (PatchInfoAnd rt p wA wB))
-> Hopefully (WrappedNamed rt p) wA wB
-> IO (PatchInfoAnd rt p wA wB)
forall a b. (a -> b) -> a -> b
$ Hopefully (WrappedNamed rt p) Any wX
-> Hopefully (WrappedNamed rt p) wA wB
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP Hopefully (WrappedNamed rt p) Any wX
x

createValidHashed :: PatchHash
                  -> (PatchHash -> IO (Sealed (a wX)))
                  -> IO (Sealed (Darcs.Patch.PatchInfoAnd.Hopefully a wX))
createValidHashed :: PatchHash
-> (PatchHash -> IO (Sealed (a wX)))
-> IO (Sealed (Hopefully a wX))
createValidHashed h :: PatchHash
h f :: PatchHash -> IO (Sealed (a wX))
f = String
-> (String -> IO (Sealed (a wX))) -> IO (Sealed (Hopefully a wX))
forall (a :: * -> * -> *) wX.
String
-> (String -> IO (Sealed (a wX))) -> IO (Sealed (Hopefully a wX))
createHashed (PatchHash -> String
forall a. ValidHash a => a -> String
getValidHash PatchHash
h) (PatchHash -> IO (Sealed (a wX))
f (PatchHash -> IO (Sealed (a wX)))
-> (String -> PatchHash) -> String -> IO (Sealed (a wX))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PatchHash
forall a. ValidHash a => String -> a
mkValidHash)

-- | writeTentativeInventory writes @patchSet@ as the tentative inventory.
writeTentativeInventory :: RepoPatch p => Cache -> Compression
                        -> PatchSet rt p Origin wX -> IO ()
writeTentativeInventory :: Cache -> Compression -> PatchSet rt p Origin wX -> IO ()
writeTentativeInventory cache :: Cache
cache compr :: Compression
compr patchSet :: PatchSet rt p Origin wX
patchSet = do
    String -> IO ()
debugMessage "in writeTentativeInventory..."
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
inventoriesDirPath
    String -> IO ()
beginTedious String
tediousName
    Maybe String
hsh <- PatchSet rt p Origin wX -> IO (Maybe String)
forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
PatchSet rt p Origin wX -> IO (Maybe String)
writeInventoryPrivate (PatchSet rt p Origin wX -> IO (Maybe String))
-> PatchSet rt p Origin wX -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> PatchSet rt p wStart wX
slightlyOptimizePatchset PatchSet rt p Origin wX
patchSet
    String -> IO ()
endTedious String
tediousName
    String -> IO ()
debugMessage "still in writeTentativeInventory..."
    case Maybe String
hsh of
        Nothing -> String -> ByteString -> IO ()
forall p. FilePathLike p => p -> ByteString -> IO ()
writeBinFile (String -> String
makeDarcsdirPath String
tentativeHashedInventory) ByteString
B.empty
        Just h :: String
h -> do
            ByteString
content <- (String, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((String, ByteString) -> ByteString)
-> IO (String, ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cache -> HashedDir -> String -> IO (String, ByteString)
fetchFileUsingCache Cache
cache HashedDir
HashedInventoriesDir String
h
            String -> ByteString -> IO ()
forall p. FilePathLike p => p -> ByteString -> IO ()
writeAtomicFilePS (String -> String
makeDarcsdirPath String
tentativeHashedInventory) ByteString
content
  where
    tediousName :: String
tediousName = "Writing inventory"
    writeInventoryPrivate :: RepoPatch p => PatchSet rt p Origin wX
                          -> IO (Maybe String)
    writeInventoryPrivate :: PatchSet rt p Origin wX -> IO (Maybe String)
writeInventoryPrivate (PatchSet NilRL NilRL) = Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
    writeInventoryPrivate (PatchSet NilRL ps :: RL (PatchInfoAnd rt p) wX wX
ps) = do
        [(PatchInfo, PatchHash)]
inventory <- [IO (PatchInfo, PatchHash)] -> IO [(PatchInfo, PatchHash)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([IO (PatchInfo, PatchHash)] -> IO [(PatchInfo, PatchHash)])
-> [IO (PatchInfo, PatchHash)] -> IO [(PatchInfo, PatchHash)]
forall a b. (a -> b) -> a -> b
$ (forall wW wZ.
 PatchInfoAnd rt p wW wZ -> IO (PatchInfo, PatchHash))
-> RL (PatchInfoAnd rt p) wX wX -> [IO (PatchInfo, PatchHash)]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL (Cache
-> Compression
-> PatchInfoAnd rt p wW wZ
-> IO (PatchInfo, PatchHash)
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
Cache
-> Compression
-> PatchInfoAnd rt p wX wY
-> IO (PatchInfo, PatchHash)
writePatchIfNecessary Cache
cache Compression
compr) RL (PatchInfoAnd rt p) wX wX
ps
        let inventorylist :: Doc
inventorylist = [(PatchInfo, PatchHash)] -> Doc
showInventoryPatches ([(PatchInfo, PatchHash)] -> [(PatchInfo, PatchHash)]
forall a. [a] -> [a]
reverse [(PatchInfo, PatchHash)]
inventory)
        String
hash <- Cache -> Compression -> HashedDir -> Doc -> IO String
writeHashFile Cache
cache Compression
compr HashedDir
HashedInventoriesDir Doc
inventorylist
        Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
hash
    writeInventoryPrivate
        (PatchSet xs :: RL (Tagged rt p) Origin wX
xs@(_ :<: Tagged t :: PatchInfoAnd rt p wY wX
t _ _) x :: RL (PatchInfoAnd rt p) wX wX
x) = do
        Maybe String
resthash <- RL (Tagged rt p) Origin wX -> IO (Maybe String)
forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
RL (Tagged rt p) Origin wX -> IO (Maybe String)
write_ts RL (Tagged rt p) Origin wX
xs
        String -> String -> IO ()
finishedOneIO String
tediousName (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "" Maybe String
resthash
        [(PatchInfo, PatchHash)]
inventory <- [IO (PatchInfo, PatchHash)] -> IO [(PatchInfo, PatchHash)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([IO (PatchInfo, PatchHash)] -> IO [(PatchInfo, PatchHash)])
-> [IO (PatchInfo, PatchHash)] -> IO [(PatchInfo, PatchHash)]
forall a b. (a -> b) -> a -> b
$ (forall wW wZ.
 PatchInfoAnd rt p wW wZ -> IO (PatchInfo, PatchHash))
-> RL (PatchInfoAnd rt p) wY wX -> [IO (PatchInfo, PatchHash)]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL (Cache
-> Compression
-> PatchInfoAnd rt p wW wZ
-> IO (PatchInfo, PatchHash)
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
Cache
-> Compression
-> PatchInfoAnd rt p wX wY
-> IO (PatchInfo, PatchHash)
writePatchIfNecessary Cache
cache Compression
compr)
                                    (RL (PatchInfoAnd rt p) wY wY
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL RL (PatchInfoAnd rt p) wY wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wX
t RL (PatchInfoAnd rt p) wY wX
-> RL (PatchInfoAnd rt p) wX wX -> RL (PatchInfoAnd rt p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> RL a wY wZ -> RL a wX wZ
+<+ RL (PatchInfoAnd rt p) wX wX
x)
        let inventorylist :: Doc
inventorylist = [Doc] -> Doc
hcat (((PatchInfo, PatchHash) -> Doc)
-> [(PatchInfo, PatchHash)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PatchInfo, PatchHash) -> Doc
showInventoryEntry ([(PatchInfo, PatchHash)] -> [Doc])
-> [(PatchInfo, PatchHash)] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [(PatchInfo, PatchHash)] -> [(PatchInfo, PatchHash)]
forall a. [a] -> [a]
reverse [(PatchInfo, PatchHash)]
inventory)
            inventorycontents :: Doc
inventorycontents =
                case Maybe String
resthash of
                    Just h :: String
h -> String -> Doc
text ("Starting with inventory:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
h) Doc -> Doc -> Doc
$$
                                  Doc
inventorylist
                    Nothing -> Doc
inventorylist
        String
hash <- Cache -> Compression -> HashedDir -> Doc -> IO String
writeHashFile Cache
cache Compression
compr HashedDir
HashedInventoriesDir Doc
inventorycontents
        Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
hash
      where
        -- | write_ts writes out a tagged patchset. If it has already been
        -- written, we'll have the hash, so we can immediately return it.
        write_ts :: RepoPatch p => RL (Tagged rt p) Origin wX
                 -> IO (Maybe String)
        write_ts :: RL (Tagged rt p) Origin wX -> IO (Maybe String)
write_ts (_ :<: Tagged _ (Just h :: String
h) _) = Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
h)
        write_ts (tts :: RL (Tagged rt p) Origin wY
tts :<: Tagged _ Nothing pps :: RL (PatchInfoAnd rt p) wY wY
pps) =
            PatchSet rt p Origin wY -> IO (Maybe String)
forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
PatchSet rt p Origin wX -> IO (Maybe String)
writeInventoryPrivate (PatchSet rt p Origin wY -> IO (Maybe String))
-> PatchSet rt p Origin wY -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wY -> PatchSet rt p Origin wY
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) Origin wY
tts RL (PatchInfoAnd rt p) wY wY
pps
        write_ts NilRL = Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing

-- |writeHashIfNecessary writes the patch and returns the resulting info/hash,
-- if it has not already been written. If it has been written, we have the hash
-- in the PatchInfoAnd, so we extract and return the info/hash.
writePatchIfNecessary :: RepoPatch p => Cache -> Compression
                      -> PatchInfoAnd rt p wX wY -> IO InventoryEntry
writePatchIfNecessary :: Cache
-> Compression
-> PatchInfoAnd rt p wX wY
-> IO (PatchInfo, PatchHash)
writePatchIfNecessary c :: Cache
c compr :: Compression
compr hp :: PatchInfoAnd rt p wX wY
hp = PatchInfo
infohp PatchInfo -> IO (PatchInfo, PatchHash) -> IO (PatchInfo, PatchHash)
forall a b. a -> b -> b
`seq`
    case PatchInfoAnd rt p wX wY -> Either (WrappedNamed rt p wX wY) String
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> Either (WrappedNamed rt p wA wB) String
extractHash PatchInfoAnd rt p wX wY
hp of
        Right h :: String
h -> (PatchInfo, PatchHash) -> IO (PatchInfo, PatchHash)
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchInfo
infohp, String -> PatchHash
forall a. ValidHash a => String -> a
mkValidHash String
h)
        Left p :: WrappedNamed rt p wX wY
p -> do
          String
h <- Cache -> Compression -> HashedDir -> Doc -> IO String
writeHashFile Cache
c Compression
compr HashedDir
HashedPatchesDir (ShowPatchFor -> WrappedNamed rt p wX wY -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForStorage WrappedNamed rt p wX wY
p)
          (PatchInfo, PatchHash) -> IO (PatchInfo, PatchHash)
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchInfo
infohp, String -> PatchHash
forall a. ValidHash a => String -> a
mkValidHash String
h)
  where
    infohp :: PatchInfo
infohp = PatchInfoAnd rt p wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wX wY
hp

-- |listInventoriesWith returns a list of the inventories hashes.
-- The first argument is to choose directory format.
-- The first argument can be readInventoryPrivate or readInventoryLocalPrivate.
-- The second argument specifies whether the files are expected
-- to be stored in plain or in bucketed format.
-- The third argument is the directory of the parent inventory files.
-- The fourth argument is the directory of the head inventory file.
listInventoriesWith
  :: (FilePath -> IO Inventory)
  -> DirLayout
  -> String -> String -> IO [String]
listInventoriesWith :: (String -> IO Inventory)
-> DirLayout -> String -> String -> IO [String]
listInventoriesWith readInv :: String -> IO Inventory
readInv dirformat :: DirLayout
dirformat baseDir :: String
baseDir startDir :: String
startDir = do
    Maybe InventoryHash
mbStartingWithInv <- String -> String -> IO (Maybe InventoryHash)
getStartingWithHash String
startDir String
hashedInventory
    Maybe InventoryHash -> IO [String]
followStartingWiths Maybe InventoryHash
mbStartingWithInv
  where
    getStartingWithHash :: String -> String -> IO (Maybe InventoryHash)
getStartingWithHash dir :: String
dir file :: String
file = Inventory -> Maybe InventoryHash
inventoryParent (Inventory -> Maybe InventoryHash)
-> IO Inventory -> IO (Maybe InventoryHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Inventory
readInv (String
dir String -> String -> String
</> String
file)

    invDir :: String
invDir = String
baseDir String -> String -> String
</> String
inventoriesDir
    nextDir :: String -> String
nextDir dir :: String
dir = case DirLayout
dirformat of
        BucketedLayout -> String
invDir String -> String -> String
</> String -> String
bucketFolder String
dir
        PlainLayout -> String
invDir

    followStartingWiths :: Maybe InventoryHash -> IO [String]
followStartingWiths Nothing = [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    followStartingWiths (Just hash :: InventoryHash
hash) = do
        let startingWith :: String
startingWith = InventoryHash -> String
forall a. ValidHash a => a -> String
getValidHash InventoryHash
hash
        Maybe InventoryHash
mbNextInv <- String -> String -> IO (Maybe InventoryHash)
getStartingWithHash (String -> String
nextDir String
startingWith) String
startingWith
        (String
startingWith String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InventoryHash -> IO [String]
followStartingWiths Maybe InventoryHash
mbNextInv

-- |listInventories returns a list of the inventories hashes.
-- This function attempts to retrieve missing inventory files.
listInventories :: IO [String]
listInventories :: IO [String]
listInventories =
    (String -> IO Inventory)
-> DirLayout -> String -> String -> IO [String]
listInventoriesWith String -> IO Inventory
readInventoryPrivate DirLayout
PlainLayout String
darcsdir String
darcsdir

-- | Read the given inventory file if it exist, otherwise return an empty
-- inventory. Used when we expect that some inventory files may be missing.
readInventoryLocalPrivate :: FilePath -> IO Inventory
readInventoryLocalPrivate :: String -> IO Inventory
readInventoryLocalPrivate path :: String
path = do
    Bool
b <- String -> IO Bool
doesFileExist String
path
    if Bool
b then String -> IO Inventory
readInventoryPrivate String
path
        else Inventory -> IO Inventory
forall (m :: * -> *) a. Monad m => a -> m a
return Inventory
emptyInventory

-- | Return inventories hashes by following the head inventory.
-- This function does not attempt to retrieve missing inventory files.
listInventoriesLocal :: IO [String]
listInventoriesLocal :: IO [String]
listInventoriesLocal =
    (String -> IO Inventory)
-> DirLayout -> String -> String -> IO [String]
listInventoriesWith String -> IO Inventory
readInventoryLocalPrivate DirLayout
PlainLayout String
darcsdir String
darcsdir

-- |listInventoriesRepoDir returns a list of the inventories hashes.
-- The argument @repoDir@ is the directory of the repository from which
-- we are going to read the head inventory file.
-- The rest of hashed files are read from the global cache.
listInventoriesRepoDir :: String -> IO [String]
listInventoriesRepoDir :: String -> IO [String]
listInventoriesRepoDir repoDir :: String
repoDir = do
    Maybe String
gCacheDir' <- IO (Maybe String)
globalCacheDir
    let gCacheInvDir :: String
gCacheInvDir = Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust Maybe String
gCacheDir'
    (String -> IO Inventory)
-> DirLayout -> String -> String -> IO [String]
listInventoriesWith
      String -> IO Inventory
readInventoryLocalPrivate DirLayout
BucketedLayout String
gCacheInvDir (String
repoDir String -> String -> String
</> String
darcsdir)

-- | Return a list of the patch filenames, extracted from inventory
-- files, by starting with the head inventory and then following the
-- chain of parent inventories.
--
-- This function does not attempt to download missing inventory files.
--
-- * The first argument specifies whether the files are expected
--   to be stored in plain or in bucketed format.
-- * The second argument is the directory of the parent inventory.
-- * The third argument is the directory of the head inventory.
listPatchesLocal :: DirLayout -> String -> String -> IO [String]
listPatchesLocal :: DirLayout -> String -> String -> IO [String]
listPatchesLocal dirformat :: DirLayout
dirformat baseDir :: String
baseDir startDir :: String
startDir = do
    Inventory
inventory <- String -> IO Inventory
readInventoryPrivate (String
startDir String -> String -> String
</> String
hashedInventory)
    Maybe InventoryHash -> [String] -> IO [String]
followStartingWiths (Inventory -> Maybe InventoryHash
inventoryParent Inventory
inventory) (Inventory -> [String]
inventoryPatchNames Inventory
inventory)
    where
        invDir :: String
invDir = String
baseDir String -> String -> String
</> String
inventoriesDir
        nextDir :: String -> String
nextDir dir :: String
dir = case DirLayout
dirformat of
            BucketedLayout -> String
invDir String -> String -> String
</> String -> String
bucketFolder String
dir
            PlainLayout -> String
invDir

        followStartingWiths :: Maybe InventoryHash -> [String] -> IO [String]
followStartingWiths Nothing patches :: [String]
patches = [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
patches
        followStartingWiths (Just hash :: InventoryHash
hash) patches :: [String]
patches = do
            let startingWith :: String
startingWith = InventoryHash -> String
forall a. ValidHash a => a -> String
getValidHash InventoryHash
hash
            Inventory
inv <- String -> IO Inventory
readInventoryLocalPrivate
                (String -> String
nextDir String
startingWith String -> String -> String
</> String
startingWith)
            ([String]
patches[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InventoryHash -> [String] -> IO [String]
followStartingWiths (Inventory -> Maybe InventoryHash
inventoryParent Inventory
inv) (Inventory -> [String]
inventoryPatchNames Inventory
inv)

-- |listPatchesLocalBucketed is similar to listPatchesLocal, but
-- it read the inventory directory under @darcsDir@ in bucketed format.
listPatchesLocalBucketed :: String -> String -> IO [String]
listPatchesLocalBucketed :: String -> String -> IO [String]
listPatchesLocalBucketed = DirLayout -> String -> String -> IO [String]
listPatchesLocal DirLayout
BucketedLayout

-- | copyPristine copies a pristine tree into the current pristine dir,
--   and possibly copies a clean working copy.
--   The target is read from the passed-in dir/inventory name combination.
copyPristine :: Cache -> String -> String -> WithWorkingDir -> IO ()
copyPristine :: Cache -> String -> String -> WithWorkingDir -> IO ()
copyPristine cache :: Cache
cache dir :: String
dir iname :: String
iname wwd :: WithWorkingDir
wwd = do
    ByteString
i <- String -> Cachable -> IO ByteString
fetchFilePS (String
dir String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
iname) Cachable
Uncachable
    String -> IO ()
debugMessage (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Copying hashed pristine tree: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
peekPristineHash ByteString
i
    let tediousName :: String
tediousName = "Copying pristine"
    String -> IO ()
beginTedious String
tediousName
    String -> Cache -> WithWorkingDir -> String -> IO ()
copyHashed String
tediousName Cache
cache WithWorkingDir
wwd (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> String
peekPristineHash ByteString
i
    String -> IO ()
endTedious String
tediousName

-- |copyPartialsPristine copies the pristine entries for a given list of
-- filepaths.
copyPartialsPristine :: FilePathLike fp => Cache -> String
                     -> String -> [fp] -> IO ()
copyPartialsPristine :: Cache -> String -> String -> [fp] -> IO ()
copyPartialsPristine c :: Cache
c d :: String
d iname :: String
iname fps :: [fp]
fps = do
    ByteString
i <- String -> Cachable -> IO ByteString
fetchFilePS (String
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
iname) Cachable
Uncachable
    Cache -> String -> [fp] -> IO ()
forall fp. FilePathLike fp => Cache -> String -> [fp] -> IO ()
copyPartialsHashed Cache
c (ByteString -> String
peekPristineHash ByteString
i) [fp]
fps

unrevertUrl :: Repository rt p wR wU wT -> String
unrevertUrl :: Repository rt p wR wU wT -> String
unrevertUrl r :: Repository rt p wR wU wT
r = Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
repoLocation Repository rt p wR wU wT
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
darcsdirString -> String -> String
forall a. [a] -> [a] -> [a]
++"/patches/unrevert"

tentativelyAddPatch :: (RepoPatch p, ApplyState p ~ Tree)
                    => Repository rt p wR wU wT
                    -> Compression
                    -> Verbosity
                    -> UpdateWorking
                    -> PatchInfoAnd rt p wT wY
                    -> IO (Repository rt p wR wU wY)
tentativelyAddPatch :: Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdateWorking
-> PatchInfoAnd rt p wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatch = UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdateWorking
-> PatchInfoAnd rt p wT wY
-> IO (Repository rt p wR wU wY)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(RepoPatch p, ApplyState p ~ Tree) =>
UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdateWorking
-> PatchInfoAnd rt p wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatch_ UpdatePristine
UpdatePristine

data UpdatePristine = UpdatePristine 
                    | DontUpdatePristine
                    | DontUpdatePristineNorRevert deriving UpdatePristine -> UpdatePristine -> Bool
(UpdatePristine -> UpdatePristine -> Bool)
-> (UpdatePristine -> UpdatePristine -> Bool) -> Eq UpdatePristine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePristine -> UpdatePristine -> Bool
$c/= :: UpdatePristine -> UpdatePristine -> Bool
== :: UpdatePristine -> UpdatePristine -> Bool
$c== :: UpdatePristine -> UpdatePristine -> Bool
Eq

tentativelyAddPatches_ :: (RepoPatch p, ApplyState p ~ Tree)
                       => UpdatePristine
                       -> Repository rt p wR wU wT
                       -> Compression
                       -> Verbosity
                       -> UpdateWorking
                       -> FL (PatchInfoAnd rt p) wT wY
                       -> IO (Repository rt p wR wU wY)
tentativelyAddPatches_ :: UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdateWorking
-> FL (PatchInfoAnd rt p) wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatches_ up :: UpdatePristine
up r :: Repository rt p wR wU wT
r c :: Compression
c v :: Verbosity
v uw :: UpdateWorking
uw ps :: FL (PatchInfoAnd rt p) wT wY
ps =
    (forall wA wB.
 Repository rt p wR wU wA
 -> PatchInfoAnd rt p wA wB -> IO (Repository rt p wR wU wB))
-> Repository rt p wR wU wT
-> FL (PatchInfoAnd rt p) wT wY
-> IO (Repository rt p wR wU wY)
forall (m :: * -> *) (r :: * -> *) (p :: * -> * -> *) wX wY.
Monad m =>
(forall wA wB. r wA -> p wA wB -> m (r wB))
-> r wX -> FL p wX wY -> m (r wY)
foldFL_M (\r' :: Repository rt p wR wU wA
r' p :: PatchInfoAnd rt p wA wB
p -> UpdatePristine
-> Repository rt p wR wU wA
-> Compression
-> Verbosity
-> UpdateWorking
-> PatchInfoAnd rt p wA wB
-> IO (Repository rt p wR wU wB)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(RepoPatch p, ApplyState p ~ Tree) =>
UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdateWorking
-> PatchInfoAnd rt p wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatch_ UpdatePristine
up Repository rt p wR wU wA
r' Compression
c Verbosity
v UpdateWorking
uw PatchInfoAnd rt p wA wB
p) Repository rt p wR wU wT
r FL (PatchInfoAnd rt p) wT wY
ps

-- TODO re-add a safety catch for --dry-run? Maybe using a global, like dryRun
-- :: Bool, with dryRun = unsafePerformIO $ readIORef ...
tentativelyAddPatch_ :: (RepoPatch p, ApplyState p ~ Tree)
                     => UpdatePristine
                     -> Repository rt p wR wU wT
                     -> Compression
                     -> Verbosity
                     -> UpdateWorking
                     -> PatchInfoAnd rt p wT wY
                     -> IO (Repository rt p wR wU wY)

tentativelyAddPatch_ :: UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdateWorking
-> PatchInfoAnd rt p wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatch_ up :: UpdatePristine
up r :: Repository rt p wR wU wT
r compr :: Compression
compr verb :: Verbosity
verb uw :: UpdateWorking
uw p :: PatchInfoAnd rt p wT wY
p =
    Repository rt p wR wU wT
-> IO (Repository rt p wR wU wY) -> IO (Repository rt p wR wU wY)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT a.
Repository rt p wR wU wT -> IO a -> IO a
withRepoLocation Repository rt p wR wU wT
r (IO (Repository rt p wR wU wY) -> IO (Repository rt p wR wU wY))
-> IO (Repository rt p wR wU wY) -> IO (Repository rt p wR wU wY)
forall a b. (a -> b) -> a -> b
$ do
       IO String -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO String -> IO ()) -> IO String -> IO ()
forall a b. (a -> b) -> a -> b
$ Cache -> Compression -> PatchInfoAnd rt p wT wY -> IO String
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
Cache -> Compression -> PatchInfoAnd rt p wX wY -> IO String
addToTentativeInventory (Repository rt p wR wU wT -> Cache
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p wR wU wT
r) Compression
compr PatchInfoAnd rt p wT wY
p
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UpdatePristine
up UpdatePristine -> UpdatePristine -> Bool
forall a. Eq a => a -> a -> Bool
== UpdatePristine
UpdatePristine) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do String -> IO ()
debugMessage "Applying to pristine cache..."
                                        Repository rt p wR wU wT
-> Verbosity -> PatchInfoAnd rt p wT wY -> IO ()
forall (q :: * -> * -> *) (rt :: RepoType) (p :: * -> * -> *) wR wU
       wT wY.
(ApplyState q ~ Tree, Apply q, ShowPatch q) =>
Repository rt p wR wU wT -> Verbosity -> q wT wY -> IO ()
applyToTentativePristine Repository rt p wR wU wT
r Verbosity
verb PatchInfoAnd rt p wT wY
p
                                        String -> IO ()
debugMessage "Updating pending..."
                                        Repository rt p wR wU wT
-> UpdateWorking -> PatchInfoAnd rt p wT wY -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX wY.
RepoPatch p =>
Repository rt p wR wU wT
-> UpdateWorking -> PatchInfoAnd rt p wX wY -> IO ()
tentativelyRemoveFromPending Repository rt p wR wU wT
r UpdateWorking
uw PatchInfoAnd rt p wT wY
p
       Repository rt p wR wU wY -> IO (Repository rt p wR wU wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (Repository rt p wR wU wT -> Repository rt p wR wU wY
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wT'.
Repository rt p wR wU wT -> Repository rt p wR wU wT'
coerceT Repository rt p wR wU wT
r)


-- |applyToTentativePristine applies a patch @p@ to the tentative pristine
-- tree, and updates the tentative pristine hash
applyToTentativePristine :: (ApplyState q ~ Tree, Apply q, ShowPatch q)
                         => Repository rt p wR wU wT
                         -> Verbosity
                         -> q wT wY
                         -> IO ()
applyToTentativePristine :: Repository rt p wR wU wT -> Verbosity -> q wT wY -> IO ()
applyToTentativePristine r :: Repository rt p wR wU wT
r verb :: Verbosity
verb p :: q wT wY
p =
    Repository rt p wR wU wT -> IO () -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT a.
Repository rt p wR wU wT -> IO a -> IO a
withRepoLocation Repository rt p wR wU wT
r (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    do Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verb Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
Verbose) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> IO ()
putDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "Applying to pristine..." Doc -> Doc -> Doc
<+> q wT wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
description q wT wY
p
       q wT wY -> IO ()
forall (p :: * -> * -> *) wX wY.
(ApplyState p ~ Tree, Apply p) =>
p wX wY -> IO ()
applyToTentativePristineCwd q wT wY
p

applyToTentativePristineCwd :: (ApplyState p ~ Tree, Apply p) => p wX wY
                            -> IO ()
applyToTentativePristineCwd :: p wX wY -> IO ()
applyToTentativePristineCwd p :: p wX wY
p = do
    ByteString
tentativePristine <- String -> IO ByteString
gzReadFilePS String
tentativePristinePath
    -- Extract the pristine hash from the tentativePristine file, using
    -- peekPristineHash (this is valid since we normally just extract the hash from the
    -- first line of an inventory file; we can pass in a one-line file that
    -- just contains said hash).
    let tentativePristineHash :: String
tentativePristineHash = ByteString -> String
peekPristineHash ByteString
tentativePristine
    String
newPristineHash <- String -> p wX wY -> IO String
forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
String -> p wX wY -> IO String
applyToHashedPristine String
tentativePristineHash p wX wY
p
    String -> Doc -> IO ()
forall p. FilePathLike p => p -> Doc -> IO ()
writeDocBinFile String
tentativePristinePath (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> ByteString -> Doc
pokePristineHash String
newPristineHash ByteString
tentativePristine

tentativelyRemovePatches :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
                         => Repository rt p wR wU wT
                         -> Compression
                         -> UpdateWorking
                         -> FL (PatchInfoAnd rt p) wX wT
                         -> IO (Repository rt p wR wU wX)
tentativelyRemovePatches :: Repository rt p wR wU wT
-> Compression
-> UpdateWorking
-> FL (PatchInfoAnd rt p) wX wT
-> IO (Repository rt p wR wU wX)
tentativelyRemovePatches = UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> UpdateWorking
-> FL (PatchInfoAnd rt p) wX wT
-> IO (Repository rt p wR wU wX)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> UpdateWorking
-> FL (PatchInfoAnd rt p) wX wT
-> IO (Repository rt p wR wU wX)
tentativelyRemovePatches_ UpdatePristine
UpdatePristine

tentativelyRemovePatches_ :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
                          => UpdatePristine
                          -> Repository rt p wR wU wT
                          -> Compression
                          -> UpdateWorking
                          -> FL (PatchInfoAnd rt p) wX wT
                          -> IO (Repository rt p wR wU wX)
tentativelyRemovePatches_ :: UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> UpdateWorking
-> FL (PatchInfoAnd rt p) wX wT
-> IO (Repository rt p wR wU wX)
tentativelyRemovePatches_ up :: UpdatePristine
up r :: Repository rt p wR wU wT
r compr :: Compression
compr uw :: UpdateWorking
uw ps :: FL (PatchInfoAnd rt p) wX wT
ps =
    Repository rt p wR wU wT
-> IO (Repository rt p wR wU wX) -> IO (Repository rt p wR wU wX)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT a.
Repository rt p wR wU wT -> IO a -> IO a
withRepoLocation Repository rt p wR wU wT
r (IO (Repository rt p wR wU wX) -> IO (Repository rt p wR wU wX))
-> IO (Repository rt p wR wU wX) -> IO (Repository rt p wR wU wX)
forall a b. (a -> b) -> a -> b
$ do
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UpdatePristine
up UpdatePristine -> UpdatePristine -> Bool
forall a. Eq a => a -> a -> Bool
== UpdatePristine
UpdatePristine) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do String -> IO ()
debugMessage "Adding changes to pending..."
                                       Repository rt p wR wU wT
-> UpdateWorking -> FL (PrimOf p) wX wT -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX wY.
RepoPatch p =>
Repository rt p wR wU wT
-> UpdateWorking -> FL (PrimOf p) wX wY -> IO ()
prepend Repository rt p wR wU wT
r UpdateWorking
uw (FL (PrimOf p) wX wT -> IO ()) -> FL (PrimOf p) wX wT -> IO ()
forall a b. (a -> b) -> a -> b
$ FL (PatchInfoAnd rt p) wX wT
-> FL (PrimOf (FL (PatchInfoAnd rt p))) wX wT
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect FL (PatchInfoAnd rt p) wX wT
ps
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (UpdatePristine
up UpdatePristine -> UpdatePristine -> Bool
forall a. Eq a => a -> a -> Bool
== UpdatePristine
DontUpdatePristineNorRevert) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Repository rt p wR wU wT -> FL (PatchInfoAnd rt p) wX wT -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> FL (PatchInfoAnd rt p) wX wT -> IO ()
removeFromUnrevertContext Repository rt p wR wU wT
r FL (PatchInfoAnd rt p) wX wT
ps
      String -> IO ()
debugMessage "Removing changes from tentative inventory..."
      if RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
HashedInventory (Repository rt p wR wU wT -> RepoFormat
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository rt p wR wU wT
r)
        then do Repository rt p wR wU wT
-> Compression -> FL (PatchInfoAnd rt p) wX wT -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT
-> Compression -> FL (PatchInfoAnd rt p) wX wT -> IO ()
removeFromTentativeInventory Repository rt p wR wU wT
r Compression
compr FL (PatchInfoAnd rt p) wX wT
ps
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UpdatePristine
up UpdatePristine -> UpdatePristine -> Bool
forall a. Eq a => a -> a -> Bool
== UpdatePristine
UpdatePristine) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                     FL (PatchInfoAnd rt p) wT wX -> IO ()
forall (p :: * -> * -> *) wX wY.
(ApplyState p ~ Tree, Apply p) =>
p wX wY -> IO ()
applyToTentativePristineCwd (FL (PatchInfoAnd rt p) wT wX -> IO ())
-> FL (PatchInfoAnd rt p) wT wX -> IO ()
forall a b. (a -> b) -> a -> b
$
                     String
-> FL (PatchInfoAnd rt p) wT wX -> FL (PatchInfoAnd rt p) wT wX
forall (a :: * -> * -> *) wX wY. String -> FL a wX wY -> FL a wX wY
progressFL "Applying inverse to pristine" (FL (PatchInfoAnd rt p) wT wX -> FL (PatchInfoAnd rt p) wT wX)
-> FL (PatchInfoAnd rt p) wT wX -> FL (PatchInfoAnd rt p) wT wX
forall a b. (a -> b) -> a -> b
$ FL (PatchInfoAnd rt p) wX wT -> FL (PatchInfoAnd rt p) wT wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FL (PatchInfoAnd rt p) wX wT
ps
        else String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
Old.oldRepoFailMsg
      Repository rt p wR wU wX -> IO (Repository rt p wR wU wX)
forall (m :: * -> *) a. Monad m => a -> m a
return (Repository rt p wR wU wT -> Repository rt p wR wU wX
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wT'.
Repository rt p wR wU wT -> Repository rt p wR wU wT'
coerceT Repository rt p wR wU wT
r)

-- FIXME this is a rather weird API. If called with a patch that isn't already
-- in the repo, it fails with an obscure error from 'commuteToEnd'. It also
-- ends up redoing the work that the caller has already done - if it has
-- already commuted these patches to the end, it must also know the commuted
-- versions of the other patches in the repo.
-- |Given a sequence of patches anchored at the end of the current repository,
-- actually pull them to the end of the repository by removing any patches
-- with the same name and then adding the passed in sequence.
-- Typically callers will have obtained the passed in sequence using
-- 'findCommon' and friends.
tentativelyReplacePatches :: forall rt p wR wU wT wX
                           . (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
                          => Repository rt p wR wU wT
                          -> Compression
                          -> UpdateWorking
                          -> Verbosity
                          -> FL (PatchInfoAnd rt p) wX wT
                          -> IO ()
tentativelyReplacePatches :: Repository rt p wR wU wT
-> Compression
-> UpdateWorking
-> Verbosity
-> FL (PatchInfoAnd rt p) wX wT
-> IO ()
tentativelyReplacePatches repository :: Repository rt p wR wU wT
repository compr :: Compression
compr uw :: UpdateWorking
uw verb :: Verbosity
verb ps :: FL (PatchInfoAnd rt p) wX wT
ps =
    do let ps' :: FL (PatchInfoAnd rt p) wX wT
ps' = (forall wX wY. PatchInfoAnd rt p wX wY -> EqCheck wX wY)
-> FL (PatchInfoAnd rt p) wX wT -> FL (PatchInfoAnd rt p) wX wT
forall (p :: * -> * -> *) wW wZ.
(forall wX wY. p wX wY -> EqCheck wX wY)
-> FL p wW wZ -> FL p wW wZ
filterOutFLFL (WrappedNamed rt p wX wY -> EqCheck wX wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
IsRepoType rt =>
WrappedNamed rt p wX wY -> EqCheck wX wY
namedIsInternal (WrappedNamed rt p wX wY -> EqCheck wX wY)
-> (PatchInfoAnd rt p wX wY -> WrappedNamed rt p wX wY)
-> PatchInfoAnd rt p wX wY
-> EqCheck wX wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAnd rt p wX wY -> WrappedNamed rt p wX wY
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> WrappedNamed rt p wA wB
hopefully) FL (PatchInfoAnd rt p) wX wT
ps
       Repository rt p wR wU wX
repository' <- UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> UpdateWorking
-> FL (PatchInfoAnd rt p) wX wT
-> IO (Repository rt p wR wU wX)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> UpdateWorking
-> FL (PatchInfoAnd rt p) wX wT
-> IO (Repository rt p wR wU wX)
tentativelyRemovePatches_ UpdatePristine
DontUpdatePristineNorRevert Repository rt p wR wU wT
repository Compression
compr UpdateWorking
uw FL (PatchInfoAnd rt p) wX wT
ps'
       Repository rt p wR wU wX -> FL (PatchInfoAnd rt p) wX wT -> IO ()
forall wM wL wI wJ.
Repository rt p wM wL wI -> FL (PatchInfoAnd rt p) wI wJ -> IO ()
mapAdd Repository rt p wR wU wX
repository' FL (PatchInfoAnd rt p) wX wT
ps'
  where mapAdd :: Repository rt p wM wL wI
               -> FL (PatchInfoAnd rt p) wI wJ
               -> IO ()
        mapAdd :: Repository rt p wM wL wI -> FL (PatchInfoAnd rt p) wI wJ -> IO ()
mapAdd _ NilFL = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        mapAdd r :: Repository rt p wM wL wI
r (a :: PatchInfoAnd rt p wI wY
a:>:as :: FL (PatchInfoAnd rt p) wY wJ
as) =
               do Repository rt p wM wL wY
r' <- UpdatePristine
-> Repository rt p wM wL wI
-> Compression
-> Verbosity
-> UpdateWorking
-> PatchInfoAnd rt p wI wY
-> IO (Repository rt p wM wL wY)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(RepoPatch p, ApplyState p ~ Tree) =>
UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdateWorking
-> PatchInfoAnd rt p wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatch_ UpdatePristine
DontUpdatePristine Repository rt p wM wL wI
r Compression
compr Verbosity
verb UpdateWorking
uw PatchInfoAnd rt p wI wY
a
                  Repository rt p wM wL wY -> FL (PatchInfoAnd rt p) wY wJ -> IO ()
forall wM wL wI wJ.
Repository rt p wM wL wI -> FL (PatchInfoAnd rt p) wI wJ -> IO ()
mapAdd Repository rt p wM wL wY
r' FL (PatchInfoAnd rt p) wY wJ
as

-- The type here should rather be
--  ... -> Repo rt p wR wU wT -> IO (Repo rt p wT wU wT)
-- In other words: we set the recorded state to the tentative state.
finalizeRepositoryChanges :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
                          => Repository rt p wR wU wT
                          -> UpdateWorking
                          -> Compression
                          -> IO ()
finalizeRepositoryChanges :: Repository rt p wR wU wT -> UpdateWorking -> Compression -> IO ()
finalizeRepositoryChanges r :: Repository rt p wR wU wT
r updateWorking :: UpdateWorking
updateWorking compr :: Compression
compr
    | RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
HashedInventory (Repository rt p wR wU wT -> RepoFormat
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository rt p wR wU wT
r) =
        Repository rt p wR wU wT -> IO () -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT a.
Repository rt p wR wU wT -> IO a -> IO a
withRepoLocation Repository rt p wR wU wT
r (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            String -> IO ()
debugMessage "Finalizing changes..."
            IO () -> IO ()
forall a. IO a -> IO a
withSignalsBlocked (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                 Repository rt p wR wU wT -> Compression -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> Compression -> IO ()
finalizeTentativeChanges Repository rt p wR wU wT
r Compression
compr
                 Tree IO
recordedState <- Repository rt p wR wU wT -> IO (Tree IO)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO (Tree IO)
readRecorded Repository rt p wR wU wT
r
                 Repository rt p wR wU wT -> UpdateWorking -> Tree IO -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> UpdateWorking -> Tree IO -> IO ()
finalizePending Repository rt p wR wU wT
r UpdateWorking
updateWorking Tree IO
recordedState
            String -> IO ()
debugMessage "Done finalizing changes..."
            PatchSet rt p Origin wR
ps <- 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
r
            String -> IO Bool
doesPatchIndexExist (Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
repoLocation Repository rt p wR wU wT
r) IO Bool -> (Bool -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
createOrUpdatePatchIndexDisk Repository rt p wR wU wT
r PatchSet rt p Origin wR
ps)
            Repository rt p wR wU wT -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> IO ()
updateIndex Repository rt p wR wU wT
r
    | Bool
otherwise = String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
Old.oldRepoFailMsg

-- TODO: rename this and document the transaction protocol (revert/finalize)
-- clearly.
-- |Slightly confusingly named: as well as throwing away any tentative
-- changes, revertRepositoryChanges also re-initialises the tentative state.
-- It's therefore used before makign any changes to the repo.
-- So the type should rather be
--
-- > ... -> Repo rt p wR wU wT -> IO (Repo rt p wR wU wR)
revertRepositoryChanges :: RepoPatch p
                        => Repository rt p wR wU wT
                        -> UpdateWorking
                        -> IO ()
revertRepositoryChanges :: Repository rt p wR wU wT -> UpdateWorking -> IO ()
revertRepositoryChanges r :: Repository rt p wR wU wT
r uw :: UpdateWorking
uw
 | RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
HashedInventory (Repository rt p wR wU wT -> RepoFormat
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository rt p wR wU wT
r) =
    Repository rt p wR wU wT -> IO () -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT a.
Repository rt p wR wU wT -> IO a -> IO a
withRepoLocation Repository rt p wR wU wT
r (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    do String -> IO ()
forall p. FilePathLike p => p -> IO ()
removeFileMayNotExist (String
pendingName String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".tentative")
       Sealed x :: FL (PrimOf p) wT wX
x <- Repository rt p wR wU wT -> IO (Sealed (FL (PrimOf p) wT))
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> IO (Sealed (FL (PrimOf p) wT))
readPending Repository rt p wR wU wT
r
       Repository rt p wR wU wT
-> UpdateWorking -> FL (PrimOf p) wT wX -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX wY.
RepoPatch p =>
Repository rt p wR wU wT
-> UpdateWorking -> FL (PrimOf p) wX wY -> IO ()
setTentativePending Repository rt p wR wU wT
r UpdateWorking
uw FL (PrimOf p) wT wX
x
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UpdateWorking
uw UpdateWorking -> UpdateWorking -> Bool
forall a. Eq a => a -> a -> Bool
== UpdateWorking
NoUpdateWorking) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall p. FilePathLike p => p -> IO ()
removeFileMayNotExist String
pendingName
       IO ()
revertTentativeChanges
 | Bool
otherwise = String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
Old.oldRepoFailMsg

removeFromUnrevertContext :: forall rt p wR wU wT wX
                           . (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
                          => Repository rt p wR wU wT
                          -> FL (PatchInfoAnd rt p) wX wT
                          -> IO ()
removeFromUnrevertContext :: Repository rt p wR wU wT -> FL (PatchInfoAnd rt p) wX wT -> IO ()
removeFromUnrevertContext r :: Repository rt p wR wU wT
r ps :: FL (PatchInfoAnd rt p) wX wT
ps = do
  Sealed bundle :: PatchSet rt p Origin wX
bundle <- IO (Sealed (PatchSet rt p Origin))
unrevert_patch_bundle IO (Sealed (PatchSet rt p Origin))
-> IO (Sealed (PatchSet rt p Origin))
-> IO (Sealed (PatchSet rt p Origin))
forall a. IO a -> IO a -> IO a
`catchall` Sealed (PatchSet rt p Origin) -> IO (Sealed (PatchSet rt p Origin))
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchSet rt p Origin Origin -> Sealed (PatchSet rt p Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (RL (Tagged rt p) Origin Origin
-> RL (PatchInfoAnd rt p) Origin Origin
-> PatchSet rt p Origin Origin
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) Origin Origin
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL RL (PatchInfoAnd rt p) Origin Origin
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL))
  PatchSet rt p Origin wX -> IO ()
forall wZ. PatchSet rt p Origin wZ -> IO ()
remove_from_unrevert_context_ PatchSet rt p Origin wX
bundle
  where unrevert_impossible :: IO ()
unrevert_impossible =
            do Bool
confirmed <- String -> IO Bool
promptYorn "This operation will make unrevert impossible!\nProceed?"
               if Bool
confirmed then String -> IO ()
forall p. FilePathLike p => p -> IO ()
removeFileMayNotExist (Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
unrevertUrl Repository rt p wR wU wT
r)
                            else String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Cancelled."
        unrevert_patch_bundle :: IO (SealedPatchSet rt p Origin)
        unrevert_patch_bundle :: IO (Sealed (PatchSet rt p Origin))
unrevert_patch_bundle = do ByteString
pf <- String -> IO ByteString
B.readFile (Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
unrevertUrl Repository rt p wR wU wT
r)
                                   case ByteString -> Either String (Sealed (PatchSet rt p Origin))
forall (rt :: RepoType) (p :: * -> * -> *).
RepoPatch p =>
ByteString -> Either String (SealedPatchSet rt p Origin)
scanBundle ByteString
pf of
                                     Right foo :: Sealed (PatchSet rt p Origin)
foo -> Sealed (PatchSet rt p Origin) -> IO (Sealed (PatchSet rt p Origin))
forall (m :: * -> *) a. Monad m => a -> m a
return Sealed (PatchSet rt p Origin)
foo
                                     Left err :: String
err -> String -> IO (Sealed (PatchSet rt p Origin))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO (Sealed (PatchSet rt p Origin)))
-> String -> IO (Sealed (PatchSet rt p Origin))
forall a b. (a -> b) -> a -> b
$ "Couldn't parse unrevert patch:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
        remove_from_unrevert_context_ :: PatchSet rt p Origin wZ -> IO ()
        remove_from_unrevert_context_ :: PatchSet rt p Origin wZ -> IO ()
remove_from_unrevert_context_ (PatchSet NilRL NilRL) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        remove_from_unrevert_context_ bundle :: PatchSet rt p Origin wZ
bundle =
         do String -> IO ()
debugMessage "Adjusting the context of the unrevert changes..."
            String -> IO ()
debugMessage (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Removing "String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (FL (PatchInfoAnd rt p) wX wT -> Int
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL (PatchInfoAnd rt p) wX wT
ps) String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                  " patches in removeFromUnrevertContext!"
            PatchSet rt p Origin wT
ref <- Repository rt p wR wU wT -> String -> IO (PatchSet rt p Origin wT)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> String -> IO (PatchSet rt p Origin wT)
readTentativeRepo Repository rt p wR wU wT
r (Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
repoLocation Repository rt p wR wU wT
r)
            let withSinglet :: Sealed (FL ppp wXxx)
                            -> (forall wYyy . ppp wXxx wYyy -> IO ()) -> IO ()
                withSinglet :: Sealed (FL ppp wXxx)
-> (forall wYyy. ppp wXxx wYyy -> IO ()) -> IO ()
withSinglet (Sealed (x :: ppp wXxx wY
x :>: NilFL)) j :: forall wYyy. ppp wXxx wYyy -> IO ()
j = ppp wXxx wY -> IO ()
forall wYyy. ppp wXxx wYyy -> IO ()
j ppp wXxx wY
x
                withSinglet _ _ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Sealed (FL (PatchInfoAnd rt p) wT)
-> (forall wYyy. PatchInfoAnd rt p wT wYyy -> IO ()) -> IO ()
forall (ppp :: * -> * -> *) wXxx.
Sealed (FL ppp wXxx)
-> (forall wYyy. ppp wXxx wYyy -> IO ()) -> IO ()
withSinglet (PatchSet rt p Origin wT
-> PatchSet rt p Origin wZ -> Sealed (FL (PatchInfoAnd rt p) wT)
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX wY.
Merge p =>
PatchSet rt p wStart wX
-> PatchSet rt p wStart wY -> Sealed (FL (PatchInfoAnd rt p) wX)
mergeThem PatchSet rt p Origin wT
ref PatchSet rt p Origin wZ
bundle) ((forall wYyy. PatchInfoAnd rt p wT wYyy -> IO ()) -> IO ())
-> (forall wYyy. PatchInfoAnd rt p wT wYyy -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \h_us :: PatchInfoAnd rt p wT wYyy
h_us ->
                  case (:>) (RL (PatchInfoAnd rt p)) (PatchInfoAnd rt p) wX wYyy
-> Maybe
     ((:>) (PatchInfoAnd rt p) (RL (PatchInfoAnd rt p)) wX wYyy)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) (RL p) p wX wY -> Maybe ((:>) p (RL p) wX wY)
commuteRL (FL (PatchInfoAnd rt p) wX wT -> RL (PatchInfoAnd rt p) wX wT
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL (PatchInfoAnd rt p) wX wT
ps RL (PatchInfoAnd rt p) wX wT
-> PatchInfoAnd rt p wT wYyy
-> (:>) (RL (PatchInfoAnd rt p)) (PatchInfoAnd rt p) wX wYyy
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> PatchInfoAnd rt p wT wYyy
h_us) of
                    Nothing -> IO ()
unrevert_impossible
                    Just (us' :: PatchInfoAnd rt p wX wZ
us' :> _) ->
                      case FL (PatchInfoAnd rt p) wX wT
-> PatchSet rt p Origin wT -> Maybe (PatchSet rt p Origin wX)
forall (p :: * -> * -> *) (rt :: RepoType) wX wY wStart.
Commute p =>
FL (PatchInfoAnd rt p) wX wY
-> PatchSet rt p wStart wY -> Maybe (PatchSet rt p wStart wX)
removeFromPatchSet FL (PatchInfoAnd rt p) wX wT
ps PatchSet rt p Origin wT
ref of
                      Nothing -> IO ()
unrevert_impossible
                      Just common :: PatchSet rt p Origin wX
common ->
                          do String -> IO ()
debugMessage "Have now found the new context..."
                             Doc
bundle' <- Maybe (Tree IO)
-> PatchSet rt p Origin wX
-> FL (WrappedNamed rt p) wX wZ
-> IO Doc
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Maybe (Tree IO)
-> PatchSet rt p wStart wX
-> FL (WrappedNamed rt p) wX wY
-> IO Doc
makeBundleN Maybe (Tree IO)
forall a. Maybe a
Nothing PatchSet rt p Origin wX
common (PatchInfoAnd rt p wX wZ -> WrappedNamed rt p wX wZ
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> WrappedNamed rt p wA wB
hopefully PatchInfoAnd rt p wX wZ
us'WrappedNamed rt p wX wZ
-> FL (WrappedNamed rt p) wZ wZ -> FL (WrappedNamed rt p) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:FL (WrappedNamed rt p) wZ wZ
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
                             String -> Doc -> IO ()
forall p. FilePathLike p => p -> Doc -> IO ()
writeDocBinFile (Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
unrevertUrl Repository rt p wR wU wT
r) Doc
bundle'
            String -> IO ()
debugMessage "Done adjusting the context of the unrevert changes!"

cleanRepository :: Repository rt p wR wU wT -> IO ()
cleanRepository :: Repository rt p wR wU wT -> IO ()
cleanRepository r :: Repository rt p wR wU wT
r = Repository rt p wR wU wT -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO ()
cleanPristine Repository rt p wR wU wT
r IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Repository rt p wR wU wT -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO ()
cleanInventories Repository rt p wR wU wT
r IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Repository rt p wR wU wT -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO ()
cleanPatches Repository rt p wR wU wT
r

-- | grab the pristine hash of _darcs/hash_inventory, and retrieve whole pristine tree,
--   possibly writing a clean working copy in the process.
createPristineDirectoryTree :: Repository rt p wR wU wT -> FilePath -> WithWorkingDir -> IO ()
createPristineDirectoryTree :: Repository rt p wR wU wT -> String -> WithWorkingDir -> IO ()
createPristineDirectoryTree r :: Repository rt p wR wU wT
r reldir :: String
reldir wwd :: WithWorkingDir
wwd
    | RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
HashedInventory (Repository rt p wR wU wT -> RepoFormat
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository rt p wR wU wT
r) =
        do Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
reldir
           String -> IO () -> IO ()
forall p a. FilePathLike p => p -> IO a -> IO a
withCurrentDirectory String
reldir (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
              Cache -> String -> String -> WithWorkingDir -> IO ()
copyPristine (Repository rt p wR wU wT -> Cache
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p wR wU wT
r) (Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
repoLocation Repository rt p wR wU wT
r) String
hashedInventoryPath WithWorkingDir
wwd
    | Bool
otherwise = String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
Old.oldRepoFailMsg

-- fp below really should be FileName
-- | Used by the commands dist and diff
createPartialsPristineDirectoryTree :: (FilePathLike fp)
                                    => Repository rt p wR wU wT
                                    -> [fp]
                                    -> FilePath
                                    -> IO ()
createPartialsPristineDirectoryTree :: Repository rt p wR wU wT -> [fp] -> String -> IO ()
createPartialsPristineDirectoryTree r :: Repository rt p wR wU wT
r prefs :: [fp]
prefs dir :: String
dir
    | RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
HashedInventory (Repository rt p wR wU wT -> RepoFormat
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository rt p wR wU wT
r) =
        do Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
dir
           String -> IO () -> IO ()
forall p a. FilePathLike p => p -> IO a -> IO a
withCurrentDirectory String
dir (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            Cache -> String -> String -> [fp] -> IO ()
forall fp.
FilePathLike fp =>
Cache -> String -> String -> [fp] -> IO ()
copyPartialsPristine (Repository rt p wR wU wT -> Cache
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p wR wU wT
r) (Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
repoLocation Repository rt p wR wU wT
r)
              String
hashedInventoryPath [fp]
prefs
    | Bool
otherwise = String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
Old.oldRepoFailMsg

withRecorded :: Repository rt p wR wU wT
             -> ((AbsolutePath -> IO a) -> IO a)
             -> (AbsolutePath -> IO a)
             -> IO a
withRecorded :: Repository rt p wR wU wT
-> ((AbsolutePath -> IO a) -> IO a)
-> (AbsolutePath -> IO a)
-> IO a
withRecorded repository :: Repository rt p wR wU wT
repository mk_dir :: (AbsolutePath -> IO a) -> IO a
mk_dir f :: AbsolutePath -> IO a
f
    = (AbsolutePath -> IO a) -> IO a
mk_dir ((AbsolutePath -> IO a) -> IO a) -> (AbsolutePath -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \d :: AbsolutePath
d -> do Repository rt p wR wU wT -> String -> WithWorkingDir -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String -> WithWorkingDir -> IO ()
createPristineDirectoryTree Repository rt p wR wU wT
repository (AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath AbsolutePath
d) WithWorkingDir
WithWorkingDir
                        AbsolutePath -> IO a
f AbsolutePath
d

withTentative :: forall rt p a wR wU wT.
                 Repository rt p wR wU wT
              -> ((AbsolutePath -> IO a) -> IO a)
              -> (AbsolutePath -> IO a)
              -> IO a
withTentative :: Repository rt p wR wU wT
-> ((AbsolutePath -> IO a) -> IO a)
-> (AbsolutePath -> IO a)
-> IO a
withTentative r :: Repository rt p wR wU wT
r mk_dir :: (AbsolutePath -> IO a) -> IO a
mk_dir f :: AbsolutePath -> IO a
f
    | RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
HashedInventory (Repository rt p wR wU wT -> RepoFormat
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository rt p wR wU wT
r) =
        (AbsolutePath -> IO a) -> IO a
mk_dir ((AbsolutePath -> IO a) -> IO a) -> (AbsolutePath -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \d :: AbsolutePath
d -> do Cache -> String -> String -> WithWorkingDir -> IO ()
copyPristine
                              (Repository rt p wR wU wT -> Cache
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p wR wU wT
r)
                              (Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
repoLocation Repository rt p wR wU wT
r)
                              (String
darcsdirString -> String -> String
forall a. [a] -> [a] -> [a]
++"/tentative_pristine")
                              WithWorkingDir
WithWorkingDir
                          AbsolutePath -> IO a
f AbsolutePath
d
    | Bool
otherwise = String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
Old.oldRepoFailMsg

-- | Writes out a fresh copy of the inventory that minimizes the
-- amount of inventory that need be downloaded when people pull from
-- the repository.
--
-- Specifically, it breaks up the inventory on the most recent tag.
-- This speeds up most commands when run remotely, both because a
-- smaller file needs to be transfered (only the most recent
-- inventory).  It also gives a guarantee that all the patches prior
-- to a given tag are included in that tag, so less commutation and
-- history traversal is needed.  This latter issue can become very
-- important in large repositories.
reorderInventory :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
                 => Repository rt p wR wU wR
                 -> Compression
                 -> UpdateWorking
                 -> Verbosity
                 -> IO ()
reorderInventory :: Repository rt p wR wU wR
-> Compression -> UpdateWorking -> Verbosity -> IO ()
reorderInventory repository :: Repository rt p wR wU wR
repository compr :: Compression
compr uw :: UpdateWorking
uw verb :: Verbosity
verb = do
        String -> IO ()
debugMessage "Reordering the inventory."
        PatchSet _ ps :: RL (PatchInfoAnd rt p) wX wR
ps <- PatchSet rt p Origin wR -> PatchSet rt p Origin wR
forall (rt :: RepoType) (p :: * -> * -> *) wS wX.
RepoPatch p =>
PatchSet rt p wS wX -> PatchSet rt p wS wX
misplacedPatches (PatchSet rt p Origin wR -> PatchSet rt p Origin wR)
-> IO (PatchSet rt p Origin wR) -> IO (PatchSet rt p Origin wR)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Repository rt p wR wU wR -> 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 wR
repository
        Repository rt p wR wU wR
-> Compression
-> UpdateWorking
-> Verbosity
-> FL (PatchInfoAnd rt p) wX wR
-> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> Compression
-> UpdateWorking
-> Verbosity
-> FL (PatchInfoAnd rt p) wX wT
-> IO ()
tentativelyReplacePatches Repository rt p wR wU wR
repository Compression
compr UpdateWorking
uw Verbosity
verb (FL (PatchInfoAnd rt p) wX wR -> IO ())
-> FL (PatchInfoAnd rt p) wX wR -> IO ()
forall a b. (a -> b) -> a -> b
$ RL (PatchInfoAnd rt p) wX wR -> FL (PatchInfoAnd rt p) wX wR
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL (PatchInfoAnd rt p) wX wR
ps
        Repository rt p wR wU wR -> Compression -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> Compression -> IO ()
finalizeTentativeChanges Repository rt p wR wU wR
repository Compression
compr
        String -> IO ()
debugMessage "Done reordering the inventory."

-- | Returns the patches that make the most recent tag dirty.
misplacedPatches :: forall rt p wS wX . RepoPatch p
                 => PatchSet rt p wS wX
                 -> PatchSet rt p wS wX
misplacedPatches :: PatchSet rt p wS wX -> PatchSet rt p wS wX
misplacedPatches ps :: PatchSet rt p wS wX
ps = 
        -- Filter the repository keeping only with the tags, ordered from the
        -- most recent.
        case (PatchInfo -> Bool) -> [PatchInfo] -> [PatchInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter PatchInfo -> Bool
isTag ([PatchInfo] -> [PatchInfo]) -> [PatchInfo] -> [PatchInfo]
forall a b. (a -> b) -> a -> b
$ (forall wW wZ. PatchInfoAnd rt p wW wZ -> PatchInfo)
-> RL (PatchInfoAnd rt p) wS wX -> [PatchInfo]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL forall wW wZ. PatchInfoAnd rt p wW wZ -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> PatchInfo
info (RL (PatchInfoAnd rt p) wS wX -> [PatchInfo])
-> RL (PatchInfoAnd rt p) wS wX -> [PatchInfo]
forall a b. (a -> b) -> a -> b
$ PatchSet rt p wS wX -> RL (PatchInfoAnd rt p) wS wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> RL (PatchInfoAnd rt p) wStart wX
patchSet2RL PatchSet rt p wS wX
ps of
                [] -> PatchSet rt p wS wX
ps
                (lt :: PatchInfo
lt:_) -> 
                    -- Take the most recent tag, and split the repository in,
                    -- the clean PatchSet "up to" the tag (ts), and a RL of
                    -- patches after the tag (r).
                    case PatchInfo
-> PatchSet rt p wS wX
-> Maybe ((:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) wS wX)
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
Commute p =>
PatchInfo
-> PatchSet rt p wStart wX
-> Maybe ((:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) wStart wX)
splitOnTag PatchInfo
lt PatchSet rt p wS wX
ps of
                        Just (PatchSet ts :: RL (Tagged rt p) wS wX
ts xs :: RL (PatchInfoAnd rt p) wX wZ
xs :> r :: RL (PatchInfoAnd rt p) wZ wX
r) -> RL (Tagged rt p) wS wX
-> RL (PatchInfoAnd rt p) wX wX -> PatchSet rt p wS wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) wS wX
ts (RL (PatchInfoAnd rt p) wX wZ
xsRL (PatchInfoAnd rt p) wX wZ
-> RL (PatchInfoAnd rt p) wZ wX -> RL (PatchInfoAnd rt p) wX wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> RL a wY wZ -> RL a wX wZ
+<+RL (PatchInfoAnd rt p) wZ wX
r)
                        _ -> PatchSet rt p wS wX
forall a. a
impossible -- Because the tag is in ps.

-- @todo: we should not have to open the result of HashedRepo and
-- seal it.  Instead, update this function to work with type witnesses
-- by fixing DarcsRepo to match HashedRepo in the handling of
-- Repository state.
readRepo :: (IsRepoType rt, RepoPatch p)
         => Repository rt p wR wU wT
         -> IO (PatchSet rt p Origin wR)
readRepo :: Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo r :: Repository rt p wR wU wT
r
    | RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
HashedInventory (Repository rt p wR wU wT -> RepoFormat
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository rt p wR wU wT
r) = Repository rt p wR wU wT -> String -> IO (PatchSet rt p Origin wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> String -> IO (PatchSet rt p Origin wR)
readRepoHashed Repository rt p wR wU wT
r (Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
repoLocation Repository rt p wR wU wT
r)
    | Bool
otherwise = do Sealed ps :: PatchSet rt p Origin wX
ps <- String -> IO (Sealed (PatchSet rt p Origin))
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, RepoPatch p) =>
String -> IO (SealedPatchSet rt p Origin)
Old.readOldRepo (Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
repoLocation Repository rt p wR wU wT
r)
                     PatchSet rt p Origin wR -> IO (PatchSet rt p Origin wR)
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchSet rt p Origin wR -> IO (PatchSet rt p Origin wR))
-> PatchSet rt p Origin wR -> IO (PatchSet rt p Origin wR)
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wX -> PatchSet rt p Origin wR
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP PatchSet rt p Origin wX
ps

-- | XOR of all hashes of the patches' metadata.
-- It enables to quickly see whether two repositories
-- have the same patches, independently of their order.
-- It relies on the assumption that the same patch cannot
-- be present twice in a repository.
-- This checksum is not cryptographically secure,
-- see http://robotics.stanford.edu/~xb/crypto06b/ .
repoXor :: (IsRepoType rt, RepoPatch p)
        => Repository rt p wR wU wR -> IO SHA1
repoXor :: Repository rt p wR wU wR -> IO SHA1
repoXor repo :: Repository rt p wR wU wR
repo = do
  [SHA1]
hashes <- (forall wW wZ. PatchInfoAnd rt p wW wZ -> SHA1)
-> RL (PatchInfoAnd rt p) Origin wR -> [SHA1]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL (PatchInfo -> SHA1
makePatchname (PatchInfo -> SHA1)
-> (PatchInfoAnd rt p wW wZ -> PatchInfo)
-> PatchInfoAnd rt p wW wZ
-> SHA1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAnd rt p wW wZ -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> PatchInfo
info) (RL (PatchInfoAnd rt p) Origin wR -> [SHA1])
-> (PatchSet rt p Origin wR -> RL (PatchInfoAnd rt p) Origin wR)
-> PatchSet rt p Origin wR
-> [SHA1]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchSet rt p Origin wR -> RL (PatchInfoAnd rt p) Origin wR
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> RL (PatchInfoAnd rt p) wStart wX
patchSet2RL (PatchSet rt p Origin wR -> [SHA1])
-> IO (PatchSet rt p Origin wR) -> IO [SHA1]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Repository rt p wR wU wR -> 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 wR
repo
  SHA1 -> IO SHA1
forall (m :: * -> *) a. Monad m => a -> m a
return (SHA1 -> IO SHA1) -> SHA1 -> IO SHA1
forall a b. (a -> b) -> a -> b
$ (SHA1 -> SHA1 -> SHA1) -> SHA1 -> [SHA1] -> SHA1
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SHA1 -> SHA1 -> SHA1
sha1Xor SHA1
sha1zero [SHA1]
hashes