module Darcs.Repository.Inventory
( module Darcs.Repository.Inventory.Format
, readPatchesFromInventoryFile
, readPatchesFromInventory
, readSinglePatch
, readOneInventory
, writeInventory
, writePatchIfNecessary
, writeHashFile
) where
import Darcs.Prelude
import Control.Exception ( catch )
import Control.Monad ( unless )
import System.FilePath.Posix ( (</>) )
import System.IO ( hPutStrLn, stderr )
import System.IO.Unsafe ( unsafeInterleaveIO )
import Darcs.Patch ( RepoPatch, readPatch, showPatch )
import Darcs.Patch.Format ( PatchListFormat )
import Darcs.Patch.Info ( PatchInfo, displayPatchInfo, piName )
import Darcs.Patch.PatchInfoAnd
( PatchInfoAnd
, PatchInfoAndG
, createHashed
, extractHash
, info
, patchInfoAndPatch
)
import Darcs.Patch.Read ( ReadPatch )
import Darcs.Patch.Set ( Origin, PatchSet(..), SealedPatchSet, Tagged(..) )
import Darcs.Patch.Show ( ShowPatchFor(..) )
import Darcs.Patch.Witnesses.Ordered ( RL(..), mapRL )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), mapSeal, seal, unseal )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )
import Darcs.Repository.InternalTypes ( Repository, repoCache, repoLocation )
import Darcs.Repository.Inventory.Format
import Darcs.Util.Cache
( Cache
, fetchFileUsingCache
, peekInCache
, speculateFilesUsingCache
, writeFileUsingCache
)
import Darcs.Util.File ( Cachable(Uncachable), gzFetchFilePS )
import Darcs.Util.Printer ( Doc, renderPS, renderString, text, ($$) )
import Darcs.Util.Progress ( debugMessage, finishedOneIO )
readPatchesFromInventoryFile
:: (PatchListFormat p, ReadPatch p)
=> FilePath
-> Repository rt p wU wR
-> IO (PatchSet p Origin wS)
readPatchesFromInventoryFile :: forall (p :: * -> * -> *) (rt :: AccessType) wU wR wS.
(PatchListFormat p, ReadPatch p) =>
FilePath -> Repository rt p wU wR -> IO (PatchSet p Origin wS)
readPatchesFromInventoryFile FilePath
invPath Repository rt p wU wR
repo = do
let repodir :: FilePath
repodir = Repository rt p wU wR -> FilePath
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> FilePath
repoLocation Repository rt p wU wR
repo
Sealed PatchSet p Origin wX
ps <-
IO (Sealed (PatchSet p Origin))
-> (IOError -> IO (Sealed (PatchSet p Origin)))
-> IO (Sealed (PatchSet p Origin))
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
(FilePath -> IO Inventory
readInventoryPrivate (FilePath
repodir FilePath -> FilePath -> FilePath
</> FilePath
invPath) IO Inventory
-> (Inventory -> IO (Sealed (PatchSet p Origin)))
-> IO (Sealed (PatchSet p Origin))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Cache -> Inventory -> IO (Sealed (PatchSet p Origin))
forall (p :: * -> * -> *).
(PatchListFormat p, ReadPatch p) =>
Cache -> Inventory -> IO (SealedPatchSet p Origin)
readPatchesFromInventory (Repository rt p wU wR -> Cache
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> Cache
repoCache Repository rt p wU wR
repo))
(\IOError
e -> Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath
"Invalid repository: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
repodir) IO ()
-> IO (Sealed (PatchSet p Origin))
-> IO (Sealed (PatchSet p Origin))
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IOError -> IO (Sealed (PatchSet p Origin))
forall a. IOError -> IO a
ioError IOError
e)
PatchSet p Origin wS -> IO (PatchSet p Origin wS)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchSet p Origin wS -> IO (PatchSet p Origin wS))
-> PatchSet p Origin wS -> IO (PatchSet p Origin wS)
forall a b. (a -> b) -> a -> b
$ PatchSet p Origin wX -> PatchSet p Origin wS
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP PatchSet p Origin wX
ps
readPatchesFromInventory :: (PatchListFormat p, ReadPatch p)
=> Cache
-> Inventory
-> IO (SealedPatchSet p Origin)
readPatchesFromInventory :: forall (p :: * -> * -> *).
(PatchListFormat p, ReadPatch p) =>
Cache -> Inventory -> IO (SealedPatchSet p Origin)
readPatchesFromInventory Cache
cache = Inventory -> IO (SealedPatchSet p Origin)
forall (p :: * -> * -> *).
(PatchListFormat p, ReadPatch p) =>
Inventory -> IO (SealedPatchSet p Origin)
parseInv
where
parseInv :: (PatchListFormat p, ReadPatch p)
=> Inventory
-> IO (SealedPatchSet p Origin)
parseInv :: forall (p :: * -> * -> *).
(PatchListFormat p, ReadPatch p) =>
Inventory -> IO (SealedPatchSet p Origin)
parseInv (Inventory Maybe InventoryHash
Nothing [InventoryEntry]
ris) =
(forall wX.
RL (PatchInfoAndG (Named p)) Origin wX -> PatchSet p Origin wX)
-> Sealed (RL (PatchInfoAndG (Named p)) Origin)
-> Sealed (PatchSet p Origin)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal (RL (Tagged p) Origin Origin
-> RL (PatchInfoAndG (Named p)) Origin wX -> PatchSet p Origin wX
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin Origin
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL) (Sealed (RL (PatchInfoAndG (Named p)) Origin)
-> Sealed (PatchSet p Origin))
-> IO (Sealed (RL (PatchInfoAndG (Named p)) Origin))
-> IO (Sealed (PatchSet p Origin))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cache
-> [InventoryEntry]
-> IO (Sealed (RL (PatchInfoAndG (Named p)) Origin))
forall (np :: * -> * -> *) wX.
ReadPatch np =>
Cache -> [InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG np) wX))
readPatchesFromInventoryEntries Cache
cache [InventoryEntry]
ris
parseInv (Inventory (Just InventoryHash
h) []) =
FilePath -> IO (Sealed (PatchSet p Origin))
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO (Sealed (PatchSet p Origin)))
-> FilePath -> IO (Sealed (PatchSet p Origin))
forall a b. (a -> b) -> a -> b
$ FilePath
"bad inventory " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ InventoryHash -> FilePath
forall h. ValidHash h => h -> FilePath
encodeValidHash InventoryHash
h FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" (no tag) in parseInv!"
parseInv (Inventory (Just InventoryHash
h) (InventoryEntry
t : [InventoryEntry]
ris)) = do
Sealed RL (Tagged p) Origin wX
ts <- IO (Sealed (RL (Tagged p) Origin))
-> IO (Sealed (RL (Tagged p) Origin))
forall (p :: * -> * -> *) wX.
IO (Sealed (p wX)) -> IO (Sealed (p wX))
delaySealed (InventoryEntry
-> InventoryHash -> IO (Sealed (RL (Tagged p) Origin))
forall (p :: * -> * -> *).
(PatchListFormat p, ReadPatch p) =>
InventoryEntry
-> InventoryHash -> IO (Sealed (RL (Tagged p) Origin))
read_ts InventoryEntry
t InventoryHash
h)
Sealed RL (PatchInfoAndG (Named p)) wX wX
ps <- IO (Sealed (RL (PatchInfoAndG (Named p)) wX))
-> IO (Sealed (RL (PatchInfoAndG (Named p)) wX))
forall (p :: * -> * -> *) wX.
IO (Sealed (p wX)) -> IO (Sealed (p wX))
delaySealed (Cache
-> [InventoryEntry]
-> IO (Sealed (RL (PatchInfoAndG (Named p)) wX))
forall (np :: * -> * -> *) wX.
ReadPatch np =>
Cache -> [InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG np) wX))
readPatchesFromInventoryEntries Cache
cache [InventoryEntry]
ris)
Sealed (PatchSet p Origin) -> IO (Sealed (PatchSet p Origin))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (PatchSet p Origin) -> IO (Sealed (PatchSet p Origin)))
-> Sealed (PatchSet p Origin) -> IO (Sealed (PatchSet p Origin))
forall a b. (a -> b) -> a -> b
$ PatchSet p Origin wX -> Sealed (PatchSet p Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (PatchSet p Origin wX -> Sealed (PatchSet p Origin))
-> PatchSet p Origin wX -> Sealed (PatchSet p Origin)
forall a b. (a -> b) -> a -> b
$ RL (Tagged p) Origin wX
-> RL (PatchInfoAndG (Named p)) wX wX -> PatchSet p Origin wX
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
ts RL (PatchInfoAndG (Named p)) wX wX
ps
read_ts :: (PatchListFormat p, ReadPatch p) => InventoryEntry
-> InventoryHash -> IO (Sealed (RL (Tagged p) Origin))
read_ts :: forall (p :: * -> * -> *).
(PatchListFormat p, ReadPatch p) =>
InventoryEntry
-> InventoryHash -> IO (Sealed (RL (Tagged p) Origin))
read_ts InventoryEntry
tag0 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
$ InventoryHash -> IO Inventory
readTaggedInventory InventoryHash
h0
let is :: [InventoryEntry]
is = case Inventory
contents of
Inventory (Just InventoryHash
_) (InventoryEntry
_ : [InventoryEntry]
ris0) -> [InventoryEntry]
ris0
Inventory Maybe InventoryHash
Nothing [InventoryEntry]
ris0 -> [InventoryEntry]
ris0
Inventory (Just InventoryHash
_) [] -> FilePath -> [InventoryEntry]
forall a. HasCallStack => FilePath -> a
error FilePath
"inventory without tag!"
Sealed RL (Tagged p) Origin wX
ts <-
IO (Sealed (RL (Tagged p) Origin))
-> IO (Sealed (RL (Tagged p) Origin))
forall (p :: * -> * -> *) wX.
IO (Sealed (p wX)) -> IO (Sealed (p wX))
delaySealed (IO (Sealed (RL (Tagged p) Origin))
-> IO (Sealed (RL (Tagged p) Origin)))
-> IO (Sealed (RL (Tagged p) Origin))
-> IO (Sealed (RL (Tagged p) Origin))
forall a b. (a -> b) -> a -> b
$
case Inventory
contents of
Inventory (Just InventoryHash
h') (InventoryEntry
t' : [InventoryEntry]
_) -> InventoryEntry
-> InventoryHash -> IO (Sealed (RL (Tagged p) Origin))
forall (p :: * -> * -> *).
(PatchListFormat p, ReadPatch p) =>
InventoryEntry
-> InventoryHash -> IO (Sealed (RL (Tagged p) Origin))
read_ts InventoryEntry
t' InventoryHash
h'
Inventory (Just InventoryHash
_) [] -> FilePath -> IO (Sealed (RL (Tagged p) Origin))
forall a. HasCallStack => FilePath -> a
error FilePath
"inventory without tag!"
Inventory Maybe InventoryHash
Nothing [InventoryEntry]
_ -> Sealed (RL (Tagged p) Origin) -> IO (Sealed (RL (Tagged p) Origin))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (RL (Tagged p) Origin)
-> IO (Sealed (RL (Tagged p) Origin)))
-> Sealed (RL (Tagged p) Origin)
-> IO (Sealed (RL (Tagged p) Origin))
forall a b. (a -> b) -> a -> b
$ RL (Tagged p) Origin Origin -> Sealed (RL (Tagged p) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal RL (Tagged p) Origin Origin
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
Sealed RL (PatchInfoAndG (Named p)) wX wX
ps <- IO (Sealed (RL (PatchInfoAndG (Named p)) wX))
-> IO (Sealed (RL (PatchInfoAndG (Named p)) wX))
forall (p :: * -> * -> *) wX.
IO (Sealed (p wX)) -> IO (Sealed (p wX))
delaySealed (Cache
-> [InventoryEntry]
-> IO (Sealed (RL (PatchInfoAndG (Named p)) wX))
forall (np :: * -> * -> *) wX.
ReadPatch np =>
Cache -> [InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG np) wX))
readPatchesFromInventoryEntries Cache
cache [InventoryEntry]
is)
Sealed PatchInfoAnd p wX wX
tag00 <- InventoryEntry -> IO (Sealed (PatchInfoAnd p wX))
forall (p :: * -> * -> *) wX.
(PatchListFormat p, ReadPatch p) =>
InventoryEntry -> IO (Sealed (PatchInfoAnd p wX))
read_tag InventoryEntry
tag0
Sealed (RL (Tagged p) Origin) -> IO (Sealed (RL (Tagged p) Origin))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (RL (Tagged p) Origin)
-> IO (Sealed (RL (Tagged p) Origin)))
-> Sealed (RL (Tagged p) Origin)
-> IO (Sealed (RL (Tagged p) Origin))
forall a b. (a -> b) -> a -> b
$ RL (Tagged p) Origin wX -> Sealed (RL (Tagged p) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (RL (Tagged p) Origin wX -> Sealed (RL (Tagged p) Origin))
-> RL (Tagged p) Origin wX -> Sealed (RL (Tagged p) Origin)
forall a b. (a -> b) -> a -> b
$ RL (Tagged p) Origin wX
ts RL (Tagged p) Origin wX
-> Tagged p wX wX -> RL (Tagged p) Origin wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: RL (PatchInfoAndG (Named p)) wX wX
-> PatchInfoAnd p wX wX -> Maybe InventoryHash -> Tagged p wX wX
forall (p :: * -> * -> *) wX wY wZ.
RL (PatchInfoAnd p) wX wY
-> PatchInfoAnd p wY wZ -> Maybe InventoryHash -> Tagged p wX wZ
Tagged RL (PatchInfoAndG (Named p)) wX wX
ps PatchInfoAnd p wX wX
tag00 (InventoryHash -> Maybe InventoryHash
forall a. a -> Maybe a
Just InventoryHash
h0)
read_tag :: (PatchListFormat p, ReadPatch p) => InventoryEntry
-> IO (Sealed (PatchInfoAnd p wX))
read_tag :: forall (p :: * -> * -> *) wX.
(PatchListFormat p, ReadPatch p) =>
InventoryEntry -> IO (Sealed (PatchInfoAnd p wX))
read_tag (PatchInfo
i, PatchHash
h) =
(forall wX. Hopefully (Named p) wX wX -> PatchInfoAnd p wX wX)
-> Sealed (Hopefully (Named p) wX) -> Sealed (PatchInfoAnd p wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal (PatchInfo
-> Hopefully (Named p) wX wX -> PatchInfoAndG (Named p) wX wX
forall (p :: * -> * -> *) wA wB.
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG p wA wB
patchInfoAndPatch PatchInfo
i) (Sealed (Hopefully (Named p) wX) -> Sealed (PatchInfoAnd p wX))
-> IO (Sealed (Hopefully (Named p) wX))
-> IO (Sealed (PatchInfoAnd p wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PatchHash
-> (PatchHash -> IO (Sealed (Named p wX)))
-> IO (Sealed (Hopefully (Named p) wX))
forall (a :: * -> * -> *) wX.
PatchHash
-> (PatchHash -> IO (Sealed (a wX)))
-> IO (Sealed (Hopefully a wX))
createHashed PatchHash
h (Cache -> PatchInfo -> PatchHash -> IO (Sealed (Named p wX))
forall (p :: * -> * -> *) wX.
ReadPatch p =>
Cache -> PatchInfo -> PatchHash -> IO (Sealed (p wX))
readSinglePatch Cache
cache PatchInfo
i)
readTaggedInventory :: InventoryHash -> IO Inventory
readTaggedInventory :: InventoryHash -> IO Inventory
readTaggedInventory InventoryHash
invHash = do
(FilePath
fileName, ByteString
inventory) <- Cache -> InventoryHash -> IO (FilePath, ByteString)
forall h. ValidHash h => Cache -> h -> IO (FilePath, ByteString)
fetchFileUsingCache Cache
cache InventoryHash
invHash
case ByteString -> Either FilePath Inventory
parseInventory ByteString
inventory of
Right Inventory
r -> Inventory -> IO Inventory
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Inventory
r
Left FilePath
e -> FilePath -> IO Inventory
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO Inventory) -> FilePath -> IO Inventory
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines [[FilePath] -> FilePath
unwords [FilePath
"parse error in file", FilePath
fileName],FilePath
e]
readPatchesFromInventoryEntries :: ReadPatch np
=> Cache
-> [InventoryEntry]
-> IO (Sealed (RL (PatchInfoAndG np) wX))
readPatchesFromInventoryEntries :: forall (np :: * -> * -> *) wX.
ReadPatch np =>
Cache -> [InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG np) wX))
readPatchesFromInventoryEntries Cache
cache [InventoryEntry]
ris = [InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG np) wX))
forall {p :: * -> * -> *} {wX}.
ReadPatch p =>
[InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG p) wX))
read_patches ([InventoryEntry] -> [InventoryEntry]
forall a. [a] -> [a]
reverse [InventoryEntry]
ris)
where
read_patches :: [InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG p) wX))
read_patches [] = Sealed (RL (PatchInfoAndG p) wX)
-> IO (Sealed (RL (PatchInfoAndG p) wX))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (RL (PatchInfoAndG p) wX)
-> IO (Sealed (RL (PatchInfoAndG p) wX)))
-> Sealed (RL (PatchInfoAndG p) wX)
-> IO (Sealed (RL (PatchInfoAndG p) wX))
forall a b. (a -> b) -> a -> b
$ RL (PatchInfoAndG p) wX wX -> Sealed (RL (PatchInfoAndG p) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal RL (PatchInfoAndG p) wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
read_patches allis :: [InventoryEntry]
allis@((PatchInfo
i1, PatchHash
h1) : [InventoryEntry]
is1) =
(forall wY wZ.
Hopefully p wY wZ
-> RL (PatchInfoAndG p) wX wY -> RL (PatchInfoAndG p) wX wZ)
-> IO (Sealed (RL (PatchInfoAndG p) wX))
-> (forall wB. IO (Sealed (Hopefully p wB)))
-> IO (Sealed (RL (PatchInfoAndG 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 (\Hopefully p wY wZ
p RL (PatchInfoAndG p) wX wY
rest -> RL (PatchInfoAndG p) wX wY
rest RL (PatchInfoAndG p) wX wY
-> PatchInfoAndG p wY wZ -> RL (PatchInfoAndG p) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfo
i1 PatchInfo -> Hopefully p wY wZ -> PatchInfoAndG p wY wZ
forall (p :: * -> * -> *) wA wB.
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG p wA wB
`patchInfoAndPatch` Hopefully p wY wZ
p) ([InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG p) wX))
forall {p :: * -> * -> *} {wX}.
ReadPatch p =>
[InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG p) wX))
rp [InventoryEntry]
is1)
(PatchHash
-> (PatchHash -> IO (Sealed (p wB)))
-> IO (Sealed (Hopefully p wB))
forall (a :: * -> * -> *) wX.
PatchHash
-> (PatchHash -> IO (Sealed (a wX)))
-> IO (Sealed (Hopefully a wX))
createHashed PatchHash
h1 (IO (Sealed (p wB)) -> PatchHash -> IO (Sealed (p wB))
forall a b. a -> b -> a
const (IO (Sealed (p wB)) -> PatchHash -> IO (Sealed (p wB)))
-> IO (Sealed (p wB)) -> PatchHash -> IO (Sealed (p wB))
forall a b. (a -> b) -> a -> b
$ PatchHash -> [InventoryEntry] -> PatchInfo -> IO (Sealed (p wB))
forall {p :: * -> * -> *} {wX}.
ReadPatch p =>
PatchHash -> [InventoryEntry] -> PatchInfo -> IO (Sealed (p wX))
speculateAndParse PatchHash
h1 [InventoryEntry]
allis PatchInfo
i1))
where
rp :: [InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG p) wX))
rp [] = Sealed (RL (PatchInfoAndG p) wX)
-> IO (Sealed (RL (PatchInfoAndG p) wX))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (RL (PatchInfoAndG p) wX)
-> IO (Sealed (RL (PatchInfoAndG p) wX)))
-> Sealed (RL (PatchInfoAndG p) wX)
-> IO (Sealed (RL (PatchInfoAndG p) wX))
forall a b. (a -> b) -> a -> b
$ RL (PatchInfoAndG p) wX wX -> Sealed (RL (PatchInfoAndG p) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal RL (PatchInfoAndG p) wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
rp [(PatchInfo
i, PatchHash
h), (PatchInfo
il, PatchHash
hl)] =
(forall wY wZ.
Hopefully p wY wZ
-> RL (PatchInfoAndG p) wX wY -> RL (PatchInfoAndG p) wX wZ)
-> IO (Sealed (RL (PatchInfoAndG p) wX))
-> (forall wB. IO (Sealed (Hopefully p wB)))
-> IO (Sealed (RL (PatchInfoAndG 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 (\Hopefully p wY wZ
p RL (PatchInfoAndG p) wX wY
rest -> RL (PatchInfoAndG p) wX wY
rest RL (PatchInfoAndG p) wX wY
-> PatchInfoAndG p wY wZ -> RL (PatchInfoAndG p) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfo
i PatchInfo -> Hopefully p wY wZ -> PatchInfoAndG p wY wZ
forall (p :: * -> * -> *) wA wB.
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG p wA wB
`patchInfoAndPatch` Hopefully p wY wZ
p)
([InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG p) wX))
rp [(PatchInfo
il, PatchHash
hl)])
(PatchHash
-> (PatchHash -> IO (Sealed (p wB)))
-> IO (Sealed (Hopefully p wB))
forall (a :: * -> * -> *) wX.
PatchHash
-> (PatchHash -> IO (Sealed (a wX)))
-> IO (Sealed (Hopefully a wX))
createHashed PatchHash
h
(IO (Sealed (p wB)) -> PatchHash -> IO (Sealed (p wB))
forall a b. a -> b -> a
const (IO (Sealed (p wB)) -> PatchHash -> IO (Sealed (p wB)))
-> IO (Sealed (p wB)) -> PatchHash -> IO (Sealed (p wB))
forall a b. (a -> b) -> a -> b
$ PatchHash -> [InventoryEntry] -> PatchInfo -> IO (Sealed (p wB))
forall {p :: * -> * -> *} {wX}.
ReadPatch p =>
PatchHash -> [InventoryEntry] -> PatchInfo -> IO (Sealed (p wX))
speculateAndParse PatchHash
h ([InventoryEntry] -> [InventoryEntry]
forall a. [a] -> [a]
reverse [InventoryEntry]
allis) PatchInfo
i))
rp ((PatchInfo
i, PatchHash
h) : [InventoryEntry]
is) =
(forall wY wZ.
Hopefully p wY wZ
-> RL (PatchInfoAndG p) wX wY -> RL (PatchInfoAndG p) wX wZ)
-> IO (Sealed (RL (PatchInfoAndG p) wX))
-> (forall wB. IO (Sealed (Hopefully p wB)))
-> IO (Sealed (RL (PatchInfoAndG 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 (\Hopefully p wY wZ
p RL (PatchInfoAndG p) wX wY
rest -> RL (PatchInfoAndG p) wX wY
rest RL (PatchInfoAndG p) wX wY
-> PatchInfoAndG p wY wZ -> RL (PatchInfoAndG p) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfo
i PatchInfo -> Hopefully p wY wZ -> PatchInfoAndG p wY wZ
forall (p :: * -> * -> *) wA wB.
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG p wA wB
`patchInfoAndPatch` Hopefully p wY wZ
p)
([InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG p) wX))
rp [InventoryEntry]
is)
(PatchHash
-> (PatchHash -> IO (Sealed (p wB)))
-> IO (Sealed (Hopefully p wB))
forall (a :: * -> * -> *) wX.
PatchHash
-> (PatchHash -> IO (Sealed (a wX)))
-> IO (Sealed (Hopefully a wX))
createHashed PatchHash
h (Cache -> PatchInfo -> PatchHash -> IO (Sealed (p wB))
forall (p :: * -> * -> *) wX.
ReadPatch p =>
Cache -> PatchInfo -> PatchHash -> IO (Sealed (p wX))
readSinglePatch Cache
cache PatchInfo
i))
lift2Sealed :: (forall wY wZ . q wY wZ -> p wX wY -> r wX wZ)
-> IO (Sealed (p wX))
-> (forall wB . IO (Sealed (q wB)))
-> IO (Sealed (r wX))
lift2Sealed :: forall (q :: * -> * -> *) (p :: * -> * -> *) wX (r :: * -> * -> *).
(forall wY wZ. q wY wZ -> p wX wY -> r wX wZ)
-> IO (Sealed (p wX))
-> (forall wB. IO (Sealed (q wB)))
-> IO (Sealed (r wX))
lift2Sealed forall wY wZ. q wY wZ -> p wX wY -> r wX wZ
f IO (Sealed (p wX))
iox forall wB. IO (Sealed (q wB))
ioy = do
Sealed p wX wX
x <- IO (Sealed (p wX)) -> IO (Sealed (p wX))
forall (p :: * -> * -> *) wX.
IO (Sealed (p wX)) -> IO (Sealed (p wX))
delaySealed IO (Sealed (p wX))
iox
Sealed q wX wX
y <- IO (Sealed (q wX)) -> IO (Sealed (q wX))
forall (p :: * -> * -> *) wX.
IO (Sealed (p wX)) -> IO (Sealed (p wX))
delaySealed IO (Sealed (q wX))
forall wB. IO (Sealed (q wB))
ioy
Sealed (r wX) -> IO (Sealed (r wX))
forall a. a -> IO a
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 -> [InventoryEntry] -> PatchInfo -> IO (Sealed (p wX))
speculateAndParse PatchHash
h [InventoryEntry]
is PatchInfo
i = PatchHash -> [InventoryEntry] -> IO ()
speculate PatchHash
h [InventoryEntry]
is IO () -> IO (Sealed (p wX)) -> IO (Sealed (p wX))
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Cache -> PatchInfo -> PatchHash -> IO (Sealed (p wX))
forall (p :: * -> * -> *) wX.
ReadPatch p =>
Cache -> PatchInfo -> PatchHash -> IO (Sealed (p wX))
readSinglePatch Cache
cache PatchInfo
i PatchHash
h
speculate :: PatchHash -> [InventoryEntry] -> IO ()
speculate :: PatchHash -> [InventoryEntry] -> IO ()
speculate PatchHash
pHash [InventoryEntry]
is = do
Bool
already_got_one <- Cache -> PatchHash -> IO Bool
forall h. ValidHash h => Cache -> h -> IO Bool
peekInCache Cache
cache PatchHash
pHash
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 -> [PatchHash] -> IO ()
forall h. ValidHash h => Cache -> [h] -> IO ()
speculateFilesUsingCache Cache
cache ((InventoryEntry -> PatchHash) -> [InventoryEntry] -> [PatchHash]
forall a b. (a -> b) -> [a] -> [b]
map InventoryEntry -> PatchHash
forall a b. (a, b) -> b
snd [InventoryEntry]
is)
delaySealed :: IO (Sealed (p wX)) -> IO (Sealed (p wX))
delaySealed :: forall (p :: * -> * -> *) wX.
IO (Sealed (p wX)) -> IO (Sealed (p wX))
delaySealed = (Sealed (p wX) -> Sealed (p wX))
-> IO (Sealed (p wX)) -> IO (Sealed (p wX))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((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 p wX wX -> Sealed (p wX)
forall wX. p wX wX -> Sealed (p wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal) (IO (Sealed (p wX)) -> IO (Sealed (p wX)))
-> (IO (Sealed (p wX)) -> IO (Sealed (p wX)))
-> IO (Sealed (p wX))
-> IO (Sealed (p wX))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Sealed (p wX)) -> IO (Sealed (p wX))
forall a. IO a -> IO a
unsafeInterleaveIO
readSinglePatch :: ReadPatch p
=> Cache
-> PatchInfo -> PatchHash -> IO (Sealed (p wX))
readSinglePatch :: forall (p :: * -> * -> *) wX.
ReadPatch p =>
Cache -> PatchInfo -> PatchHash -> IO (Sealed (p wX))
readSinglePatch Cache
cache PatchInfo
i PatchHash
h = do
FilePath -> IO ()
debugMessage (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Reading patch file for: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PatchInfo -> FilePath
piName PatchInfo
i
(FilePath
fn, ByteString
ps) <- Cache -> PatchHash -> IO (FilePath, ByteString)
forall h. ValidHash h => Cache -> h -> IO (FilePath, ByteString)
fetchFileUsingCache Cache
cache PatchHash
h
case ByteString -> Either FilePath (Sealed (p wX))
forall (p :: * -> * -> *) wX.
ReadPatch p =>
ByteString -> Either FilePath (Sealed (p wX))
readPatch ByteString
ps of
Right Sealed (p wX)
p -> Sealed (p wX) -> IO (Sealed (p wX))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Sealed (p wX)
p
Left FilePath
e -> FilePath -> IO (Sealed (p wX))
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO (Sealed (p wX))) -> FilePath -> IO (Sealed (p wX))
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines
[ FilePath
"Couldn't parse file " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fn
, FilePath
"which is patch"
, Doc -> FilePath
renderString (Doc -> FilePath) -> Doc -> FilePath
forall a b. (a -> b) -> a -> b
$ PatchInfo -> Doc
displayPatchInfo PatchInfo
i
, FilePath
e
]
readOneInventory :: ReadPatch p
=> Cache -> FilePath -> IO (Sealed (RL (PatchInfoAndG p) wX))
readOneInventory :: forall (p :: * -> * -> *) wX.
ReadPatch p =>
Cache -> FilePath -> IO (Sealed (RL (PatchInfoAndG p) wX))
readOneInventory Cache
cache FilePath
path = do
Inventory Maybe InventoryHash
_ [InventoryEntry]
invEntries <- FilePath -> IO Inventory
readInventoryPrivate FilePath
path
Cache -> [InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG p) wX))
forall (np :: * -> * -> *) wX.
ReadPatch np =>
Cache -> [InventoryEntry] -> IO (Sealed (RL (PatchInfoAndG np) wX))
readPatchesFromInventoryEntries Cache
cache [InventoryEntry]
invEntries
readInventoryPrivate :: FilePath -> IO Inventory
readInventoryPrivate :: FilePath -> IO Inventory
readInventoryPrivate FilePath
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
<$> FilePath -> Cachable -> IO ByteString
gzFetchFilePS FilePath
path Cachable
Uncachable
case ByteString -> Either FilePath Inventory
parseInventory ByteString
inv of
Right Inventory
r -> Inventory -> IO Inventory
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Inventory
r
Left FilePath
e -> FilePath -> IO Inventory
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO Inventory) -> FilePath -> IO Inventory
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines [[FilePath] -> FilePath
unwords [FilePath
"parse error in file", FilePath
path],FilePath
e]
writeInventory :: RepoPatch p => String -> Cache
-> PatchSet p Origin wX -> IO InventoryHash
writeInventory :: forall (p :: * -> * -> *) wX.
RepoPatch p =>
FilePath -> Cache -> PatchSet p Origin wX -> IO InventoryHash
writeInventory FilePath
tediousName Cache
cache = PatchSet p Origin wX -> IO InventoryHash
forall (p :: * -> * -> *) wX.
RepoPatch p =>
PatchSet p Origin wX -> IO InventoryHash
go
where
go :: RepoPatch p => PatchSet p Origin wX -> IO InventoryHash
go :: forall (p :: * -> * -> *) wX.
RepoPatch p =>
PatchSet p Origin wX -> IO InventoryHash
go (PatchSet RL (Tagged p) Origin wX
ts RL (PatchInfoAnd p) wX wX
ps) = do
[InventoryEntry]
entries <- [IO InventoryEntry] -> IO [InventoryEntry]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([IO InventoryEntry] -> IO [InventoryEntry])
-> [IO InventoryEntry] -> IO [InventoryEntry]
forall a b. (a -> b) -> a -> b
$ (forall wW wZ. PatchInfoAnd p wW wZ -> IO InventoryEntry)
-> RL (PatchInfoAnd p) wX wX -> [IO InventoryEntry]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL (Cache -> PatchInfoAndG (Named p) wW wZ -> IO InventoryEntry
forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
Cache -> PatchInfoAnd p wX wY -> IO InventoryEntry
writePatchIfNecessary Cache
cache) RL (PatchInfoAnd p) wX wX
ps
Doc
content <- RL (Tagged p) Origin wX -> [InventoryEntry] -> IO Doc
forall {p :: * -> * -> *} {wZ}.
(ApplyState p ~ ApplyState (PrimOf p), Check p, Conflict p,
Effect p, FromPrim p, IsHunk p, Merge p, PrimPatchBase p,
Summary p, ToPrim p, Unwind p, PatchInspect p, RepairToFL p,
Commute p, Eq2 p, ReadPatch p, ShowPatch p, ShowContextPatch p,
PatchListFormat p) =>
RL (Tagged p) Origin wZ -> [InventoryEntry] -> IO Doc
write_ts RL (Tagged p) Origin wX
ts [InventoryEntry]
entries
Cache -> Doc -> IO InventoryHash
forall h. ValidHash h => Cache -> Doc -> IO h
writeHashFile Cache
cache Doc
content
write_ts :: RL (Tagged p) Origin wZ -> [InventoryEntry] -> IO Doc
write_ts RL (Tagged p) Origin wZ
NilRL [InventoryEntry]
entries = Doc -> IO Doc
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> IO Doc) -> Doc -> IO Doc
forall a b. (a -> b) -> a -> b
$ [InventoryEntry] -> Doc
showInventoryPatches ([InventoryEntry] -> [InventoryEntry]
forall a. [a] -> [a]
reverse [InventoryEntry]
entries)
write_ts (RL (Tagged p) Origin wY
tts :<: Tagged RL (PatchInfoAnd p) wY wY
tps PatchInfoAnd p wY wZ
t Maybe InventoryHash
maybeHash) [InventoryEntry]
entries = do
InventoryHash
parenthash <- IO InventoryHash
-> (InventoryHash -> IO InventoryHash)
-> Maybe InventoryHash
-> IO InventoryHash
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PatchSet p Origin wY -> IO InventoryHash
forall (p :: * -> * -> *) wX.
RepoPatch p =>
PatchSet p Origin wX -> IO InventoryHash
go (RL (Tagged p) Origin wY
-> RL (PatchInfoAnd p) wY wY -> PatchSet p Origin wY
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wY
tts RL (PatchInfoAnd p) wY wY
tps)) InventoryHash -> IO InventoryHash
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InventoryHash
maybeHash
let parenthash_str :: FilePath
parenthash_str = InventoryHash -> FilePath
forall h. ValidHash h => h -> FilePath
encodeValidHash InventoryHash
parenthash
FilePath -> FilePath -> IO ()
finishedOneIO FilePath
tediousName FilePath
parenthash_str
InventoryEntry
tag_entry <- Cache -> PatchInfoAnd p wY wZ -> IO InventoryEntry
forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
Cache -> PatchInfoAnd p wX wY -> IO InventoryEntry
writePatchIfNecessary Cache
cache PatchInfoAnd p wY wZ
t
Doc -> IO Doc
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> IO Doc) -> Doc -> IO Doc
forall a b. (a -> b) -> a -> b
$
FilePath -> Doc
text (FilePath
"Starting with inventory:\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
parenthash_str) Doc -> Doc -> Doc
$$
[InventoryEntry] -> Doc
showInventoryPatches (InventoryEntry
tag_entry InventoryEntry -> [InventoryEntry] -> [InventoryEntry]
forall a. a -> [a] -> [a]
: [InventoryEntry] -> [InventoryEntry]
forall a. [a] -> [a]
reverse [InventoryEntry]
entries)
writePatchIfNecessary :: RepoPatch p => Cache
-> PatchInfoAnd p wX wY -> IO InventoryEntry
writePatchIfNecessary :: forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
Cache -> PatchInfoAnd p wX wY -> IO InventoryEntry
writePatchIfNecessary Cache
c PatchInfoAnd p wX wY
hp = PatchInfo
infohp PatchInfo -> IO InventoryEntry -> IO InventoryEntry
forall a b. a -> b -> b
`seq`
case PatchInfoAnd p wX wY -> Either (Named p wX wY) PatchHash
forall (p :: * -> * -> *) wA wB.
PatchInfoAndG p wA wB -> Either (p wA wB) PatchHash
extractHash PatchInfoAnd p wX wY
hp of
Right PatchHash
h -> InventoryEntry -> IO InventoryEntry
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchInfo
infohp, PatchHash
h)
Left Named p wX wY
p ->
(PatchInfo
infohp,) (PatchHash -> InventoryEntry) -> IO PatchHash -> IO InventoryEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Cache -> Doc -> IO PatchHash
forall h. ValidHash h => Cache -> Doc -> IO h
writeHashFile Cache
c (ShowPatchFor -> Named p wX wY -> Doc
forall wX wY. ShowPatchFor -> Named p wX wY -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForStorage Named p wX wY
p)
where
infohp :: PatchInfo
infohp = PatchInfoAnd p wX wY -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAnd p wX wY
hp
writeHashFile :: ValidHash h => Cache -> Doc -> IO h
writeHashFile :: forall h. ValidHash h => Cache -> Doc -> IO h
writeHashFile Cache
c Doc
d = Cache -> ByteString -> IO h
forall h. ValidHash h => Cache -> ByteString -> IO h
writeFileUsingCache Cache
c (Doc -> ByteString
renderPS Doc
d)