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 )

-- | Read a 'PatchSet' starting with a specific inventory inside a 'Repository'.
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

-- | Read a complete 'PatchSet' from a 'Cache', by following the chain of
-- 'Inventory's, starting with the given one.
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) []) =
        -- TODO could be more tolerant and create a larger PatchSet
        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]

-- | Read patches from a 'Cache' as specified by a list of 'InventoryEntry'.
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)

-- | We have to unseal and then reseal, otherwise the 'unsafeInterleaveIO' has
-- no effect.
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

-- | Read a single patch from a 'Cache', given its 'PatchInfo' and 'PatchHash'.
-- Fails with an error message if the patch file cannot be parsed.
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

-- | Read an 'Inventory' from a file. Fails with an error message if
-- file is not there or cannot be parsed.
readInventoryPrivate :: FilePath -> IO Inventory
readInventoryPrivate :: 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
      -- if the Tagged has a hash, then we know that it has already been
      -- written; otherwise recurse without the tag
      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)

-- | Write a 'PatchInfoAnd' to disk and return an 'InventoryEntry' i.e. the
-- patch info and hash. However, if we patch already contains a hash, assume it
-- has already been written to disk at some point and merely return the info
-- and hash.
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

-- | Wrapper around 'writeFileUsingCache' that takes a 'Doc' instead of a
-- 'ByteString'.
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)