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
hashedInventory, hashedInventoryPath :: String
hashedInventory :: String
hashedInventory = "hashed_inventory"
hashedInventoryPath :: String
hashedInventoryPath = String -> String
makeDarcsdirPath String
hashedInventory
tentativeHashedInventory, tentativeHashedInventoryPath :: String
tentativeHashedInventory :: String
tentativeHashedInventory = "tentative_hashed_inventory"
tentativeHashedInventoryPath :: String
tentativeHashedInventoryPath = String -> String
makeDarcsdirPath String
tentativeHashedInventory
inventoriesDir, inventoriesDirPath :: String
inventoriesDir :: String
inventoriesDir = "inventories"
inventoriesDirPath :: String
inventoriesDirPath = String -> String
makeDarcsdirPath String
inventoriesDir
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
patchesDir, patchesDirPath :: String
patchesDir :: String
patchesDir = "patches"
patchesDirPath :: String
patchesDirPath = String -> String
makeDarcsdirPath String
patchesDir
data DirLayout = PlainLayout | BucketedLayout
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
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
Tree IO
old <- String -> (Maybe Int, Hash) -> IO (Tree IO)
readDarcsHashed String
pristineDirPath (Maybe Int, Hash)
oldrootSizeandHash
Hash
root <- Tree IO -> String -> IO Hash
writeDarcsHashed Tree IO
old String
pristineDirPath
let newroot :: String
newroot = Hash -> String
hash2root Hash
root
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..."
Hash -> IO String
tryApply Hash
root
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 :: (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..."
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
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
String -> String -> IO ()
renameFile String
tentativeHashedInventoryPath String
hashedInventoryPath
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 :: 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 :: 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 []
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 :: 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)
specialPatches :: [FilePath]
specialPatches :: [String]
specialPatches = ["unrevert", "pending", "pending.tentative"]
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 :: 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
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
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 :: 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
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
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 :: (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
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) []) =
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]
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]
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
String -> IO ()
debugMessage "Done copying hashed inventory."
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 :: 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 :: 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
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
:: (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 :: 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
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
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 :: 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)
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 :: String -> String -> IO [String]
listPatchesLocalBucketed :: String -> String -> IO [String]
listPatchesLocalBucketed = DirLayout -> String -> String -> IO [String]
listPatchesLocal DirLayout
BucketedLayout
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 :: 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
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 :: (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
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)
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
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
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
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
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
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."
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 =
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:_) ->
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
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
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