{-# LANGUAGE OverloadedStrings #-}
module Darcs.Repository.Hashed
( revertTentativeChanges
, revertRepositoryChanges
, finalizeTentativeChanges
, addToTentativeInventory
, readRepo
, readRepoHashed
, readTentativeRepo
, writeAndReadPatch
, writeTentativeInventory
, copyHashedInventory
, writePatchIfNecessary
, tentativelyAddPatch
, tentativelyRemovePatches
, tentativelyRemovePatches_
, tentativelyAddPatch_
, tentativelyAddPatches_
, finalizeRepositoryChanges
, reorderInventory
, UpdatePristine(..)
, repoXor
, upgradeOldStyleRebase
) where
import Darcs.Prelude
import Control.Exception ( catch )
import Darcs.Util.Exception ( catchall )
import Control.Monad ( when, unless )
import Data.Maybe
import Data.List( foldl' )
import qualified Data.ByteString as B ( empty, readFile, append )
import qualified Data.ByteString.Char8 as BC ( pack )
import Darcs.Util.Hash( SHA1, sha1Xor, sha1zero )
import Darcs.Util.Prompt ( promptYorn )
import Darcs.Util.Tree ( Tree )
import Darcs.Util.SignalHandler ( withSignalsBlocked )
import System.Directory
( copyFile
, createDirectoryIfMissing
, doesFileExist
, removeFile
, renameFile
)
import System.FilePath.Posix( (</>) )
import System.IO.Unsafe ( unsafeInterleaveIO )
import System.IO ( IOMode(..), hClose, hPutStrLn, openBinaryFile, stderr )
import System.IO.Error ( catchIOError, isDoesNotExistError )
import Darcs.Util.External
( copyFileOrUrl
, cloneFile
, gzFetchFilePS
, Cachable( Uncachable )
)
import Darcs.Repository.Flags
( Compression
, RemoteDarcs
, UpdatePending(..)
, Verbosity(..)
, remoteDarcs
)
import Darcs.Repository.Format
( RepoProperty( HashedInventory, RebaseInProgress, RebaseInProgress_2_16 )
, formatHas
, writeRepoFormat
, addToFormat
, removeFromFormat
)
import Darcs.Repository.Pending
( tentativelyRemoveFromPending
, revertPending
, finalizePending
, readTentativePending
, writeTentativePending
)
import Darcs.Repository.PatchIndex
( createOrUpdatePatchIndexDisk
, doesPatchIndexExist
)
import Darcs.Repository.Pristine
( ApplyDir(..)
, applyToTentativePristine
, applyToTentativePristineCwd
)
import Darcs.Repository.Paths
import Darcs.Repository.Rebase
( withTentativeRebase
, createTentativeRebase
, readTentativeRebase
, writeTentativeRebase
, commuteOutOldStyleRebase
)
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 ( ShowPatchFor(..) )
import qualified Darcs.Patch.Named.Wrapped as W
import Darcs.Patch.PatchInfoAnd
( PatchInfoAnd, PatchInfoAndG, Hopefully, patchInfoAndPatch, info
, extractHash, createHashed, hopefully
, fmapPIAP
)
import Darcs.Patch ( IsRepoType, RepoPatch, showPatch
, commuteRL
, readPatch
, effect
, displayPatch
)
import Darcs.Patch.Apply ( Apply(..) )
import Darcs.Patch.Format ( PatchListFormat )
import Darcs.Patch.Bundle ( Bundle(..), makeBundle, interpretBundle, parseBundle )
import Darcs.Patch.Read ( ReadPatch )
import Darcs.Patch.Depends ( removeFromPatchSet, slightlyOptimizePatchset
, mergeThem, cleanLatestTag )
import Darcs.Patch.Info
( PatchInfo, displayPatchInfo, makePatchname )
import Darcs.Patch.Rebase.Suspended
( Suspended(..), addFixupsToSuspended, removeFixupsFromSuspended )
import Darcs.Util.Path ( ioAbsoluteOrRemote, toPath )
import Darcs.Repository.Cache
( Cache
, HashedDir(..)
, fetchFileUsingCache
, hashedDir
, peekInCache
, speculateFilesUsingCache
, writeFileUsingCache
)
import Darcs.Repository.Inventory
import Darcs.Repository.InternalTypes
( Repository
, repoCache
, repoFormat
, repoLocation
, withRepoLocation
, unsafeCoerceR
, unsafeCoerceT
)
import qualified Darcs.Repository.Old as Old ( readOldRepo, oldRepoFailMsg )
import Darcs.Patch.Witnesses.Ordered
( (+<+), FL(..), RL(..), mapRL, foldFL_M, foldrwFL, mapRL_RL
, (:>)(..), lengthFL, (+>+)
, reverseFL )
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 ( debugDoc, ePutDocLn )
import Darcs.Util.Printer
( Doc
, ($$)
, (<+>)
, hcat
, renderPS
, renderString
, text
)
import Darcs.Util.Progress ( beginTedious, endTedious, debugMessage, finishedOneIO )
import Darcs.Patch.Progress (progressFL)
revertTentativeChanges :: IO ()
revertTentativeChanges :: IO ()
revertTentativeChanges = do
[Char] -> [Char] -> IO ()
cloneFile [Char]
hashedInventoryPath [Char]
tentativeHashedInventoryPath
ByteString
i <- [Char] -> IO ByteString
gzReadFilePS [Char]
hashedInventoryPath
forall p. FilePathLike p => p -> ByteString -> IO ()
writeBinFile [Char]
tentativePristinePath forall a b. (a -> b) -> a -> b
$
ByteString -> ByteString -> ByteString
B.append ByteString
pristineName forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
BC.pack forall a b. (a -> b) -> a -> b
$ forall a. ValidHash a => a -> [Char]
getValidHash forall a b. (a -> b) -> a -> b
$ ByteString -> PristineHash
peekPristineHash ByteString
i
finalizeTentativeChanges :: (IsRepoType rt, RepoPatch p)
=> Repository rt p wR wU wT -> Compression -> IO ()
finalizeTentativeChanges :: 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 = do
[Char] -> IO ()
debugMessage [Char]
"Optimizing the inventory..."
PatchSet rt p Origin wT
ps <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
Repository rt p wR wU wT -> [Char] -> IO (PatchSet rt p Origin wT)
readTentativeRepo Repository rt p wR wU wT
r [Char]
"."
forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
Cache -> Compression -> PatchSet rt p Origin wX -> IO ()
writeTentativeInventory (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 <- [Char] -> IO ByteString
gzReadFilePS [Char]
tentativeHashedInventoryPath
ByteString
p <- [Char] -> IO ByteString
gzReadFilePS [Char]
tentativePristinePath
forall p. FilePathLike p => p -> Doc -> IO ()
writeDocBinFile [Char]
tentativeHashedInventoryPath forall a b. (a -> b) -> a -> b
$ PristineHash -> ByteString -> Doc
pokePristineHash (ByteString -> PristineHash
peekPristineHash ByteString
p) ByteString
i
[Char] -> [Char] -> IO ()
renameFile [Char]
tentativeHashedInventoryPath [Char]
hashedInventoryPath
addToSpecificInventory :: RepoPatch p => String -> Cache -> Compression
-> PatchInfoAnd rt p wX wY -> IO ()
addToSpecificInventory :: forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
[Char] -> Cache -> Compression -> PatchInfoAnd rt p wX wY -> IO ()
addToSpecificInventory [Char]
invPath Cache
c Compression
compr PatchInfoAnd rt p wX wY
p = do
let invFile :: [Char]
invFile = [Char] -> [Char]
makeDarcsdirPath [Char]
invPath
PatchHash
hash <- forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
Cache
-> Compression -> PatchInfoAnd rt p wX wY -> IO InventoryEntry
writePatchIfNecessary Cache
c Compression
compr PatchInfoAnd rt p wX wY
p
forall p. FilePathLike p => p -> Doc -> IO ()
appendDocBinFile [Char]
invFile forall a b. (a -> b) -> a -> b
$ InventoryEntry -> Doc
showInventoryEntry (forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wX wY
p, PatchHash
hash)
addToTentativeInventory :: RepoPatch p => Cache -> Compression
-> PatchInfoAnd rt p wX wY -> IO ()
addToTentativeInventory :: forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
Cache -> Compression -> PatchInfoAnd rt p wX wY -> IO ()
addToTentativeInventory = forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
[Char] -> Cache -> Compression -> PatchInfoAnd rt p wX wY -> IO ()
addToSpecificInventory [Char]
tentativeHashedInventory
writeHashFile :: Cache -> Compression -> HashedDir -> Doc -> IO String
writeHashFile :: Cache -> Compression -> HashedDir -> Doc -> IO [Char]
writeHashFile Cache
c Compression
compr HashedDir
subdir Doc
d = do
[Char] -> IO ()
debugMessage forall a b. (a -> b) -> a -> b
$ [Char]
"Writing hash file to " forall a. [a] -> [a] -> [a]
++ HashedDir -> [Char]
hashedDir HashedDir
subdir
Cache -> Compression -> HashedDir -> ByteString -> IO [Char]
writeFileUsingCache Cache
c Compression
compr HashedDir
subdir forall a b. (a -> b) -> a -> b
$ Doc -> ByteString
renderPS Doc
d
readRepoHashed :: (IsRepoType rt, RepoPatch p) => Repository rt p wR wU wT
-> String -> IO (PatchSet rt p Origin wR)
readRepoHashed :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> [Char] -> IO (PatchSet rt p Origin wR)
readRepoHashed = forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wS.
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
[Char]
-> Repository rt p wR wU wT
-> [Char]
-> IO (PatchSet rt p Origin wS)
readRepoUsingSpecificInventory [Char]
hashedInventory
readTentativeRepo :: (IsRepoType rt, PatchListFormat p, ReadPatch p)
=> Repository rt p wR wU wT -> String
-> IO (PatchSet rt p Origin wT)
readTentativeRepo :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
Repository rt p wR wU wT -> [Char] -> IO (PatchSet rt p Origin wT)
readTentativeRepo = forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wS.
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
[Char]
-> Repository rt p wR wU wT
-> [Char]
-> IO (PatchSet rt p Origin wS)
readRepoUsingSpecificInventory [Char]
tentativeHashedInventory
readRepoUsingSpecificInventory :: (IsRepoType rt, PatchListFormat p, ReadPatch p)
=> String -> Repository rt p wR wU wT
-> String -> IO (PatchSet rt p Origin wS)
readRepoUsingSpecificInventory :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wS.
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
[Char]
-> Repository rt p wR wU wT
-> [Char]
-> IO (PatchSet rt p Origin wS)
readRepoUsingSpecificInventory [Char]
invPath Repository rt p wR wU wT
repo [Char]
dir = do
[Char]
realdir <- forall a. FilePathOrURL a => a -> [Char]
toPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO AbsoluteOrRemotePath
ioAbsoluteOrRemote [Char]
dir
Sealed PatchSet rt p Origin wX
ps <- forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
Cache -> [Char] -> [Char] -> IO (SealedPatchSet rt p Origin)
readRepoPrivate (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p wR wU wT
repo) [Char]
realdir [Char]
invPath
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \IOError
e -> do
Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char]
"Invalid repository: " forall a. [a] -> [a] -> [a]
++ [Char]
realdir)
forall a. IOError -> IO a
ioError IOError
e
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP PatchSet rt p Origin wX
ps
where
readRepoPrivate :: (IsRepoType rt, PatchListFormat p, ReadPatch p)
=> Cache -> FilePath
-> FilePath -> IO (SealedPatchSet rt p Origin)
readRepoPrivate :: forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
Cache -> [Char] -> [Char] -> IO (SealedPatchSet rt p Origin)
readRepoPrivate Cache
cache [Char]
d [Char]
iname = do
Inventory
inventory <- [Char] -> IO Inventory
readInventoryPrivate ([Char]
d [Char] -> [Char] -> [Char]
</> [Char]
darcsdir [Char] -> [Char] -> [Char]
</> [Char]
iname)
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
Cache -> Inventory -> IO (SealedPatchSet rt p Origin)
readRepoFromInventoryList Cache
cache Inventory
inventory
readRepoFromInventoryList
:: (IsRepoType rt, PatchListFormat p, ReadPatch p)
=> Cache
-> Inventory
-> IO (SealedPatchSet rt p Origin)
readRepoFromInventoryList :: forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
Cache -> Inventory -> IO (SealedPatchSet rt p Origin)
readRepoFromInventoryList Cache
cache = forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
Inventory -> IO (SealedPatchSet rt p Origin)
parseInv
where
parseInv :: (IsRepoType rt, PatchListFormat p, ReadPatch p)
=> Inventory
-> IO (SealedPatchSet rt p Origin)
parseInv :: forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
Inventory -> IO (SealedPatchSet rt p Origin)
parseInv (Inventory Maybe InventoryHash
Nothing [InventoryEntry]
ris) =
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal (forall (rt :: RepoType) (p :: * -> * -> *) wY wY.
RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wY -> PatchSet rt p Origin wY
PatchSet forall (a :: * -> * -> *) wX. RL a wX wX
NilRL) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (np :: * -> * -> *) (rt :: RepoType) wX.
ReadPatch np =>
Cache
-> [InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG rt np) wX))
readPatchesFromInventory Cache
cache [InventoryEntry]
ris
parseInv (Inventory (Just InventoryHash
h) []) =
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"bad inventory " forall a. [a] -> [a] -> [a]
++ forall a. ValidHash a => a -> [Char]
getValidHash InventoryHash
h forall a. [a] -> [a] -> [a]
++ [Char]
" (no tag) in parseInv!"
parseInv (Inventory (Just InventoryHash
h) (InventoryEntry
t : [InventoryEntry]
ris)) = do
Sealed RL (Tagged rt p) Origin wX
ts <- forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall (a :: * -> *) wX. a wX -> Sealed a
seal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IO a -> IO a
unsafeInterleaveIO (forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
InventoryEntry
-> InventoryHash -> IO (Sealed (RL (Tagged rt p) Origin))
read_ts InventoryEntry
t InventoryHash
h)
Sealed RL (PatchInfoAndG rt (Named p)) wX wX
ps <- forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall (a :: * -> *) wX. a wX -> Sealed a
seal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall a. IO a -> IO a
unsafeInterleaveIO (forall (np :: * -> * -> *) (rt :: RepoType) wX.
ReadPatch np =>
Cache
-> [InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG rt np) wX))
readPatchesFromInventory Cache
cache [InventoryEntry]
ris)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) wX. a wX -> Sealed a
seal forall a b. (a -> b) -> a -> b
$ forall (rt :: RepoType) (p :: * -> * -> *) wY wY.
RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wX
ts RL (PatchInfoAndG rt (Named p)) wX wX
ps
read_ts :: (IsRepoType rt, PatchListFormat p, ReadPatch p) => InventoryEntry
-> InventoryHash -> IO (Sealed (RL (Tagged rt p) Origin))
read_ts :: forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
InventoryEntry
-> InventoryHash -> IO (Sealed (RL (Tagged rt p) Origin))
read_ts InventoryEntry
tag0 InventoryHash
h0 = do
Inventory
contents <- forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ InventoryHash -> IO Inventory
readTaggedInventory InventoryHash
h0
let is :: [InventoryEntry]
is = case Inventory
contents of
(Inventory (Just InventoryHash
_) (InventoryEntry
_ : [InventoryEntry]
ris0)) -> [InventoryEntry]
ris0
(Inventory Maybe InventoryHash
Nothing [InventoryEntry]
ris0) -> [InventoryEntry]
ris0
(Inventory (Just InventoryHash
_) []) -> forall a. HasCallStack => [Char] -> a
error [Char]
"inventory without tag!"
Sealed RL (Tagged rt p) Origin wX
ts <- forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall (a :: * -> *) wX. a wX -> Sealed a
seal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall a. IO a -> IO a
unsafeInterleaveIO
(case Inventory
contents of
(Inventory (Just InventoryHash
h') (InventoryEntry
t' : [InventoryEntry]
_)) -> forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
InventoryEntry
-> InventoryHash -> IO (Sealed (RL (Tagged rt p) Origin))
read_ts InventoryEntry
t' InventoryHash
h'
(Inventory (Just InventoryHash
_) []) -> forall a. HasCallStack => [Char] -> a
error [Char]
"inventory without tag!"
(Inventory Maybe InventoryHash
Nothing [InventoryEntry]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) wX. a wX -> Sealed a
seal forall (a :: * -> * -> *) wX. RL a wX wX
NilRL)
Sealed RL (PatchInfoAndG rt (Named p)) wX wX
ps <- forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall (a :: * -> *) wX. a wX -> Sealed a
seal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall a. IO a -> IO a
unsafeInterleaveIO (forall (np :: * -> * -> *) (rt :: RepoType) wX.
ReadPatch np =>
Cache
-> [InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG rt np) wX))
readPatchesFromInventory Cache
cache [InventoryEntry]
is)
Sealed PatchInfoAnd rt p wX wX
tag00 <- forall (p :: * -> * -> *) (rt :: RepoType) wX.
(PatchListFormat p, ReadPatch p) =>
InventoryEntry -> IO (Sealed (PatchInfoAnd rt p wX))
read_tag InventoryEntry
tag0
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) wX. a wX -> Sealed a
seal forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) Origin wX
ts forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: forall (rt :: RepoType) (p :: * -> * -> *) wY wZ wX.
PatchInfoAnd rt p wY wZ
-> Maybe [Char]
-> RL (PatchInfoAnd rt p) wX wY
-> Tagged rt p wX wZ
Tagged PatchInfoAnd rt p wX wX
tag00 (forall a. a -> Maybe a
Just (forall a. ValidHash a => a -> [Char]
getValidHash InventoryHash
h0)) RL (PatchInfoAndG rt (Named p)) wX wX
ps
read_tag :: (PatchListFormat p, ReadPatch p) => InventoryEntry
-> IO (Sealed (PatchInfoAnd rt p wX))
read_tag :: forall (p :: * -> * -> *) (rt :: RepoType) wX.
(PatchListFormat p, ReadPatch p) =>
InventoryEntry -> IO (Sealed (PatchInfoAnd rt p wX))
read_tag (PatchInfo
i, PatchHash
h) =
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal (forall (p :: * -> * -> *) wA wB (rt :: RepoType).
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG rt p wA wB
patchInfoAndPatch PatchInfo
i) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: * -> * -> *) wX.
PatchHash
-> (PatchHash -> IO (Sealed (a wX)))
-> IO (Sealed (Hopefully a wX))
createValidHashed PatchHash
h (forall (p :: * -> * -> *) wX.
ReadPatch p =>
Cache -> PatchInfo -> PatchHash -> IO (Sealed (p wX))
readSinglePatch Cache
cache PatchInfo
i)
readTaggedInventory :: InventoryHash -> IO Inventory
readTaggedInventory :: InventoryHash -> IO Inventory
readTaggedInventory InventoryHash
invHash = do
([Char]
fileName, ByteString
pristineAndInventory) <-
Cache -> HashedDir -> [Char] -> IO ([Char], ByteString)
fetchFileUsingCache Cache
cache HashedDir
HashedInventoriesDir (forall a. ValidHash a => a -> [Char]
getValidHash InventoryHash
invHash)
case ByteString -> Either [Char] Inventory
parseInventory ByteString
pristineAndInventory of
Right Inventory
r -> forall (m :: * -> *) a. Monad m => a -> m a
return Inventory
r
Left [Char]
e -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines [[[Char]] -> [Char]
unwords [[Char]
"parse error in file", [Char]
fileName],[Char]
e]
readPatchesFromInventory :: ReadPatch np
=> Cache
-> [InventoryEntry]
-> IO (Sealed (RL (PatchInfoAndG rt np) wX))
readPatchesFromInventory :: forall (np :: * -> * -> *) (rt :: RepoType) wX.
ReadPatch np =>
Cache
-> [InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG rt np) wX))
readPatchesFromInventory Cache
cache [InventoryEntry]
ris = forall {p :: * -> * -> *} {rt :: RepoType} {wX}.
ReadPatch p =>
[InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG rt p) wX))
read_patches (forall a. [a] -> [a]
reverse [InventoryEntry]
ris)
where
read_patches :: [InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG rt p) wX))
read_patches [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) wX. a wX -> Sealed a
seal forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
read_patches allis :: [InventoryEntry]
allis@((PatchInfo
i1, PatchHash
h1) : [InventoryEntry]
is1) =
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 (\Hopefully p wY wZ
p RL (PatchInfoAndG rt p) wX wY
rest -> RL (PatchInfoAndG rt p) wX wY
rest forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfo
i1 forall (p :: * -> * -> *) wA wB (rt :: RepoType).
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG rt p wA wB
`patchInfoAndPatch` Hopefully p wY wZ
p) (forall {p :: * -> * -> *} {rt :: RepoType} {wX}.
ReadPatch p =>
[InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG rt p) wX))
rp [InventoryEntry]
is1)
(forall (a :: * -> * -> *) wX.
PatchHash
-> (PatchHash -> IO (Sealed (a wX)))
-> IO (Sealed (Hopefully a wX))
createValidHashed PatchHash
h1 (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall {p :: * -> * -> *} {wX}.
ReadPatch p =>
PatchHash -> [InventoryEntry] -> PatchInfo -> IO (Sealed (p wX))
speculateAndParse PatchHash
h1 [InventoryEntry]
allis PatchInfo
i1))
where
rp :: [InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG rt p) wX))
rp [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) wX. a wX -> Sealed a
seal forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
rp [(PatchInfo
i, PatchHash
h), (PatchInfo
il, PatchHash
hl)] =
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 (\Hopefully p wY wZ
p RL (PatchInfoAndG rt p) wX wY
rest -> RL (PatchInfoAndG rt p) wX wY
rest forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfo
i forall (p :: * -> * -> *) wA wB (rt :: RepoType).
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG rt p wA wB
`patchInfoAndPatch` Hopefully p wY wZ
p)
([InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG rt p) wX))
rp [(PatchInfo
il, PatchHash
hl)])
(forall (a :: * -> * -> *) wX.
PatchHash
-> (PatchHash -> IO (Sealed (a wX)))
-> IO (Sealed (Hopefully a wX))
createValidHashed PatchHash
h
(forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall {p :: * -> * -> *} {wX}.
ReadPatch p =>
PatchHash -> [InventoryEntry] -> PatchInfo -> IO (Sealed (p wX))
speculateAndParse PatchHash
h (forall a. [a] -> [a]
reverse [InventoryEntry]
allis) PatchInfo
i))
rp ((PatchInfo
i, PatchHash
h) : [InventoryEntry]
is) =
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 (\Hopefully p wY wZ
p RL (PatchInfoAndG rt p) wX wY
rest -> RL (PatchInfoAndG rt p) wX wY
rest forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfo
i forall (p :: * -> * -> *) wA wB (rt :: RepoType).
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG rt p wA wB
`patchInfoAndPatch` Hopefully p wY wZ
p)
([InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG rt p) wX))
rp [InventoryEntry]
is)
(forall (a :: * -> * -> *) wX.
PatchHash
-> (PatchHash -> IO (Sealed (a wX)))
-> IO (Sealed (Hopefully a wX))
createValidHashed PatchHash
h (forall (p :: * -> * -> *) wX.
ReadPatch p =>
Cache -> PatchInfo -> PatchHash -> IO (Sealed (p wX))
readSinglePatch Cache
cache 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 (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 forall wY wZ. q wY wZ -> p wX wY -> r wX wZ
f IO (Sealed (p wX))
iox forall wB. IO (Sealed (q wB))
ioy = do
Sealed p wX wX
x <- forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall (a :: * -> *) wX. a wX -> Sealed a
seal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IO a -> IO a
unsafeInterleaveIO IO (Sealed (p wX))
iox
Sealed q wX wX
y <- forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall (a :: * -> *) wX. a wX -> Sealed a
seal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IO a -> IO a
unsafeInterleaveIO forall wB. IO (Sealed (q wB))
ioy
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) wX. a wX -> Sealed a
seal forall a b. (a -> b) -> a -> b
$ forall wY wZ. q wY wZ -> p wX wY -> r wX wZ
f q wX wX
y p wX wX
x
speculateAndParse :: PatchHash -> [InventoryEntry] -> PatchInfo -> IO (Sealed (p wX))
speculateAndParse PatchHash
h [InventoryEntry]
is PatchInfo
i = PatchHash -> [InventoryEntry] -> IO ()
speculate PatchHash
h [InventoryEntry]
is forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (p :: * -> * -> *) wX.
ReadPatch p =>
Cache -> PatchInfo -> PatchHash -> IO (Sealed (p wX))
readSinglePatch Cache
cache PatchInfo
i PatchHash
h
speculate :: PatchHash -> [InventoryEntry] -> IO ()
speculate :: PatchHash -> [InventoryEntry] -> IO ()
speculate PatchHash
pHash [InventoryEntry]
is = do
Bool
already_got_one <- Cache -> HashedDir -> [Char] -> IO Bool
peekInCache Cache
cache HashedDir
HashedPatchesDir (forall a. ValidHash a => a -> [Char]
getValidHash PatchHash
pHash)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
already_got_one forall a b. (a -> b) -> a -> b
$
Cache -> HashedDir -> [[Char]] -> IO ()
speculateFilesUsingCache Cache
cache HashedDir
HashedPatchesDir (forall a b. (a -> b) -> [a] -> [b]
map (forall a. ValidHash a => a -> [Char]
getValidHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [InventoryEntry]
is)
readSinglePatch :: ReadPatch p
=> Cache
-> PatchInfo -> PatchHash -> IO (Sealed (p wX))
readSinglePatch :: forall (p :: * -> * -> *) wX.
ReadPatch p =>
Cache -> PatchInfo -> PatchHash -> IO (Sealed (p wX))
readSinglePatch Cache
cache PatchInfo
i PatchHash
h = do
Doc -> IO ()
debugDoc forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
"Reading patch file:" Doc -> Doc -> Doc
<+> PatchInfo -> Doc
displayPatchInfo PatchInfo
i
([Char]
fn, ByteString
ps) <- Cache -> HashedDir -> [Char] -> IO ([Char], ByteString)
fetchFileUsingCache Cache
cache HashedDir
HashedPatchesDir (forall a. ValidHash a => a -> [Char]
getValidHash PatchHash
h)
case forall (p :: * -> * -> *) wX.
ReadPatch p =>
ByteString -> Either [Char] (Sealed (p wX))
readPatch ByteString
ps of
Right Sealed (p wX)
p -> forall (m :: * -> *) a. Monad m => a -> m a
return Sealed (p wX)
p
Left [Char]
e -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines
[ [Char]
"Couldn't parse file " forall a. [a] -> [a] -> [a]
++ [Char]
fn
, [Char]
"which is patch"
, Doc -> [Char]
renderString forall a b. (a -> b) -> a -> b
$ PatchInfo -> Doc
displayPatchInfo PatchInfo
i
, [Char]
e
]
readInventoryPrivate :: FilePath -> IO Inventory
readInventoryPrivate :: [Char] -> IO Inventory
readInventoryPrivate [Char]
path = do
ByteString
inv <- ByteString -> ByteString
skipPristineHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Cachable -> IO ByteString
gzFetchFilePS [Char]
path Cachable
Uncachable
case ByteString -> Either [Char] Inventory
parseInventory ByteString
inv of
Right Inventory
r -> forall (m :: * -> *) a. Monad m => a -> m a
return Inventory
r
Left [Char]
e -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines [[[Char]] -> [Char]
unwords [[Char]
"parse error in file", [Char]
path],[Char]
e]
copyHashedInventory :: Repository rt p wR wU wT -> RemoteDarcs -> String -> IO ()
copyHashedInventory :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RemoteDarcs -> [Char] -> IO ()
copyHashedInventory Repository rt p wR wU wT
outrepo RemoteDarcs
rdarcs [Char]
inloc | [Char]
remote <- RemoteDarcs -> [Char]
remoteDarcs RemoteDarcs
rdarcs = do
let outloc :: [Char]
outloc = forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> [Char]
repoLocation Repository rt p wR wU wT
outrepo
Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
False ([Char]
outloc forall a. [a] -> [a] -> [a]
++ [Char]
"/" forall a. [a] -> [a] -> [a]
++ [Char]
inventoriesDirPath)
[Char] -> [Char] -> [Char] -> Cachable -> IO ()
copyFileOrUrl [Char]
remote ([Char]
inloc [Char] -> [Char] -> [Char]
</> [Char]
hashedInventoryPath)
([Char]
outloc [Char] -> [Char] -> [Char]
</> [Char]
hashedInventoryPath)
Cachable
Uncachable
[Char] -> IO ()
debugMessage [Char]
"Done copying hashed inventory."
writeAndReadPatch :: RepoPatch p => Cache -> Compression
-> PatchInfoAnd rt p wX wY -> IO (PatchInfoAnd rt p wX wY)
writeAndReadPatch :: forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
Cache
-> Compression
-> PatchInfoAnd rt p wX wY
-> IO (PatchInfoAnd rt p wX wY)
writeAndReadPatch Cache
c Compression
compr PatchInfoAnd rt p wX wY
p = do
(PatchInfo
i, PatchHash
h) <- forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
Cache
-> Compression -> PatchInfoAnd rt p wX wY -> IO InventoryEntry
writePatchIfNecessary Cache
c Compression
compr PatchInfoAnd rt p wX wY
p
forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ forall {a :: * -> * -> *} {rt :: RepoType} {wA} {wB}.
ReadPatch a =>
PatchHash -> PatchInfo -> IO (PatchInfoAndG rt a wA wB)
readp PatchHash
h PatchInfo
i
where
parse :: PatchInfo -> a -> IO (Sealed (p wX))
parse PatchInfo
i a
h = do
Doc -> IO ()
debugDoc forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
"Rereading patch file:" Doc -> Doc -> Doc
<+> PatchInfo -> Doc
displayPatchInfo PatchInfo
i
([Char]
fn, ByteString
ps) <- Cache -> HashedDir -> [Char] -> IO ([Char], ByteString)
fetchFileUsingCache Cache
c HashedDir
HashedPatchesDir (forall a. ValidHash a => a -> [Char]
getValidHash a
h)
case forall (p :: * -> * -> *) wX.
ReadPatch p =>
ByteString -> Either [Char] (Sealed (p wX))
readPatch ByteString
ps of
Right Sealed (p wX)
x -> forall (m :: * -> *) a. Monad m => a -> m a
return Sealed (p wX)
x
Left [Char]
e -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines
[ [Char]
"Couldn't parse patch file " forall a. [a] -> [a] -> [a]
++ [Char]
fn
, [Char]
"which is"
, Doc -> [Char]
renderString forall a b. (a -> b) -> a -> b
$ PatchInfo -> Doc
displayPatchInfo PatchInfo
i
, [Char]
e
]
readp :: PatchHash -> PatchInfo -> IO (PatchInfoAndG rt a wA wB)
readp PatchHash
h PatchInfo
i = do Sealed Hopefully a Any wX
x <- forall (a :: * -> * -> *) wX.
PatchHash
-> (PatchHash -> IO (Sealed (a wX)))
-> IO (Sealed (Hopefully a wX))
createValidHashed PatchHash
h (forall {a} {p :: * -> * -> *} {wX}.
(ValidHash a, ReadPatch p) =>
PatchInfo -> a -> IO (Sealed (p wX))
parse PatchInfo
i)
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) wA wB (rt :: RepoType).
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG rt p wA wB
patchInfoAndPatch PatchInfo
i forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP Hopefully a Any wX
x
createValidHashed :: PatchHash
-> (PatchHash -> IO (Sealed (a wX)))
-> IO (Sealed (Darcs.Patch.PatchInfoAnd.Hopefully a wX))
createValidHashed :: forall (a :: * -> * -> *) wX.
PatchHash
-> (PatchHash -> IO (Sealed (a wX)))
-> IO (Sealed (Hopefully a wX))
createValidHashed PatchHash
h PatchHash -> IO (Sealed (a wX))
f = forall (a :: * -> * -> *) wX.
[Char]
-> ([Char] -> IO (Sealed (a wX))) -> IO (Sealed (Hopefully a wX))
createHashed (forall a. ValidHash a => a -> [Char]
getValidHash PatchHash
h) (PatchHash -> IO (Sealed (a wX))
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ValidHash a => [Char] -> a
mkValidHash)
writeTentativeInventory :: RepoPatch p => Cache -> Compression
-> PatchSet rt p Origin wX -> IO ()
writeTentativeInventory :: forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
Cache -> Compression -> PatchSet rt p Origin wX -> IO ()
writeTentativeInventory Cache
cache Compression
compr PatchSet rt p Origin wX
patchSet = do
[Char] -> IO ()
debugMessage [Char]
"in writeTentativeInventory..."
Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
False [Char]
inventoriesDirPath
[Char] -> IO ()
beginTedious [Char]
tediousName
Maybe [Char]
hsh <- forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
PatchSet rt p Origin wX -> IO (Maybe [Char])
writeInventoryPrivate forall a b. (a -> b) -> a -> b
$ forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> PatchSet rt p wStart wX
slightlyOptimizePatchset PatchSet rt p Origin wX
patchSet
[Char] -> IO ()
endTedious [Char]
tediousName
[Char] -> IO ()
debugMessage [Char]
"still in writeTentativeInventory..."
case Maybe [Char]
hsh of
Maybe [Char]
Nothing -> forall p. FilePathLike p => p -> ByteString -> IO ()
writeBinFile ([Char] -> [Char]
makeDarcsdirPath [Char]
tentativeHashedInventory) ByteString
B.empty
Just [Char]
h -> do
ByteString
content <- forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cache -> HashedDir -> [Char] -> IO ([Char], ByteString)
fetchFileUsingCache Cache
cache HashedDir
HashedInventoriesDir [Char]
h
forall p. FilePathLike p => p -> ByteString -> IO ()
writeAtomicFilePS ([Char] -> [Char]
makeDarcsdirPath [Char]
tentativeHashedInventory) ByteString
content
where
tediousName :: [Char]
tediousName = [Char]
"Writing inventory"
writeInventoryPrivate :: RepoPatch p => PatchSet rt p Origin wX
-> IO (Maybe String)
writeInventoryPrivate :: forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
PatchSet rt p Origin wX -> IO (Maybe [Char])
writeInventoryPrivate (PatchSet RL (Tagged rt p) Origin wX
NilRL RL (PatchInfoAnd rt p) wX wX
NilRL) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
writeInventoryPrivate (PatchSet RL (Tagged rt p) Origin wX
NilRL RL (PatchInfoAnd rt p) wX wX
ps) = do
[InventoryEntry]
inventory <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL (forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
Cache
-> Compression -> PatchInfoAnd rt p wX wY -> IO InventoryEntry
writePatchIfNecessary Cache
cache Compression
compr) RL (PatchInfoAnd rt p) wX wX
ps
let inventorylist :: Doc
inventorylist = [InventoryEntry] -> Doc
showInventoryPatches (forall a. [a] -> [a]
reverse [InventoryEntry]
inventory)
[Char]
hash <- Cache -> Compression -> HashedDir -> Doc -> IO [Char]
writeHashFile Cache
cache Compression
compr HashedDir
HashedInventoriesDir Doc
inventorylist
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just [Char]
hash
writeInventoryPrivate
(PatchSet xs :: RL (Tagged rt p) Origin wX
xs@(RL (Tagged rt p) Origin wY
_ :<: Tagged PatchInfoAnd rt p wY wX
t Maybe [Char]
_ RL (PatchInfoAnd rt p) wY wY
_) RL (PatchInfoAnd rt p) wX wX
x) = do
Maybe [Char]
resthash <- forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
RL (Tagged rt p) Origin wX -> IO (Maybe [Char])
write_ts RL (Tagged rt p) Origin wX
xs
[Char] -> [Char] -> IO ()
finishedOneIO [Char]
tediousName forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [Char]
"" Maybe [Char]
resthash
[InventoryEntry]
inventory <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL (forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
Cache
-> Compression -> PatchInfoAnd rt p wX wY -> IO InventoryEntry
writePatchIfNecessary Cache
cache Compression
compr)
(forall (a :: * -> * -> *) wX. RL a wX wX
NilRL forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wX
t 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 (forall a b. (a -> b) -> [a] -> [b]
map InventoryEntry -> Doc
showInventoryEntry forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [InventoryEntry]
inventory)
inventorycontents :: Doc
inventorycontents =
case Maybe [Char]
resthash of
Just [Char]
h -> [Char] -> Doc
text ([Char]
"Starting with inventory:\n" forall a. [a] -> [a] -> [a]
++ [Char]
h) Doc -> Doc -> Doc
$$
Doc
inventorylist
Maybe [Char]
Nothing -> Doc
inventorylist
[Char]
hash <- Cache -> Compression -> HashedDir -> Doc -> IO [Char]
writeHashFile Cache
cache Compression
compr HashedDir
HashedInventoriesDir Doc
inventorycontents
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just [Char]
hash
where
write_ts :: RepoPatch p => RL (Tagged rt p) Origin wX
-> IO (Maybe String)
write_ts :: forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
RL (Tagged rt p) Origin wX -> IO (Maybe [Char])
write_ts (RL (Tagged rt p) Origin wY
_ :<: Tagged PatchInfoAnd rt p wY wX
_ (Just [Char]
h) RL (PatchInfoAnd rt p) wY wY
_) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just [Char]
h)
write_ts (RL (Tagged rt p) Origin wY
tts :<: Tagged PatchInfoAnd rt p wY wX
_ Maybe [Char]
Nothing RL (PatchInfoAnd rt p) wY wY
pps) =
forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
PatchSet rt p Origin wX -> IO (Maybe [Char])
writeInventoryPrivate forall a b. (a -> b) -> a -> b
$ forall (rt :: RepoType) (p :: * -> * -> *) wY wY.
RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wY
tts RL (PatchInfoAnd rt p) wY wY
pps
write_ts RL (Tagged rt p) Origin wX
NilRL = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
writePatchIfNecessary :: RepoPatch p => Cache -> Compression
-> PatchInfoAnd rt p wX wY -> IO InventoryEntry
writePatchIfNecessary :: forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
Cache
-> Compression -> PatchInfoAnd rt p wX wY -> IO InventoryEntry
writePatchIfNecessary Cache
c Compression
compr PatchInfoAnd rt p wX wY
hp = PatchInfo
infohp seq :: forall a b. a -> b -> b
`seq`
case forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> Either (p wA wB) [Char]
extractHash PatchInfoAnd rt p wX wY
hp of
Right [Char]
h -> forall (m :: * -> *) a. Monad m => a -> m a
return (PatchInfo
infohp, forall a. ValidHash a => [Char] -> a
mkValidHash [Char]
h)
Left Named p wX wY
p -> do
[Char]
h <- Cache -> Compression -> HashedDir -> Doc -> IO [Char]
writeHashFile Cache
c Compression
compr HashedDir
HashedPatchesDir (forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForStorage Named p wX wY
p)
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchInfo
infohp, forall a. ValidHash a => [Char] -> a
mkValidHash [Char]
h)
where
infohp :: PatchInfo
infohp = forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wX wY
hp
tentativelyAddPatch :: (RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdatePending
-> PatchInfoAnd rt p wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatch :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdatePending
-> PatchInfoAnd rt p wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatch = forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(RepoPatch p, ApplyState p ~ Tree) =>
UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdatePending
-> PatchInfoAnd rt p wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatch_ UpdatePristine
UpdatePristine
data UpdatePristine = UpdatePristine
| DontUpdatePristine
| DontUpdatePristineNorRevert deriving UpdatePristine -> UpdatePristine -> Bool
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
-> UpdatePending
-> FL (PatchInfoAnd rt p) wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatches_ :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(RepoPatch p, ApplyState p ~ Tree) =>
UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdatePending
-> FL (PatchInfoAnd rt p) wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatches_ UpdatePristine
upr Repository rt p wR wU wT
r Compression
c Verbosity
v UpdatePending
upe FL (PatchInfoAnd rt p) wT wY
ps =
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 (\Repository rt p wR wU wA
r' PatchInfoAnd rt p wA wB
p -> forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(RepoPatch p, ApplyState p ~ Tree) =>
UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdatePending
-> PatchInfoAnd rt p wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatch_ UpdatePristine
upr Repository rt p wR wU wA
r' Compression
c Verbosity
v UpdatePending
upe PatchInfoAnd rt p wA wB
p) Repository rt p wR wU wT
r FL (PatchInfoAnd rt p) wT wY
ps
tentativelyAddPatch_ :: (RepoPatch p, ApplyState p ~ Tree)
=> UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdatePending
-> PatchInfoAnd rt p wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatch_ :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(RepoPatch p, ApplyState p ~ Tree) =>
UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdatePending
-> PatchInfoAnd rt p wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatch_ UpdatePristine
upr Repository rt p wR wU wT
r Compression
compr Verbosity
verb UpdatePending
upe PatchInfoAnd rt p wT wY
p = do
let r' :: Repository rt p wR wU wT'
r' = forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wT'.
Repository rt p wR wU wT -> Repository rt p wR wU wT'
unsafeCoerceT Repository rt p wR wU wT
r
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
RepoPatch p =>
Repository rt p wR wU wT
-> Repository rt p wR wU wY
-> (Suspended p wT wT -> Suspended p wY wY)
-> IO ()
withTentativeRebase Repository rt p wR wU wT
r forall {wT'}. Repository rt p wR wU wT'
r' (forall (p :: * -> * -> *) wX wY.
(PrimPatchBase p, Commute p, FromPrim p, Effect p) =>
Named p wX wY -> Suspended p wX wX -> Suspended p wY wY
removeFixupsFromSuspended forall a b. (a -> b) -> a -> b
$ forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> p wA wB
hopefully PatchInfoAnd rt p wT wY
p)
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 forall a b. (a -> b) -> a -> b
$ do
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
Cache -> Compression -> PatchInfoAnd rt p wX wY -> IO ()
addToTentativeInventory (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
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UpdatePristine
upr forall a. Eq a => a -> a -> Bool
== UpdatePristine
UpdatePristine) forall a b. (a -> b) -> a -> b
$ do
[Char] -> IO ()
debugMessage [Char]
"Applying to pristine cache..."
forall (q :: * -> * -> *) (rt :: RepoType) (p :: * -> * -> *) wR wU
wT wY.
(ApplyState q ~ Tree, Apply q, ShowPatch q) =>
Repository rt p wR wU wT
-> ApplyDir -> Verbosity -> q wT wY -> IO ()
applyToTentativePristine Repository rt p wR wU wT
r ApplyDir
ApplyNormal Verbosity
verb PatchInfoAnd rt p wT wY
p
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UpdatePending
upe forall a. Eq a => a -> a -> Bool
== UpdatePending
YesUpdatePending) forall a b. (a -> b) -> a -> b
$ do
[Char] -> IO ()
debugMessage [Char]
"Updating pending..."
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wO.
RepoPatch p =>
Repository rt p wR wU wT -> FL (PrimOf p) wO wT -> IO ()
tentativelyRemoveFromPending forall {wT'}. Repository rt p wR wU wT'
r' (forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect PatchInfoAnd rt p wT wY
p)
forall (m :: * -> *) a. Monad m => a -> m a
return forall {wT'}. Repository rt p wR wU wT'
r'
tentativelyRemovePatches :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wR wU wT
-> Compression
-> UpdatePending
-> FL (PatchInfoAnd rt p) wX wT
-> IO (Repository rt p wR wU wX)
tentativelyRemovePatches :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> Compression
-> UpdatePending
-> FL (PatchInfoAnd rt p) wX wT
-> IO (Repository rt p wR wU wX)
tentativelyRemovePatches = forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> UpdatePending
-> FL (PatchInfoAnd rt p) wX wT
-> IO (Repository rt p wR wU wX)
tentativelyRemovePatches_ UpdatePristine
UpdatePristine
newtype Dup p wX = Dup { forall (p :: * -> * -> *) wX. Dup p wX -> p wX wX
unDup :: p wX wX }
foldrwFL' :: (forall wA wB. p wA wB -> s wB wB -> s wA wA)
-> FL p wX wY -> s wY wY -> s wX wX
foldrwFL' :: forall (p :: * -> * -> *) (s :: * -> * -> *) wX wY.
(forall wA wB. p wA wB -> s wB wB -> s wA wA)
-> FL p wX wY -> s wY wY -> s wX wX
foldrwFL' forall wA wB. p wA wB -> s wB wB -> s wA wA
f FL p wX wY
ps = forall (p :: * -> * -> *) wX. Dup p wX -> p wX wX
unDup forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (r :: * -> *) wX wY.
(forall wA wB. p wA wB -> r wB -> r wA)
-> FL p wX wY -> r wY -> r wX
foldrwFL (\p wA wB
p -> (forall (p :: * -> * -> *) wX. p wX wX -> Dup p wX
Dup forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall wA wB. p wA wB -> s wB wB -> s wA wA
f p wA wB
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) wX. Dup p wX -> p wX wX
unDup)) FL p wX wY
ps forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) wX. p wX wX -> Dup p wX
Dup
tentativelyRemovePatches_ :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
=> UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> UpdatePending
-> FL (PatchInfoAnd rt p) wX wT
-> IO (Repository rt p wR wU wX)
tentativelyRemovePatches_ :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> UpdatePending
-> FL (PatchInfoAnd rt p) wX wT
-> IO (Repository rt p wR wU wX)
tentativelyRemovePatches_ UpdatePristine
upr Repository rt p wR wU wT
r Compression
compr UpdatePending
upe FL (PatchInfoAnd rt p) wX wT
ps
| RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
HashedInventory (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository rt p wR wU wT
r) = do
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 forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (UpdatePristine
upr forall a. Eq a => a -> a -> Bool
== UpdatePristine
DontUpdatePristineNorRevert) forall a b. (a -> b) -> a -> b
$ 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
Sealed FL (PrimOf p) wT wX
pend <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> IO (Sealed (FL (PrimOf p) wT))
readTentativePending Repository rt p wR wU wT
r
[Char] -> IO ()
debugMessage [Char]
"Removing changes from tentative inventory..."
Repository rt p wR wU wX
r' <- 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 (Repository rt p wR wU wX)
removeFromTentativeInventory Repository rt p wR wU wT
r Compression
compr FL (PatchInfoAnd rt p) wX wT
ps
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
RepoPatch p =>
Repository rt p wR wU wT
-> Repository rt p wR wU wY
-> (Suspended p wT wT -> Suspended p wY wY)
-> IO ()
withTentativeRebase Repository rt p wR wU wT
r Repository rt p wR wU wX
r'
(forall (p :: * -> * -> *) (s :: * -> * -> *) wX wY.
(forall wA wB. p wA wB -> s wB wB -> s wA wA)
-> FL p wX wY -> s wY wY -> s wX wX
foldrwFL' (forall (p :: * -> * -> *) wX wY.
(PrimPatchBase p, Commute p, FromPrim p, Effect p) =>
Named p wX wY -> Suspended p wY wY -> Suspended p wX wX
addFixupsToSuspended forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> p wA wB
hopefully) FL (PatchInfoAnd rt p) wX wT
ps)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UpdatePristine
upr forall a. Eq a => a -> a -> Bool
== UpdatePristine
UpdatePristine) forall a b. (a -> b) -> a -> b
$
forall (p :: * -> * -> *) wX wY.
(ApplyState p ~ Tree, Apply p) =>
ApplyDir -> p wX wY -> IO ()
applyToTentativePristineCwd ApplyDir
ApplyInverted forall a b. (a -> b) -> a -> b
$
forall (a :: * -> * -> *) wX wY. [Char] -> FL a wX wY -> FL a wX wY
progressFL [Char]
"Applying inverse to pristine" FL (PatchInfoAnd rt p) wX wT
ps
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UpdatePending
upe forall a. Eq a => a -> a -> Bool
== UpdatePending
YesUpdatePending) forall a b. (a -> b) -> a -> b
$ do
[Char] -> IO ()
debugMessage [Char]
"Adding changes to pending..."
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
RepoPatch p =>
Repository rt p wR wU wT -> FL (PrimOf p) wT wY -> IO ()
writeTentativePending Repository rt p wR wU wX
r' forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect FL (PatchInfoAnd rt p) wX wT
ps forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (PrimOf p) wT wX
pend
forall (m :: * -> *) a. Monad m => a -> m a
return Repository rt p wR wU wX
r'
| Bool
otherwise = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
Old.oldRepoFailMsg
removeFromTentativeInventory :: forall rt p wR wU wT wX. (IsRepoType rt, RepoPatch p)
=> Repository rt p wR wU wT
-> Compression
-> FL (PatchInfoAnd rt p) wX wT
-> IO (Repository rt p wR wU wX)
removeFromTentativeInventory :: 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 (Repository rt p wR wU wX)
removeFromTentativeInventory Repository rt p wR wU wT
repo Compression
compr FL (PatchInfoAnd rt p) wX wT
to_remove = do
[Char] -> IO ()
debugMessage forall a b. (a -> b) -> a -> b
$ [Char]
"Start removeFromTentativeInventory"
PatchSet rt p Origin wT
allpatches :: PatchSet rt p Origin wT <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
Repository rt p wR wU wT -> [Char] -> IO (PatchSet rt p Origin wT)
readTentativeRepo Repository rt p wR wU wT
repo [Char]
"."
PatchSet rt p Origin wX
remaining :: PatchSet rt p Origin wX <-
case forall (p :: * -> * -> *) (rt :: RepoType) wX wY wStart.
(Commute p, Eq2 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
Maybe (PatchSet rt p Origin wX)
Nothing -> forall a. HasCallStack => [Char] -> a
error [Char]
"Hashed.removeFromTentativeInventory: precondition violated"
Just PatchSet rt p Origin wX
r -> forall (m :: * -> *) a. Monad m => a -> m a
return PatchSet rt p Origin wX
r
forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
Cache -> Compression -> PatchSet rt p Origin wX -> IO ()
writeTentativeInventory (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
[Char] -> IO ()
debugMessage forall a b. (a -> b) -> a -> b
$ [Char]
"Done removeFromTentativeInventory"
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wT'.
Repository rt p wR wU wT -> Repository rt p wR wU wT'
unsafeCoerceT Repository rt p wR wU wT
repo)
finalizeRepositoryChanges :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wR wU wT
-> UpdatePending
-> Compression
-> IO (Repository rt p wT wU wT)
finalizeRepositoryChanges :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> UpdatePending -> Compression -> IO (Repository rt p wT wU wT)
finalizeRepositoryChanges Repository rt p wR wU wT
r UpdatePending
updatePending Compression
compr
| RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
HashedInventory (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository rt p wR wU wT
r) =
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 forall a b. (a -> b) -> a -> b
$ do
[Char] -> IO ()
debugMessage [Char]
"Finalizing changes..."
forall a. IO a -> IO a
withSignalsBlocked forall a b. (a -> b) -> a -> b
$ do
[Char] -> [Char] -> IO ()
renameFile [Char]
tentativeRebasePath [Char]
rebasePath
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 <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO (Tree IO)
readRecorded Repository rt p wR wU wT
r
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> UpdatePending -> Tree IO -> IO ()
finalizePending Repository rt p wR wU wT
r UpdatePending
updatePending Tree IO
recordedState
let r' :: Repository rt p wR' wU wT
r' = forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wR'.
Repository rt p wR wU wT -> Repository rt p wR' wU wT
unsafeCoerceR Repository rt p wR wU wT
r
[Char] -> IO ()
debugMessage [Char]
"Done finalizing changes..."
PatchSet rt p Origin Any
ps <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo forall {wR'}. Repository rt p wR' wU wT
r'
Bool
pi_exists <- [Char] -> IO Bool
doesPatchIndexExist (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> [Char]
repoLocation forall {wR'}. Repository rt p wR' wU wT
r')
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
pi_exists forall a b. (a -> b) -> a -> b
$
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 forall {wR'}. Repository rt p wR' wU wT
r' PatchSet rt p Origin Any
ps
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` \IOError
e ->
Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ [Char]
"Cannot create or update patch index: "forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show IOError
e
forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO ()
updateIndex forall {wR'}. Repository rt p wR' wU wT
r'
forall (m :: * -> *) a. Monad m => a -> m a
return forall {wR'}. Repository rt p wR' wU wT
r'
| Bool
otherwise = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
Old.oldRepoFailMsg
revertRepositoryChanges :: RepoPatch p
=> Repository rt p wR wU wT
-> UpdatePending
-> IO (Repository rt p wR wU wR)
revertRepositoryChanges :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT
-> UpdatePending -> IO (Repository rt p wR wU wR)
revertRepositoryChanges Repository rt p wR wU wT
r UpdatePending
upe
| RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
HashedInventory (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository rt p wR wU wT
r) =
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 forall a b. (a -> b) -> a -> b
$ do
IO ()
checkIndexIsWritable
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` \IOError
e -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([[Char]] -> [Char]
unlines [[Char]
"Cannot write index", forall a. Show a => a -> [Char]
show IOError
e])
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> UpdatePending -> IO ()
revertPending Repository rt p wR wU wT
r UpdatePending
upe
IO ()
revertTentativeChanges
let r' :: Repository rt p wR wU wT'
r' = forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wT'.
Repository rt p wR wU wT -> Repository rt p wR wU wT'
unsafeCoerceT Repository rt p wR wU wT
r
forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
RepoPatch p =>
Repository rt p wR wU wR -> IO ()
revertTentativeRebase forall {wT'}. Repository rt p wR wU wT'
r'
forall (m :: * -> *) a. Monad m => a -> m a
return forall {wT'}. Repository rt p wR wU wT'
r'
| Bool
otherwise = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
Old.oldRepoFailMsg
revertTentativeRebase :: RepoPatch p => Repository rt p wR wU wR -> IO ()
revertTentativeRebase :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
RepoPatch p =>
Repository rt p wR wU wR -> IO ()
revertTentativeRebase Repository rt p wR wU wR
repo =
[Char] -> [Char] -> IO ()
copyFile [Char]
rebasePath [Char]
tentativeRebasePath
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` \IOError
e ->
if IOError -> Bool
isDoesNotExistError IOError
e then
forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
RepoPatch p =>
Repository rt p wR wU wR -> IO ()
createTentativeRebase Repository rt p wR wU wR
repo
else
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show IOError
e
checkIndexIsWritable :: IO ()
checkIndexIsWritable :: IO ()
checkIndexIsWritable = do
[Char] -> IO ()
checkWritable [Char]
indexInvalidPath
[Char] -> IO ()
checkWritable [Char]
indexPath
where
checkWritable :: [Char] -> IO ()
checkWritable [Char]
path = do
Bool
exists <- [Char] -> IO Bool
doesFileExist [Char]
path
[Char] -> IO ()
touchFile [Char]
path
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
removeFile [Char]
path
touchFile :: [Char] -> IO ()
touchFile [Char]
path = [Char] -> IOMode -> IO Handle
openBinaryFile [Char]
path IOMode
AppendMode forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> IO ()
hClose
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 :: 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
_ FL (PatchInfoAnd rt p) wX wT
NilFL = forall (m :: * -> *) a. Monad m => a -> m a
return ()
removeFromUnrevertContext Repository rt p wR wU wT
r FL (PatchInfoAnd rt p) wX wT
ps = do
Sealed Bundle rt p Any wX
bundle <- forall wB. IO (Sealed (Bundle rt p wB))
unrevert_patch_bundle forall a. IO a -> IO a -> IO a
`catchall` forall (m :: * -> *) a. Monad m => a -> m a
return (forall (a :: * -> *) wX. a wX -> Sealed a
seal (forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
(:>) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wX wY
-> Bundle rt p wX wY
Bundle (forall (a :: * -> * -> *) wX. FL a wX wX
NilFL forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)))
forall wA wB. Bundle rt p wA wB -> IO ()
remove_from_unrevert_context_ Bundle rt p Any wX
bundle
where unrevert_impossible :: IO ()
unrevert_impossible =
do Bool
confirmed <- [Char] -> IO Bool
promptYorn [Char]
"This operation will make unrevert impossible!\nProceed?"
if Bool
confirmed then forall p. FilePathLike p => p -> IO ()
removeFileMayNotExist [Char]
unrevertPath
else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Cancelled."
unrevert_patch_bundle :: IO (Sealed (Bundle rt p wB))
unrevert_patch_bundle :: forall wB. IO (Sealed (Bundle rt p wB))
unrevert_patch_bundle = do ByteString
pf <- [Char] -> IO ByteString
B.readFile [Char]
unrevertPath
case forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
ByteString -> Either [Char] (Sealed (Bundle rt p wX))
parseBundle ByteString
pf of
Right Sealed (Bundle rt p wB)
foo -> forall (m :: * -> *) a. Monad m => a -> m a
return Sealed (Bundle rt p wB)
foo
Left [Char]
err -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Couldn't parse unrevert patch:\n" forall a. [a] -> [a] -> [a]
++ [Char]
err
remove_from_unrevert_context_ :: Bundle rt p wA wB -> IO ()
remove_from_unrevert_context_ :: forall wA wB. Bundle rt p wA wB -> IO ()
remove_from_unrevert_context_ Bundle rt p wA wB
bundle =
do [Char] -> IO ()
debugMessage [Char]
"Adjusting the context of the unrevert changes..."
[Char] -> IO ()
debugMessage forall a b. (a -> b) -> a -> b
$ [Char]
"Removing "forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL (PatchInfoAnd rt p) wX wT
ps) forall a. [a] -> [a] -> [a]
++
[Char]
" patches in removeFromUnrevertContext!"
PatchSet rt p Origin wT
ref <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
Repository rt p wR wU wT -> [Char] -> IO (PatchSet rt p Origin wT)
readTentativeRepo Repository rt p wR wU wT
r (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> [Char]
repoLocation Repository rt p wR wU wT
r)
let withSinglet :: Sealed (FL ppp wXxx)
-> (forall wYyy . ppp wXxx wYyy -> IO ()) -> IO ()
withSinglet :: forall (ppp :: * -> * -> *) wXxx.
Sealed (FL ppp wXxx)
-> (forall wYyy. ppp wXxx wYyy -> IO ()) -> IO ()
withSinglet (Sealed (ppp wXxx wY
x :>: FL ppp wY wX
NilFL)) forall wYyy. ppp wXxx wYyy -> IO ()
j = forall wYyy. ppp wXxx wYyy -> IO ()
j ppp wXxx wY
x
withSinglet Sealed (FL ppp wXxx)
_ forall wYyy. ppp wXxx wYyy -> IO ()
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
Sealed PatchSet rt p Origin wX
bundle_ps <- forall wA wB.
PatchSet rt p Origin wT
-> Bundle rt p wA wB -> IO (Sealed (PatchSet rt p Origin))
bundle_to_patchset PatchSet rt p Origin wT
ref Bundle rt p wA wB
bundle
forall (ppp :: * -> * -> *) wXxx.
Sealed (FL ppp wXxx)
-> (forall wYyy. ppp wXxx wYyy -> IO ()) -> IO ()
withSinglet (forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
(Commute p, Merge p) =>
PatchSet rt p Origin wX
-> PatchSet rt p Origin wY -> Sealed (FL (PatchInfoAnd rt p) wX)
mergeThem PatchSet rt p Origin wT
ref PatchSet rt p Origin wX
bundle_ps) forall a b. (a -> b) -> a -> b
$ \PatchInfoAnd rt p wT wYyy
h_us ->
case forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) (RL p) p wX wY -> Maybe ((:>) p (RL p) wX wY)
commuteRL (forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL (PatchInfoAnd rt p) wX wT
ps forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> PatchInfoAnd rt p wT wYyy
h_us) of
Maybe ((:>) (PatchInfoAnd rt p) (RL (PatchInfoAnd rt p)) wX wYyy)
Nothing -> IO ()
unrevert_impossible
Just (PatchInfoAnd rt p wX wZ
us' :> RL (PatchInfoAnd rt p) wZ wYyy
_) ->
case forall (p :: * -> * -> *) (rt :: RepoType) wX wY wStart.
(Commute p, Eq2 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
Maybe (PatchSet rt p Origin wX)
Nothing -> IO ()
unrevert_impossible
Just PatchSet rt p Origin wX
common ->
do [Char] -> IO ()
debugMessage [Char]
"Have now found the new context..."
Doc
bundle' <- forall (p :: * -> * -> *) (rt :: RepoType) wStart wX wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Maybe (Tree IO)
-> PatchSet rt p wStart wX -> FL (Named p) wX wY -> IO Doc
makeBundle forall a. Maybe a
Nothing PatchSet rt p Origin wX
common (forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> p wA wB
hopefully PatchInfoAnd rt p wX wZ
us'forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
forall p. FilePathLike p => p -> Doc -> IO ()
writeDocBinFile [Char]
unrevertPath Doc
bundle'
[Char] -> IO ()
debugMessage [Char]
"Done adjusting the context of the unrevert changes!"
bundle_to_patchset :: PatchSet rt p Origin wT
-> Bundle rt p wA wB
-> IO (SealedPatchSet rt p Origin)
bundle_to_patchset :: forall wA wB.
PatchSet rt p Origin wT
-> Bundle rt p wA wB -> IO (Sealed (PatchSet rt p Origin))
bundle_to_patchset PatchSet rt p Origin wT
ref Bundle rt p wA wB
bundle =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> *) wX. a wX -> Sealed a
Sealed) forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) (rt :: RepoType) wT wA wB.
Commute p =>
PatchSet rt p Origin wT
-> Bundle rt p wA wB -> Either [Char] (PatchSet rt p Origin wB)
interpretBundle PatchSet rt p Origin wT
ref Bundle rt p wA wB
bundle
reorderInventory :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wR wU wR
-> Compression
-> IO ()
reorderInventory :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> Compression -> IO ()
reorderInventory Repository rt p wR wU wR
r Compression
compr
| RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
HashedInventory (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository rt p wR wU wR
r) = do
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
Commute p =>
PatchSet rt p wStart wX -> PatchSet rt p wStart wX
cleanLatestTag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` 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
r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
Cache -> Compression -> PatchSet rt p Origin wX -> IO ()
writeTentativeInventory (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p wR wU wR
r) Compression
compr
forall a. IO a -> IO a
withSignalsBlocked forall a b. (a -> b) -> a -> b
$ 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
r Compression
compr
| Bool
otherwise = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
Old.oldRepoFailMsg
readRepo :: (IsRepoType rt, RepoPatch p)
=> Repository rt p wR wU wT
-> IO (PatchSet rt p Origin wR)
readRepo :: 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
| RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
HashedInventory (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository rt p wR wU wT
r) = forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> [Char] -> IO (PatchSet rt p Origin wR)
readRepoHashed Repository rt p wR wU wT
r (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> [Char]
repoLocation Repository rt p wR wU wT
r)
| Bool
otherwise = do Sealed PatchSet rt p Origin wX
ps <- forall (p :: * -> * -> *) (rt :: RepoType).
RepoPatch p =>
[Char] -> IO (SealedPatchSet rt p Origin)
Old.readOldRepo (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> [Char]
repoLocation Repository rt p wR wU wT
r)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP PatchSet rt p Origin wX
ps
repoXor :: (IsRepoType rt, RepoPatch p)
=> Repository rt p wR wU wR -> IO SHA1
repoXor :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wR -> IO SHA1
repoXor Repository rt p wR wU wR
repo = do
[SHA1]
hashes <- forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL (PatchInfo -> SHA1
makePatchname forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> RL (PatchInfoAnd rt p) wStart wX
patchSet2RL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SHA1 -> SHA1 -> SHA1
sha1Xor SHA1
sha1zero [SHA1]
hashes
upgradeOldStyleRebase :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wR wU wT -> Compression -> IO ()
upgradeOldStyleRebase :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> Compression -> IO ()
upgradeOldStyleRebase Repository rt p wR wU wT
repo Compression
compr = do
PatchSet RL (Tagged rt p) Origin wX
ts RL (PatchInfoAnd rt p) wX wT
_ <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
Repository rt p wR wU wT -> [Char] -> IO (PatchSet rt p Origin wT)
readTentativeRepo Repository rt p wR wU wT
repo (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> [Char]
repoLocation Repository rt p wR wU wT
repo)
Inventory Maybe InventoryHash
_ [InventoryEntry]
invEntries <- [Char] -> IO Inventory
readInventoryPrivate [Char]
tentativeHashedInventoryPath
Sealed RL (PatchInfoAndG rt (WrappedNamed rt p)) wX wX
wps <- forall (np :: * -> * -> *) (rt :: RepoType) wX.
ReadPatch np =>
Cache
-> [InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG rt np) wX))
readPatchesFromInventory (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p wR wU wT
repo) [InventoryEntry]
invEntries
case forall (p :: * -> * -> *) (rt :: RepoType) wA wB.
RepoPatch p =>
RL (PiaW rt p) wA wB
-> Maybe ((:>) (RL (PiaW rt p)) (PiaW rt p) wA wB)
commuteOutOldStyleRebase RL (PatchInfoAndG rt (WrappedNamed rt p)) wX wX
wps of
Maybe
((:>)
(RL (PatchInfoAndG rt (WrappedNamed rt p)))
(PatchInfoAndG rt (WrappedNamed rt p))
wX
wX)
Nothing ->
Doc -> IO ()
ePutDocLn forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
"Rebase is already in new style, no upgrade needed."
Just (RL (PatchInfoAndG rt (WrappedNamed rt p)) wX wZ
wps' :> PiaW rt p wZ wX
wr) -> do
let update_repo :: IO ()
update_repo =
forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
Cache -> Compression -> PatchSet rt p Origin wX -> IO ()
writeTentativeInventory
(forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p wR wU wT
repo)
Compression
compr
(forall (rt :: RepoType) (p :: * -> * -> *) wY wY.
RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wX
ts (forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> RL a wX wZ -> RL b wX wZ
mapRL_RL (forall (p :: * -> * -> *) wX wY (q :: * -> * -> *)
(rt :: RepoType).
(p wX wY -> q wX wY)
-> PatchInfoAndG rt p wX wY -> PatchInfoAndG rt q wX wY
fmapPIAP forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
WrappedNamed rt p wX wY -> Named p wX wY
W.fromRebasing) RL (PatchInfoAndG rt (WrappedNamed rt p)) wX wZ
wps'))
case forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> p wA wB
hopefully PiaW rt p wZ wX
wr of
W.NormalP Named p wZ wX
wtf ->
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ Doc -> [Char]
renderString forall a b. (a -> b) -> a -> b
$
Doc
"internal error: expected rebase patch but found normal patch:"
Doc -> Doc -> Doc
$$ forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch Named p wZ wX
wtf
W.RebaseP PatchInfo
_ Suspended p wZ wZ
r -> do
IO ()
update_repo
Items FL (RebaseChange (PrimOf p)) Any wY
old_r <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> IO (Suspended p wT wT)
readTentativeRebase (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wT'.
Repository rt p wR wU wT -> Repository rt p wR wU wT'
unsafeCoerceT Repository rt p wR wU wT
repo)
case FL (RebaseChange (PrimOf p)) Any wY
old_r of
FL (RebaseChange (PrimOf p)) Any wY
NilFL -> do
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> Suspended p wT wT -> IO ()
writeTentativeRebase (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wT'.
Repository rt p wR wU wT -> Repository rt p wR wU wT'
unsafeCoerceT Repository rt p wR wU wT
repo) Suspended p wZ wZ
r
Repository rt p wT wU wT
_ <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> UpdatePending -> Compression -> IO (Repository rt p wT wU wT)
finalizeRepositoryChanges Repository rt p wR wU wT
repo UpdatePending
NoUpdatePending Compression
compr
RepoFormat -> [Char] -> IO ()
writeRepoFormat
( RepoProperty -> RepoFormat -> RepoFormat
addToFormat RepoProperty
RebaseInProgress_2_16
forall a b. (a -> b) -> a -> b
$ RepoProperty -> RepoFormat -> RepoFormat
removeFromFormat RepoProperty
RebaseInProgress
forall a b. (a -> b) -> a -> b
$ forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository rt p wR wU wT
repo)
[Char]
formatPath
forall (m :: * -> *) a. Monad m => a -> m a
return ()
FL (RebaseChange (PrimOf p)) Any wY
_ -> do
Doc -> IO ()
ePutDocLn
forall a b. (a -> b) -> a -> b
$ Doc
"A new-style rebase is already in progress, not overwriting it."
Doc -> Doc -> Doc
$$ Doc
"This should not have happened! This is the old-style rebase I found"
Doc -> Doc -> Doc
$$ Doc
"and removed from the repository:"
Doc -> Doc -> Doc
$$ forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch PiaW rt p wZ wX
wr