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 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)
  return $ unsafeCoerceP 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 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 ps <- delaySealed (readPatchesFromInventoryEntries cache ris)
        return $ seal $ PatchSet ts 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
        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 = 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 ts <-
            delaySealed $
                case 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 ps <- delaySealed (readPatchesFromInventoryEntries cache is)
        Sealed tag00 <- read_tag tag0
        return $ seal $ ts :<: Tagged ps tag00 (Just 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
        (fileName, inventory) <- Cache -> InventoryHash -> IO (FilePath, ByteString)
forall h. ValidHash h => Cache -> h -> IO (FilePath, ByteString)
fetchFileUsingCache Cache
cache InventoryHash
invHash
        case parseInventory 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 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 y <- delaySealed ioy
        return $ seal $ f y 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
        already_got_one <- Cache -> PatchHash -> IO Bool
forall h. ValidHash h => Cache -> h -> IO Bool
peekInCache Cache
cache PatchHash
pHash
        unless already_got_one $
            speculateFilesUsingCache cache (map snd 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
    (fn, ps) <- Cache -> PatchHash -> IO (FilePath, ByteString)
forall h. ValidHash h => Cache -> h -> IO (FilePath, ByteString)
fetchFileUsingCache Cache
cache PatchHash
h
    case readPatch 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 _ invEntries <- FilePath -> IO Inventory
readInventoryPrivate FilePath
path
  readPatchesFromInventoryEntries cache 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
    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 parseInventory 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
      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
      content <- write_ts ts entries
      writeHashFile cache 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
      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 = InventoryHash -> FilePath
forall h. ValidHash h => h -> FilePath
encodeValidHash InventoryHash
parenthash
      finishedOneIO tediousName parenthash_str
      tag_entry <- writePatchIfNecessary cache t
      return $
        text ("Starting with inventory:\n" ++ parenthash_str) $$
        showInventoryPatches (tag_entry : reverse 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)