-- Copyright (C) 2006-2007 David Roundy
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2, or (at your option)
-- any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program; if not, write to the Free Software Foundation,
-- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
{-# LANGUAGE OverloadedStrings #-}
module Darcs.Repository.Hashed
    ( revertTentativeChanges
    , revertRepositoryChanges
    , finalizeTentativeChanges
    , addToTentativeInventory
    , readRepo
    , readRepoHashed
    , readTentativeRepo
    , writeAndReadPatch
    , writeTentativeInventory
    , copyHashedInventory
    , writePatchIfNecessary
    , tentativelyAddPatch
    , tentativelyRemovePatches
    , tentativelyRemovePatches_
    , tentativelyAddPatch_
    , tentativelyAddPatches_
    , finalizeRepositoryChanges
    , reorderInventory
    , UpdatePristine(..)
    , repoXor
    , upgradeOldStyleRebase
    ) where

import Darcs.Prelude

import Control.Exception ( catch )
import Darcs.Util.Exception ( catchall )
import Control.Monad ( when, unless )
import Data.Maybe
import Data.List( foldl' )

import qualified Data.ByteString as B ( empty, readFile, append )
import qualified Data.ByteString.Char8 as BC ( pack )

import Darcs.Util.Hash( SHA1, sha1Xor, sha1zero )
import Darcs.Util.Prompt ( promptYorn )
import Darcs.Util.Tree ( Tree )
import Darcs.Util.SignalHandler ( withSignalsBlocked )

import System.Directory
    ( copyFile
    , createDirectoryIfMissing
    , doesFileExist
    , removeFile
    , renameFile
    )
import System.FilePath.Posix( (</>) )
import System.IO.Unsafe ( unsafeInterleaveIO )
import System.IO ( IOMode(..), hClose, hPutStrLn, openBinaryFile, stderr )
import System.IO.Error ( catchIOError, isDoesNotExistError )

import Darcs.Util.External
    ( copyFileOrUrl
    , cloneFile
    , gzFetchFilePS
    , Cachable( Uncachable )
    )
import Darcs.Repository.Flags
    ( Compression
    , RemoteDarcs
    , UpdatePending(..)
    , Verbosity(..)
    , remoteDarcs
    )

import Darcs.Repository.Format
    ( RepoProperty( HashedInventory, RebaseInProgress, RebaseInProgress_2_16 )
    , formatHas
    , writeRepoFormat
    , addToFormat
    , removeFromFormat
    )
import Darcs.Repository.Pending
    ( tentativelyRemoveFromPending
    , revertPending
    , finalizePending
    , readTentativePending
    , writeTentativePending
    )
import Darcs.Repository.PatchIndex
    ( createOrUpdatePatchIndexDisk
    , doesPatchIndexExist
    )
import Darcs.Repository.Pristine
    ( ApplyDir(..)
    , applyToTentativePristine
    , applyToTentativePristineCwd
    )
import Darcs.Repository.Paths
import Darcs.Repository.Rebase
    ( withTentativeRebase
    , createTentativeRebase
    , readTentativeRebase
    , writeTentativeRebase
    , commuteOutOldStyleRebase
    )
import Darcs.Repository.State ( readRecorded, updateIndex )

import Darcs.Util.Global ( darcsdir )
import Darcs.Util.Lock
    ( writeBinFile
    , writeDocBinFile
    , writeAtomicFilePS
    , appendDocBinFile
    , removeFileMayNotExist
    )
import Darcs.Patch.Set ( PatchSet(..), Tagged(..)
                       , SealedPatchSet, Origin
                       , patchSet2RL
                       )

import Darcs.Patch.Show ( ShowPatchFor(..) )
import qualified Darcs.Patch.Named.Wrapped as W
import Darcs.Patch.PatchInfoAnd
    ( PatchInfoAnd, PatchInfoAndG, Hopefully, patchInfoAndPatch, info
    , extractHash, createHashed, hopefully
    , fmapPIAP
    )
import Darcs.Patch ( IsRepoType, RepoPatch, showPatch
                   , commuteRL
                   , readPatch
                   , effect
                   , displayPatch
                   )

import Darcs.Patch.Apply ( Apply(..) )
import Darcs.Patch.Format ( PatchListFormat )
import Darcs.Patch.Bundle ( Bundle(..), makeBundle, interpretBundle, parseBundle )
import Darcs.Patch.Read ( ReadPatch )
import Darcs.Patch.Depends ( removeFromPatchSet, slightlyOptimizePatchset
                           , mergeThem, cleanLatestTag )
import Darcs.Patch.Info
    ( PatchInfo, displayPatchInfo, makePatchname )
import Darcs.Patch.Rebase.Suspended
    ( Suspended(..), addFixupsToSuspended, removeFixupsFromSuspended )

import Darcs.Util.Path ( ioAbsoluteOrRemote, toPath )
import Darcs.Repository.Cache
    ( Cache
    , HashedDir(..)
    , fetchFileUsingCache
    , hashedDir
    , peekInCache
    , speculateFilesUsingCache
    , writeFileUsingCache
    )
import Darcs.Repository.Inventory
import Darcs.Repository.InternalTypes
    ( Repository
    , repoCache
    , repoFormat
    , repoLocation
    , withRepoLocation
    , unsafeCoerceR
    , unsafeCoerceT
    )
import qualified Darcs.Repository.Old as Old ( readOldRepo, oldRepoFailMsg )
import Darcs.Patch.Witnesses.Ordered
    ( (+<+), FL(..), RL(..), mapRL, foldFL_M, foldrwFL, mapRL_RL
    , (:>)(..), lengthFL, (+>+)
    , reverseFL )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), seal, unseal, mapSeal )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )

import Darcs.Util.ByteString ( gzReadFilePS )
import Darcs.Util.Printer.Color ( debugDoc, ePutDocLn )
import Darcs.Util.Printer
    ( Doc
    , ($$)
    , (<+>)
    , hcat
    , renderPS
    , renderString
    , text
    )
import Darcs.Util.Progress ( beginTedious, endTedious, debugMessage, finishedOneIO )
import Darcs.Patch.Progress (progressFL)


-- |revertTentativeChanges swaps the tentative and "real" hashed inventory
-- files, and then updates the tentative pristine with the "real" inventory
-- hash.
revertTentativeChanges :: IO ()
revertTentativeChanges :: IO ()
revertTentativeChanges = do
    FilePath -> FilePath -> IO ()
cloneFile FilePath
hashedInventoryPath FilePath
tentativeHashedInventoryPath
    ByteString
i <- FilePath -> IO ByteString
gzReadFilePS FilePath
hashedInventoryPath
    FilePath -> ByteString -> IO ()
forall p. FilePathLike p => p -> ByteString -> IO ()
writeBinFile FilePath
tentativePristinePath (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$
        ByteString -> ByteString -> ByteString
B.append ByteString
pristineName (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
BC.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ PristineHash -> FilePath
forall a. ValidHash a => a -> FilePath
getValidHash (PristineHash -> FilePath) -> PristineHash -> FilePath
forall a b. (a -> b) -> a -> b
$ ByteString -> PristineHash
peekPristineHash ByteString
i

-- |finalizeTentativeChanges trys to atomically swap the tentative
-- inventory/pristine pointers with the "real" pointers; it first re-reads the
-- inventory to optimize it, presumably to take account of any new tags, and
-- then writes out the new tentative inventory, and finally does the atomic
-- swap. In general, we can't clean the pristine cache at the same time, since
-- a simultaneous get might be in progress.
finalizeTentativeChanges :: (IsRepoType rt, RepoPatch p)
                         => Repository rt p wR wU wT -> Compression -> IO ()
finalizeTentativeChanges :: Repository rt p wR wU wT -> Compression -> IO ()
finalizeTentativeChanges Repository rt p wR wU wT
r Compression
compr = do
    FilePath -> IO ()
debugMessage FilePath
"Optimizing the inventory..."
    -- Read the tentative patches
    PatchSet rt p Origin wT
ps <- Repository rt p wR wU wT
-> FilePath -> IO (PatchSet rt p Origin wT)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
Repository rt p wR wU wT
-> FilePath -> IO (PatchSet rt p Origin wT)
readTentativeRepo Repository rt p wR wU wT
r FilePath
"."
    Cache -> Compression -> PatchSet rt p Origin wT -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
Cache -> Compression -> PatchSet rt p Origin wX -> IO ()
writeTentativeInventory (Repository rt p wR wU wT -> Cache
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p wR wU wT
r) Compression
compr PatchSet rt p Origin wT
ps
    ByteString
i <- FilePath -> IO ByteString
gzReadFilePS FilePath
tentativeHashedInventoryPath
    ByteString
p <- FilePath -> IO ByteString
gzReadFilePS FilePath
tentativePristinePath
    -- Write out the "optimised" tentative inventory.
    FilePath -> Doc -> IO ()
forall p. FilePathLike p => p -> Doc -> IO ()
writeDocBinFile FilePath
tentativeHashedInventoryPath (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ PristineHash -> ByteString -> Doc
pokePristineHash (ByteString -> PristineHash
peekPristineHash ByteString
p) ByteString
i
    -- Atomically swap.
    FilePath -> FilePath -> IO ()
renameFile FilePath
tentativeHashedInventoryPath FilePath
hashedInventoryPath

-- | Add (append) a patch to a specific inventory file.
-- | Warning: this allows to add any arbitrary patch!
addToSpecificInventory :: RepoPatch p => String -> Cache -> Compression
                       -> PatchInfoAnd rt p wX wY -> IO ()
addToSpecificInventory :: FilePath
-> Cache -> Compression -> PatchInfoAnd rt p wX wY -> IO ()
addToSpecificInventory FilePath
invPath Cache
c Compression
compr PatchInfoAnd rt p wX wY
p = do
    let invFile :: FilePath
invFile = FilePath -> FilePath
makeDarcsdirPath FilePath
invPath
    PatchHash
hash <- (PatchInfo, PatchHash) -> PatchHash
forall a b. (a, b) -> b
snd ((PatchInfo, PatchHash) -> PatchHash)
-> IO (PatchInfo, PatchHash) -> IO PatchHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cache
-> Compression
-> PatchInfoAnd rt p wX wY
-> IO (PatchInfo, PatchHash)
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
Cache
-> Compression
-> PatchInfoAnd rt p wX wY
-> IO (PatchInfo, PatchHash)
writePatchIfNecessary Cache
c Compression
compr PatchInfoAnd rt p wX wY
p
    FilePath -> Doc -> IO ()
forall p. FilePathLike p => p -> Doc -> IO ()
appendDocBinFile FilePath
invFile (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ (PatchInfo, PatchHash) -> Doc
showInventoryEntry (PatchInfoAnd rt p wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wX wY
p, PatchHash
hash)

-- | Add (append) a patch to the tentative inventory.
-- | Warning: this allows to add any arbitrary patch! Used by convert import.
addToTentativeInventory :: RepoPatch p => Cache -> Compression
                        -> PatchInfoAnd rt p wX wY -> IO ()
addToTentativeInventory :: Cache -> Compression -> PatchInfoAnd rt p wX wY -> IO ()
addToTentativeInventory = FilePath
-> Cache -> Compression -> PatchInfoAnd rt p wX wY -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
FilePath
-> Cache -> Compression -> PatchInfoAnd rt p wX wY -> IO ()
addToSpecificInventory FilePath
tentativeHashedInventory

-- |writeHashFile takes a Doc and writes it as a hash-named file, returning the
-- filename that the contents were written to.
writeHashFile :: Cache -> Compression -> HashedDir -> Doc -> IO String
writeHashFile :: Cache -> Compression -> HashedDir -> Doc -> IO FilePath
writeHashFile Cache
c Compression
compr HashedDir
subdir Doc
d = do
    FilePath -> IO ()
debugMessage (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Writing hash file to " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ HashedDir -> FilePath
hashedDir HashedDir
subdir
    Cache -> Compression -> HashedDir -> ByteString -> IO FilePath
writeFileUsingCache Cache
c Compression
compr HashedDir
subdir (ByteString -> IO FilePath) -> ByteString -> IO FilePath
forall a b. (a -> b) -> a -> b
$ Doc -> ByteString
renderPS Doc
d

-- |readRepo returns the "current" repo patchset.
readRepoHashed :: (IsRepoType rt, RepoPatch p) => Repository rt p wR wU wT
               -> String -> IO (PatchSet rt p Origin wR)
readRepoHashed :: Repository rt p wR wU wT
-> FilePath -> IO (PatchSet rt p Origin wR)
readRepoHashed = FilePath
-> Repository rt p wR wU wT
-> FilePath
-> IO (PatchSet rt p Origin wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wS.
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
FilePath
-> Repository rt p wR wU wT
-> FilePath
-> IO (PatchSet rt p Origin wS)
readRepoUsingSpecificInventory FilePath
hashedInventory

-- |readRepo returns the tentative repo patchset.
readTentativeRepo :: (IsRepoType rt, PatchListFormat p, ReadPatch p)
                  => Repository rt p wR wU wT -> String
                  -> IO (PatchSet rt p Origin wT)
readTentativeRepo :: Repository rt p wR wU wT
-> FilePath -> IO (PatchSet rt p Origin wT)
readTentativeRepo = FilePath
-> Repository rt p wR wU wT
-> FilePath
-> IO (PatchSet rt p Origin wT)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wS.
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
FilePath
-> Repository rt p wR wU wT
-> FilePath
-> IO (PatchSet rt p Origin wS)
readRepoUsingSpecificInventory FilePath
tentativeHashedInventory

-- |readRepoUsingSpecificInventory uses the inventory at @invPath@ to read the
-- repository @repo@.
readRepoUsingSpecificInventory :: (IsRepoType rt, PatchListFormat p, ReadPatch p)
                               => String -> Repository rt p wR wU wT
                               -> String -> IO (PatchSet rt p Origin wS)
readRepoUsingSpecificInventory :: FilePath
-> Repository rt p wR wU wT
-> FilePath
-> IO (PatchSet rt p Origin wS)
readRepoUsingSpecificInventory FilePath
invPath Repository rt p wR wU wT
repo FilePath
dir = do
    FilePath
realdir <- AbsoluteOrRemotePath -> FilePath
forall a. FilePathOrURL a => a -> FilePath
toPath (AbsoluteOrRemotePath -> FilePath)
-> IO AbsoluteOrRemotePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO AbsoluteOrRemotePath
ioAbsoluteOrRemote FilePath
dir
    Sealed PatchSet rt p Origin wX
ps <- Cache -> FilePath -> FilePath -> IO (Sealed (PatchSet rt p Origin))
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
Cache -> FilePath -> FilePath -> IO (SealedPatchSet rt p Origin)
readRepoPrivate (Repository rt p wR wU wT -> Cache
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p wR wU wT
repo) FilePath
realdir FilePath
invPath
                 IO (Sealed (PatchSet rt p Origin))
-> (IOError -> IO (Sealed (PatchSet rt p Origin)))
-> IO (Sealed (PatchSet rt p Origin))
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \IOError
e -> do
                     Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath
"Invalid repository: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
realdir)
                     IOError -> IO (Sealed (PatchSet rt p Origin))
forall a. IOError -> IO a
ioError IOError
e
    PatchSet rt p Origin wS -> IO (PatchSet rt p Origin wS)
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchSet rt p Origin wS -> IO (PatchSet rt p Origin wS))
-> PatchSet rt p Origin wS -> IO (PatchSet rt p Origin wS)
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wX -> PatchSet rt p Origin wS
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP PatchSet rt p Origin wX
ps
  where
    readRepoPrivate :: (IsRepoType rt, PatchListFormat p, ReadPatch p)
                    => Cache -> FilePath
                    -> FilePath -> IO (SealedPatchSet rt p Origin)
    readRepoPrivate :: Cache -> FilePath -> FilePath -> IO (SealedPatchSet rt p Origin)
readRepoPrivate Cache
cache FilePath
d FilePath
iname = do
      Inventory
inventory <- FilePath -> IO Inventory
readInventoryPrivate (FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
darcsdir FilePath -> FilePath -> FilePath
</> FilePath
iname)
      Cache -> Inventory -> IO (SealedPatchSet rt p Origin)
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
Cache -> Inventory -> IO (SealedPatchSet rt p Origin)
readRepoFromInventoryList Cache
cache Inventory
inventory

-- | Read a 'PatchSet' from the repository (assumed to be located at the
-- current working directory) by following the chain of 'Inventory's, starting
-- with the given one. The 'Cache' parameter is used to locate patches and parent
-- inventories, since not all of them need be present inside the current repo.
readRepoFromInventoryList
  :: (IsRepoType rt, PatchListFormat p, ReadPatch p)
  => Cache
  -> Inventory
  -> IO (SealedPatchSet rt p Origin)
readRepoFromInventoryList :: Cache -> Inventory -> IO (SealedPatchSet rt p Origin)
readRepoFromInventoryList Cache
cache = Inventory -> IO (SealedPatchSet rt p Origin)
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
Inventory -> IO (SealedPatchSet rt p Origin)
parseInv
  where
    parseInv :: (IsRepoType rt, PatchListFormat p, ReadPatch p)
             => Inventory
             -> IO (SealedPatchSet rt p Origin)
    parseInv :: Inventory -> IO (SealedPatchSet rt p Origin)
parseInv (Inventory Maybe InventoryHash
Nothing [(PatchInfo, PatchHash)]
ris) =
        (forall wX.
 RL (PatchInfoAndG rt (Named p)) Origin wX
 -> PatchSet rt p Origin wX)
-> Sealed (RL (PatchInfoAndG rt (Named p)) Origin)
-> SealedPatchSet rt p Origin
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal (RL (Tagged rt p) Origin Origin
-> RL (PatchInfoAndG rt (Named p)) Origin wX
-> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin Origin
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL) (Sealed (RL (PatchInfoAndG rt (Named p)) Origin)
 -> SealedPatchSet rt p Origin)
-> IO (Sealed (RL (PatchInfoAndG rt (Named p)) Origin))
-> IO (SealedPatchSet rt p Origin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cache
-> [(PatchInfo, PatchHash)]
-> IO (Sealed (RL (PatchInfoAndG rt (Named p)) Origin))
forall (np :: * -> * -> *) (rt :: RepoType) wX.
ReadPatch np =>
Cache
-> [(PatchInfo, PatchHash)]
-> IO (Sealed (RL (PatchInfoAndG rt np) wX))
readPatchesFromInventory Cache
cache [(PatchInfo, PatchHash)]
ris
    parseInv (Inventory (Just InventoryHash
h) []) =
        -- TODO could be more tolerant and create a larger PatchSet
        FilePath -> IO (SealedPatchSet rt p Origin)
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO (SealedPatchSet rt p Origin))
-> FilePath -> IO (SealedPatchSet rt p Origin)
forall a b. (a -> b) -> a -> b
$ FilePath
"bad inventory " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ InventoryHash -> FilePath
forall a. ValidHash a => a -> FilePath
getValidHash InventoryHash
h FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" (no tag) in parseInv!"
    parseInv (Inventory (Just InventoryHash
h) ((PatchInfo, PatchHash)
t : [(PatchInfo, PatchHash)]
ris)) = do
        Sealed RL (Tagged rt p) Origin wX
ts <- (forall wX.
 RL (Tagged rt p) Origin wX -> Sealed (RL (Tagged rt p) Origin))
-> Sealed (RL (Tagged rt p) Origin)
-> Sealed (RL (Tagged rt p) Origin)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall wX.
RL (Tagged rt p) Origin wX -> Sealed (RL (Tagged rt p) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Sealed (RL (Tagged rt p) Origin)
 -> Sealed (RL (Tagged rt p) Origin))
-> IO (Sealed (RL (Tagged rt p) Origin))
-> IO (Sealed (RL (Tagged rt p) Origin))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Sealed (RL (Tagged rt p) Origin))
-> IO (Sealed (RL (Tagged rt p) Origin))
forall a. IO a -> IO a
unsafeInterleaveIO ((PatchInfo, PatchHash)
-> InventoryHash -> IO (Sealed (RL (Tagged rt p) Origin))
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
(PatchInfo, PatchHash)
-> InventoryHash -> IO (Sealed (RL (Tagged rt p) Origin))
read_ts (PatchInfo, PatchHash)
t InventoryHash
h)
        Sealed RL (PatchInfoAndG rt (Named p)) wX wX
ps <- (forall wX.
 RL (PatchInfoAndG rt (Named p)) wX wX
 -> Sealed (RL (PatchInfoAndG rt (Named p)) wX))
-> Sealed (RL (PatchInfoAndG rt (Named p)) wX)
-> Sealed (RL (PatchInfoAndG rt (Named p)) wX)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall wX.
RL (PatchInfoAndG rt (Named p)) wX wX
-> Sealed (RL (PatchInfoAndG rt (Named p)) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Sealed (RL (PatchInfoAndG rt (Named p)) wX)
 -> Sealed (RL (PatchInfoAndG rt (Named p)) wX))
-> IO (Sealed (RL (PatchInfoAndG rt (Named p)) wX))
-> IO (Sealed (RL (PatchInfoAndG rt (Named p)) wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                        IO (Sealed (RL (PatchInfoAndG rt (Named p)) wX))
-> IO (Sealed (RL (PatchInfoAndG rt (Named p)) wX))
forall a. IO a -> IO a
unsafeInterleaveIO (Cache
-> [(PatchInfo, PatchHash)]
-> IO (Sealed (RL (PatchInfoAndG rt (Named p)) wX))
forall (np :: * -> * -> *) (rt :: RepoType) wX.
ReadPatch np =>
Cache
-> [(PatchInfo, PatchHash)]
-> IO (Sealed (RL (PatchInfoAndG rt np) wX))
readPatchesFromInventory Cache
cache [(PatchInfo, PatchHash)]
ris)
        SealedPatchSet rt p Origin -> IO (SealedPatchSet rt p Origin)
forall (m :: * -> *) a. Monad m => a -> m a
return (SealedPatchSet rt p Origin -> IO (SealedPatchSet rt p Origin))
-> SealedPatchSet rt p Origin -> IO (SealedPatchSet rt p Origin)
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wX -> SealedPatchSet rt p Origin
forall (a :: * -> *) wX. a wX -> Sealed a
seal (PatchSet rt p Origin wX -> SealedPatchSet rt p Origin)
-> PatchSet rt p Origin wX -> SealedPatchSet rt p Origin
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) Origin wX
-> RL (PatchInfoAndG rt (Named p)) wX wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wX
ts RL (PatchInfoAndG rt (Named p)) wX wX
ps

    read_ts :: (IsRepoType rt, PatchListFormat p, ReadPatch p) => InventoryEntry
            -> InventoryHash -> IO (Sealed (RL (Tagged rt p) Origin))
    read_ts :: (PatchInfo, PatchHash)
-> InventoryHash -> IO (Sealed (RL (Tagged rt p) Origin))
read_ts (PatchInfo, PatchHash)
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 :: [(PatchInfo, PatchHash)]
is = case Inventory
contents of
                    (Inventory (Just InventoryHash
_) ((PatchInfo, PatchHash)
_ : [(PatchInfo, PatchHash)]
ris0)) -> [(PatchInfo, PatchHash)]
ris0
                    (Inventory Maybe InventoryHash
Nothing [(PatchInfo, PatchHash)]
ris0) -> [(PatchInfo, PatchHash)]
ris0
                    (Inventory (Just InventoryHash
_) []) -> FilePath -> [(PatchInfo, PatchHash)]
forall a. HasCallStack => FilePath -> a
error FilePath
"inventory without tag!"
        Sealed RL (Tagged rt p) Origin wX
ts <- (forall wX.
 RL (Tagged rt p) Origin wX -> Sealed (RL (Tagged rt p) Origin))
-> Sealed (RL (Tagged rt p) Origin)
-> Sealed (RL (Tagged rt p) Origin)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall wX.
RL (Tagged rt p) Origin wX -> Sealed (RL (Tagged rt p) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Sealed (RL (Tagged rt p) Origin)
 -> Sealed (RL (Tagged rt p) Origin))
-> IO (Sealed (RL (Tagged rt p) Origin))
-> IO (Sealed (RL (Tagged rt p) Origin))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         IO (Sealed (RL (Tagged rt p) Origin))
-> IO (Sealed (RL (Tagged rt p) Origin))
forall a. IO a -> IO a
unsafeInterleaveIO
                            (case Inventory
contents of
                                 (Inventory (Just InventoryHash
h') ((PatchInfo, PatchHash)
t' : [(PatchInfo, PatchHash)]
_)) -> (PatchInfo, PatchHash)
-> InventoryHash -> IO (Sealed (RL (Tagged rt p) Origin))
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
(PatchInfo, PatchHash)
-> InventoryHash -> IO (Sealed (RL (Tagged rt p) Origin))
read_ts (PatchInfo, PatchHash)
t' InventoryHash
h'
                                 (Inventory (Just InventoryHash
_) []) -> FilePath -> IO (Sealed (RL (Tagged rt p) Origin))
forall a. HasCallStack => FilePath -> a
error FilePath
"inventory without tag!"
                                 (Inventory Maybe InventoryHash
Nothing [(PatchInfo, PatchHash)]
_) -> Sealed (RL (Tagged rt p) Origin)
-> IO (Sealed (RL (Tagged rt p) Origin))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (RL (Tagged rt p) Origin)
 -> IO (Sealed (RL (Tagged rt p) Origin)))
-> Sealed (RL (Tagged rt p) Origin)
-> IO (Sealed (RL (Tagged rt p) Origin))
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) Origin Origin -> Sealed (RL (Tagged rt p) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal RL (Tagged rt p) Origin Origin
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL)
        Sealed RL (PatchInfoAndG rt (Named p)) wX wX
ps <- (forall wX.
 RL (PatchInfoAndG rt (Named p)) wX wX
 -> Sealed (RL (PatchInfoAndG rt (Named p)) wX))
-> Sealed (RL (PatchInfoAndG rt (Named p)) wX)
-> Sealed (RL (PatchInfoAndG rt (Named p)) wX)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall wX.
RL (PatchInfoAndG rt (Named p)) wX wX
-> Sealed (RL (PatchInfoAndG rt (Named p)) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Sealed (RL (PatchInfoAndG rt (Named p)) wX)
 -> Sealed (RL (PatchInfoAndG rt (Named p)) wX))
-> IO (Sealed (RL (PatchInfoAndG rt (Named p)) wX))
-> IO (Sealed (RL (PatchInfoAndG rt (Named p)) wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            IO (Sealed (RL (PatchInfoAndG rt (Named p)) wX))
-> IO (Sealed (RL (PatchInfoAndG rt (Named p)) wX))
forall a. IO a -> IO a
unsafeInterleaveIO (Cache
-> [(PatchInfo, PatchHash)]
-> IO (Sealed (RL (PatchInfoAndG rt (Named p)) wX))
forall (np :: * -> * -> *) (rt :: RepoType) wX.
ReadPatch np =>
Cache
-> [(PatchInfo, PatchHash)]
-> IO (Sealed (RL (PatchInfoAndG rt np) wX))
readPatchesFromInventory Cache
cache [(PatchInfo, PatchHash)]
is)
        Sealed PatchInfoAnd rt p wX wX
tag00 <- (PatchInfo, PatchHash) -> IO (Sealed (PatchInfoAnd rt p wX))
forall (p :: * -> * -> *) (rt :: RepoType) wX.
(PatchListFormat p, ReadPatch p) =>
(PatchInfo, PatchHash) -> IO (Sealed (PatchInfoAnd rt p wX))
read_tag (PatchInfo, PatchHash)
tag0
        Sealed (RL (Tagged rt p) Origin)
-> IO (Sealed (RL (Tagged rt p) Origin))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (RL (Tagged rt p) Origin)
 -> IO (Sealed (RL (Tagged rt p) Origin)))
-> Sealed (RL (Tagged rt p) Origin)
-> IO (Sealed (RL (Tagged rt p) Origin))
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) Origin wX -> Sealed (RL (Tagged rt p) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (RL (Tagged rt p) Origin wX -> Sealed (RL (Tagged rt p) Origin))
-> RL (Tagged rt p) Origin wX -> Sealed (RL (Tagged rt p) Origin)
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) Origin wX
ts RL (Tagged rt p) Origin wX
-> Tagged rt p wX wX -> RL (Tagged rt p) Origin wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wX wX
-> Maybe FilePath
-> RL (PatchInfoAndG rt (Named p)) wX wX
-> Tagged rt p wX wX
forall (rt :: RepoType) (p :: * -> * -> *) wY wZ wX.
PatchInfoAnd rt p wY wZ
-> Maybe FilePath
-> RL (PatchInfoAnd rt p) wX wY
-> Tagged rt p wX wZ
Tagged PatchInfoAnd rt p wX wX
tag00 (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (InventoryHash -> FilePath
forall a. ValidHash a => a -> FilePath
getValidHash InventoryHash
h0)) RL (PatchInfoAndG rt (Named p)) wX wX
ps

    read_tag :: (PatchListFormat p, ReadPatch p) => InventoryEntry
             -> IO (Sealed (PatchInfoAnd rt p wX))
    read_tag :: (PatchInfo, PatchHash) -> IO (Sealed (PatchInfoAnd rt p wX))
read_tag (PatchInfo
i, PatchHash
h) =
        (forall wX. Hopefully (Named p) wX wX -> PatchInfoAnd rt p wX wX)
-> Sealed (Hopefully (Named p) wX) -> Sealed (PatchInfoAnd rt p wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal (PatchInfo
-> Hopefully (Named p) wX wX -> PatchInfoAndG rt (Named p) wX wX
forall (p :: * -> * -> *) wA wB (rt :: RepoType).
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG rt p wA wB
patchInfoAndPatch PatchInfo
i) (Sealed (Hopefully (Named p) wX) -> Sealed (PatchInfoAnd rt p wX))
-> IO (Sealed (Hopefully (Named p) wX))
-> IO (Sealed (PatchInfoAnd rt 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))
createValidHashed 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
pristineAndInventory) <-
            Cache -> HashedDir -> FilePath -> IO (FilePath, ByteString)
fetchFileUsingCache Cache
cache HashedDir
HashedInventoriesDir (InventoryHash -> FilePath
forall a. ValidHash a => a -> FilePath
getValidHash InventoryHash
invHash)
        case ByteString -> Either FilePath Inventory
parseInventory ByteString
pristineAndInventory of
          Right Inventory
r -> Inventory -> IO Inventory
forall (m :: * -> *) a. Monad m => a -> m a
return Inventory
r
          Left FilePath
e -> FilePath -> IO Inventory
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]

readPatchesFromInventory :: ReadPatch np
                         => Cache
                         -> [InventoryEntry]
                         -> IO (Sealed (RL (PatchInfoAndG rt np) wX))
readPatchesFromInventory :: Cache
-> [(PatchInfo, PatchHash)]
-> IO (Sealed (RL (PatchInfoAndG rt np) wX))
readPatchesFromInventory Cache
cache [(PatchInfo, PatchHash)]
ris = [(PatchInfo, PatchHash)]
-> IO (Sealed (RL (PatchInfoAndG rt np) wX))
forall (a :: * -> * -> *) (rt :: RepoType) wX.
ReadPatch a =>
[(PatchInfo, PatchHash)]
-> IO (Sealed (RL (PatchInfoAndG rt a) wX))
read_patches ([(PatchInfo, PatchHash)] -> [(PatchInfo, PatchHash)]
forall a. [a] -> [a]
reverse [(PatchInfo, PatchHash)]
ris)
  where
    read_patches :: [(PatchInfo, PatchHash)]
-> IO (Sealed (RL (PatchInfoAndG rt a) wX))
read_patches [] = Sealed (RL (PatchInfoAndG rt a) wX)
-> IO (Sealed (RL (PatchInfoAndG rt a) wX))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (RL (PatchInfoAndG rt a) wX)
 -> IO (Sealed (RL (PatchInfoAndG rt a) wX)))
-> Sealed (RL (PatchInfoAndG rt a) wX)
-> IO (Sealed (RL (PatchInfoAndG rt a) wX))
forall a b. (a -> b) -> a -> b
$ RL (PatchInfoAndG rt a) wX wX
-> Sealed (RL (PatchInfoAndG rt a) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal RL (PatchInfoAndG rt a) wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
    read_patches allis :: [(PatchInfo, PatchHash)]
allis@((PatchInfo
i1, PatchHash
h1) : [(PatchInfo, PatchHash)]
is1) =
        (forall wY wZ.
 Hopefully a wY wZ
 -> RL (PatchInfoAndG rt a) wX wY -> RL (PatchInfoAndG rt a) wX wZ)
-> IO (Sealed (RL (PatchInfoAndG rt a) wX))
-> (forall wB. IO (Sealed (Hopefully a wB)))
-> IO (Sealed (RL (PatchInfoAndG rt a) 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 a wY wZ
p RL (PatchInfoAndG rt a) wX wY
rest -> RL (PatchInfoAndG rt a) wX wY
rest RL (PatchInfoAndG rt a) wX wY
-> PatchInfoAndG rt a wY wZ -> RL (PatchInfoAndG rt a) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfo
i1 PatchInfo -> Hopefully a wY wZ -> PatchInfoAndG rt a wY wZ
forall (p :: * -> * -> *) wA wB (rt :: RepoType).
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG rt p wA wB
`patchInfoAndPatch` Hopefully a wY wZ
p) ([(PatchInfo, PatchHash)]
-> IO (Sealed (RL (PatchInfoAndG rt a) wX))
forall (a :: * -> * -> *) (rt :: RepoType) wX.
ReadPatch a =>
[(PatchInfo, PatchHash)]
-> IO (Sealed (RL (PatchInfoAndG rt a) wX))
rp [(PatchInfo, PatchHash)]
is1)
                    (PatchHash
-> (PatchHash -> IO (Sealed (a wB)))
-> IO (Sealed (Hopefully a wB))
forall (a :: * -> * -> *) wX.
PatchHash
-> (PatchHash -> IO (Sealed (a wX)))
-> IO (Sealed (Hopefully a wX))
createValidHashed PatchHash
h1 (IO (Sealed (a wB)) -> PatchHash -> IO (Sealed (a wB))
forall a b. a -> b -> a
const (IO (Sealed (a wB)) -> PatchHash -> IO (Sealed (a wB)))
-> IO (Sealed (a wB)) -> PatchHash -> IO (Sealed (a wB))
forall a b. (a -> b) -> a -> b
$ PatchHash
-> [(PatchInfo, PatchHash)] -> PatchInfo -> IO (Sealed (a wB))
forall (p :: * -> * -> *) wX.
ReadPatch p =>
PatchHash
-> [(PatchInfo, PatchHash)] -> PatchInfo -> IO (Sealed (p wX))
speculateAndParse PatchHash
h1 [(PatchInfo, PatchHash)]
allis PatchInfo
i1))
      where
        rp :: [(PatchInfo, PatchHash)]
-> IO (Sealed (RL (PatchInfoAndG rt a) wX))
rp [] = Sealed (RL (PatchInfoAndG rt a) wX)
-> IO (Sealed (RL (PatchInfoAndG rt a) wX))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (RL (PatchInfoAndG rt a) wX)
 -> IO (Sealed (RL (PatchInfoAndG rt a) wX)))
-> Sealed (RL (PatchInfoAndG rt a) wX)
-> IO (Sealed (RL (PatchInfoAndG rt a) wX))
forall a b. (a -> b) -> a -> b
$ RL (PatchInfoAndG rt a) wX wX
-> Sealed (RL (PatchInfoAndG rt a) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal RL (PatchInfoAndG rt a) wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
        rp [(PatchInfo
i, PatchHash
h), (PatchInfo
il, PatchHash
hl)] =
            (forall wY wZ.
 Hopefully a wY wZ
 -> RL (PatchInfoAndG rt a) wX wY -> RL (PatchInfoAndG rt a) wX wZ)
-> IO (Sealed (RL (PatchInfoAndG rt a) wX))
-> (forall wB. IO (Sealed (Hopefully a wB)))
-> IO (Sealed (RL (PatchInfoAndG rt a) 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 a wY wZ
p RL (PatchInfoAndG rt a) wX wY
rest -> RL (PatchInfoAndG rt a) wX wY
rest RL (PatchInfoAndG rt a) wX wY
-> PatchInfoAndG rt a wY wZ -> RL (PatchInfoAndG rt a) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfo
i PatchInfo -> Hopefully a wY wZ -> PatchInfoAndG rt a wY wZ
forall (p :: * -> * -> *) wA wB (rt :: RepoType).
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG rt p wA wB
`patchInfoAndPatch` Hopefully a wY wZ
p)
                        ([(PatchInfo, PatchHash)]
-> IO (Sealed (RL (PatchInfoAndG rt a) wX))
rp [(PatchInfo
il, PatchHash
hl)])
                        (PatchHash
-> (PatchHash -> IO (Sealed (a wB)))
-> IO (Sealed (Hopefully a wB))
forall (a :: * -> * -> *) wX.
PatchHash
-> (PatchHash -> IO (Sealed (a wX)))
-> IO (Sealed (Hopefully a wX))
createValidHashed PatchHash
h
                            (IO (Sealed (a wB)) -> PatchHash -> IO (Sealed (a wB))
forall a b. a -> b -> a
const (IO (Sealed (a wB)) -> PatchHash -> IO (Sealed (a wB)))
-> IO (Sealed (a wB)) -> PatchHash -> IO (Sealed (a wB))
forall a b. (a -> b) -> a -> b
$ PatchHash
-> [(PatchInfo, PatchHash)] -> PatchInfo -> IO (Sealed (a wB))
forall (p :: * -> * -> *) wX.
ReadPatch p =>
PatchHash
-> [(PatchInfo, PatchHash)] -> PatchInfo -> IO (Sealed (p wX))
speculateAndParse PatchHash
h ([(PatchInfo, PatchHash)] -> [(PatchInfo, PatchHash)]
forall a. [a] -> [a]
reverse [(PatchInfo, PatchHash)]
allis) PatchInfo
i))
        rp ((PatchInfo
i, PatchHash
h) : [(PatchInfo, PatchHash)]
is) =
            (forall wY wZ.
 Hopefully a wY wZ
 -> RL (PatchInfoAndG rt a) wX wY -> RL (PatchInfoAndG rt a) wX wZ)
-> IO (Sealed (RL (PatchInfoAndG rt a) wX))
-> (forall wB. IO (Sealed (Hopefully a wB)))
-> IO (Sealed (RL (PatchInfoAndG rt a) 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 a wY wZ
p RL (PatchInfoAndG rt a) wX wY
rest -> RL (PatchInfoAndG rt a) wX wY
rest RL (PatchInfoAndG rt a) wX wY
-> PatchInfoAndG rt a wY wZ -> RL (PatchInfoAndG rt a) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfo
i PatchInfo -> Hopefully a wY wZ -> PatchInfoAndG rt a wY wZ
forall (p :: * -> * -> *) wA wB (rt :: RepoType).
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG rt p wA wB
`patchInfoAndPatch` Hopefully a wY wZ
p)
                        ([(PatchInfo, PatchHash)]
-> IO (Sealed (RL (PatchInfoAndG rt a) wX))
rp [(PatchInfo, PatchHash)]
is)
                        (PatchHash
-> (PatchHash -> IO (Sealed (a wB)))
-> IO (Sealed (Hopefully a wB))
forall (a :: * -> * -> *) wX.
PatchHash
-> (PatchHash -> IO (Sealed (a wX)))
-> IO (Sealed (Hopefully a wX))
createValidHashed PatchHash
h (Cache -> PatchInfo -> PatchHash -> IO (Sealed (a 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 wY wZ. q wY wZ -> p wX wY -> r wX wZ)
-> IO (Sealed (p wX))
-> (forall wB. IO (Sealed (q wB)))
-> IO (Sealed (r wX))
lift2Sealed forall wY wZ. q wY wZ -> p wX wY -> r wX wZ
f IO (Sealed (p wX))
iox forall wB. IO (Sealed (q wB))
ioy = do
        Sealed p wX wX
x <- (forall wX. p wX wX -> Sealed (p wX))
-> Sealed (p wX) -> Sealed (p wX)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall wX. p wX wX -> Sealed (p wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Sealed (p wX) -> Sealed (p wX))
-> IO (Sealed (p wX)) -> IO (Sealed (p wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Sealed (p wX)) -> IO (Sealed (p wX))
forall a. IO a -> IO a
unsafeInterleaveIO IO (Sealed (p wX))
iox
        Sealed q wX wX
y <- (forall wX. q wX wX -> Sealed (q wX))
-> Sealed (q wX) -> Sealed (q wX)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall wX. q wX wX -> Sealed (q wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Sealed (q wX) -> Sealed (q wX))
-> IO (Sealed (q wX)) -> IO (Sealed (q wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Sealed (q wX)) -> IO (Sealed (q wX))
forall a. IO a -> IO a
unsafeInterleaveIO IO (Sealed (q wX))
forall wB. IO (Sealed (q wB))
ioy
        Sealed (r wX) -> IO (Sealed (r wX))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (r wX) -> IO (Sealed (r wX)))
-> Sealed (r wX) -> IO (Sealed (r wX))
forall a b. (a -> b) -> a -> b
$ r wX wX -> Sealed (r wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (r wX wX -> Sealed (r wX)) -> r wX wX -> Sealed (r wX)
forall a b. (a -> b) -> a -> b
$ q wX wX -> p wX wX -> r wX wX
forall wY wZ. q wY wZ -> p wX wY -> r wX wZ
f q wX wX
y p wX wX
x

    speculateAndParse :: PatchHash
-> [(PatchInfo, PatchHash)] -> PatchInfo -> IO (Sealed (p wX))
speculateAndParse PatchHash
h [(PatchInfo, PatchHash)]
is PatchInfo
i = PatchHash -> [(PatchInfo, PatchHash)] -> IO ()
speculate PatchHash
h [(PatchInfo, PatchHash)]
is IO () -> IO (Sealed (p wX)) -> IO (Sealed (p wX))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 -> [(PatchInfo, PatchHash)] -> IO ()
speculate PatchHash
pHash [(PatchInfo, PatchHash)]
is = do
        Bool
already_got_one <- Cache -> HashedDir -> FilePath -> IO Bool
peekInCache Cache
cache HashedDir
HashedPatchesDir (PatchHash -> FilePath
forall a. ValidHash a => a -> FilePath
getValidHash 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 -> HashedDir -> [FilePath] -> IO ()
speculateFilesUsingCache Cache
cache HashedDir
HashedPatchesDir (((PatchInfo, PatchHash) -> FilePath)
-> [(PatchInfo, PatchHash)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (PatchHash -> FilePath
forall a. ValidHash a => a -> FilePath
getValidHash (PatchHash -> FilePath)
-> ((PatchInfo, PatchHash) -> PatchHash)
-> (PatchInfo, PatchHash)
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PatchInfo, PatchHash) -> PatchHash
forall a b. (a, b) -> b
snd) [(PatchInfo, PatchHash)]
is)

readSinglePatch :: ReadPatch p
                => Cache
                -> PatchInfo -> PatchHash -> IO (Sealed (p wX))
readSinglePatch :: Cache -> PatchInfo -> PatchHash -> IO (Sealed (p wX))
readSinglePatch Cache
cache PatchInfo
i PatchHash
h = do
    Doc -> IO ()
debugDoc (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
text FilePath
"Reading patch file:" Doc -> Doc -> Doc
<+> PatchInfo -> Doc
displayPatchInfo PatchInfo
i
    (FilePath
fn, ByteString
ps) <- Cache -> HashedDir -> FilePath -> IO (FilePath, ByteString)
fetchFileUsingCache Cache
cache HashedDir
HashedPatchesDir (PatchHash -> FilePath
forall a. ValidHash a => a -> FilePath
getValidHash 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 (m :: * -> *) a. Monad m => a -> m a
return Sealed (p wX)
p
        Left FilePath
e -> FilePath -> IO (Sealed (p wX))
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
            ]

-- | 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 (m :: * -> *) a. Monad m => a -> m a
return Inventory
r
      Left FilePath
e -> FilePath -> IO Inventory
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]

-- |Copy the hashed inventory from the given location to the given repository,
-- possibly using the given remote darcs binary.
copyHashedInventory :: Repository rt p wR wU wT -> RemoteDarcs -> String -> IO ()
copyHashedInventory :: Repository rt p wR wU wT -> RemoteDarcs -> FilePath -> IO ()
copyHashedInventory Repository rt p wR wU wT
outrepo RemoteDarcs
rdarcs FilePath
inloc | FilePath
remote <- RemoteDarcs -> FilePath
remoteDarcs RemoteDarcs
rdarcs = do
    let outloc :: FilePath
outloc = Repository rt p wR wU wT -> FilePath
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> FilePath
repoLocation Repository rt p wR wU wT
outrepo
    Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
False (FilePath
outloc FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
inventoriesDirPath)
    FilePath -> FilePath -> FilePath -> Cachable -> IO ()
copyFileOrUrl FilePath
remote (FilePath
inloc FilePath -> FilePath -> FilePath
</> FilePath
hashedInventoryPath)
                         (FilePath
outloc FilePath -> FilePath -> FilePath
</> FilePath
hashedInventoryPath)
                  Cachable
Uncachable -- no need to copy anything but hashed_inventory!
    FilePath -> IO ()
debugMessage FilePath
"Done copying hashed inventory."

-- |writeAndReadPatch makes a patch lazy, by writing it out to disk (thus
-- forcing it), and then re-reads the patch lazily.
writeAndReadPatch :: RepoPatch p => Cache -> Compression
                  -> PatchInfoAnd rt p wX wY -> IO (PatchInfoAnd rt p wX wY)
writeAndReadPatch :: Cache
-> Compression
-> PatchInfoAnd rt p wX wY
-> IO (PatchInfoAnd rt p wX wY)
writeAndReadPatch Cache
c Compression
compr PatchInfoAnd rt p wX wY
p = do
    (PatchInfo
i, PatchHash
h) <- Cache
-> Compression
-> PatchInfoAnd rt p wX wY
-> IO (PatchInfo, PatchHash)
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
Cache
-> Compression
-> PatchInfoAnd rt p wX wY
-> IO (PatchInfo, PatchHash)
writePatchIfNecessary Cache
c Compression
compr PatchInfoAnd rt p wX wY
p
    IO (PatchInfoAnd rt p wX wY) -> IO (PatchInfoAnd rt p wX wY)
forall a. IO a -> IO a
unsafeInterleaveIO (IO (PatchInfoAnd rt p wX wY) -> IO (PatchInfoAnd rt p wX wY))
-> IO (PatchInfoAnd rt p wX wY) -> IO (PatchInfoAnd rt p wX wY)
forall a b. (a -> b) -> a -> b
$ PatchHash -> PatchInfo -> IO (PatchInfoAnd rt p wX wY)
forall (a :: * -> * -> *) (rt :: RepoType) wA wB.
ReadPatch a =>
PatchHash -> PatchInfo -> IO (PatchInfoAndG rt a wA wB)
readp PatchHash
h PatchInfo
i
  where
    parse :: PatchInfo -> a -> IO (Sealed (p wX))
parse PatchInfo
i a
h = do
        Doc -> IO ()
debugDoc (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
text FilePath
"Rereading patch file:" Doc -> Doc -> Doc
<+> PatchInfo -> Doc
displayPatchInfo PatchInfo
i
        (FilePath
fn, ByteString
ps) <- Cache -> HashedDir -> FilePath -> IO (FilePath, ByteString)
fetchFileUsingCache Cache
c HashedDir
HashedPatchesDir (a -> FilePath
forall a. ValidHash a => a -> FilePath
getValidHash a
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)
x -> Sealed (p wX) -> IO (Sealed (p wX))
forall (m :: * -> *) a. Monad m => a -> m a
return Sealed (p wX)
x
            Left FilePath
e -> FilePath -> IO (Sealed (p wX))
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 patch file " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fn
                , FilePath
"which is"
                , Doc -> FilePath
renderString (Doc -> FilePath) -> Doc -> FilePath
forall a b. (a -> b) -> a -> b
$ PatchInfo -> Doc
displayPatchInfo PatchInfo
i
                , FilePath
e
                ]

    readp :: PatchHash -> PatchInfo -> IO (PatchInfoAndG rt a wA wB)
readp PatchHash
h PatchInfo
i = do Sealed Hopefully a Any wX
x <- PatchHash
-> (PatchHash -> IO (Sealed (a Any)))
-> IO (Sealed (Hopefully a Any))
forall (a :: * -> * -> *) wX.
PatchHash
-> (PatchHash -> IO (Sealed (a wX)))
-> IO (Sealed (Hopefully a wX))
createValidHashed PatchHash
h (PatchInfo -> PatchHash -> IO (Sealed (a Any))
forall a (p :: * -> * -> *) wX.
(ValidHash a, ReadPatch p) =>
PatchInfo -> a -> IO (Sealed (p wX))
parse PatchInfo
i)
                   PatchInfoAndG rt a wA wB -> IO (PatchInfoAndG rt a wA wB)
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchInfoAndG rt a wA wB -> IO (PatchInfoAndG rt a wA wB))
-> (Hopefully a wA wB -> PatchInfoAndG rt a wA wB)
-> Hopefully a wA wB
-> IO (PatchInfoAndG rt a wA wB)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfo -> Hopefully a wA wB -> PatchInfoAndG rt a wA wB
forall (p :: * -> * -> *) wA wB (rt :: RepoType).
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG rt p wA wB
patchInfoAndPatch PatchInfo
i (Hopefully a wA wB -> IO (PatchInfoAndG rt a wA wB))
-> Hopefully a wA wB -> IO (PatchInfoAndG rt a wA wB)
forall a b. (a -> b) -> a -> b
$ Hopefully a Any wX -> Hopefully a wA wB
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP Hopefully a Any wX
x

createValidHashed :: PatchHash
                  -> (PatchHash -> IO (Sealed (a wX)))
                  -> IO (Sealed (Darcs.Patch.PatchInfoAnd.Hopefully a wX))
createValidHashed :: PatchHash
-> (PatchHash -> IO (Sealed (a wX)))
-> IO (Sealed (Hopefully a wX))
createValidHashed PatchHash
h PatchHash -> IO (Sealed (a wX))
f = FilePath
-> (FilePath -> IO (Sealed (a wX))) -> IO (Sealed (Hopefully a wX))
forall (a :: * -> * -> *) wX.
FilePath
-> (FilePath -> IO (Sealed (a wX))) -> IO (Sealed (Hopefully a wX))
createHashed (PatchHash -> FilePath
forall a. ValidHash a => a -> FilePath
getValidHash PatchHash
h) (PatchHash -> IO (Sealed (a wX))
f (PatchHash -> IO (Sealed (a wX)))
-> (FilePath -> PatchHash) -> FilePath -> IO (Sealed (a wX))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> PatchHash
forall a. ValidHash a => FilePath -> a
mkValidHash)

-- | writeTentativeInventory writes @patchSet@ as the tentative inventory.
writeTentativeInventory :: RepoPatch p => Cache -> Compression
                        -> PatchSet rt p Origin wX -> IO ()
writeTentativeInventory :: Cache -> Compression -> PatchSet rt p Origin wX -> IO ()
writeTentativeInventory Cache
cache Compression
compr PatchSet rt p Origin wX
patchSet = do
    FilePath -> IO ()
debugMessage FilePath
"in writeTentativeInventory..."
    Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
False FilePath
inventoriesDirPath
    FilePath -> IO ()
beginTedious FilePath
tediousName
    Maybe FilePath
hsh <- PatchSet rt p Origin wX -> IO (Maybe FilePath)
forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
PatchSet rt p Origin wX -> IO (Maybe FilePath)
writeInventoryPrivate (PatchSet rt p Origin wX -> IO (Maybe FilePath))
-> PatchSet rt p Origin wX -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> PatchSet rt p wStart wX
slightlyOptimizePatchset PatchSet rt p Origin wX
patchSet
    FilePath -> IO ()
endTedious FilePath
tediousName
    FilePath -> IO ()
debugMessage FilePath
"still in writeTentativeInventory..."
    case Maybe FilePath
hsh of
        Maybe FilePath
Nothing -> FilePath -> ByteString -> IO ()
forall p. FilePathLike p => p -> ByteString -> IO ()
writeBinFile (FilePath -> FilePath
makeDarcsdirPath FilePath
tentativeHashedInventory) ByteString
B.empty
        Just FilePath
h -> do
            ByteString
content <- (FilePath, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((FilePath, ByteString) -> ByteString)
-> IO (FilePath, ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cache -> HashedDir -> FilePath -> IO (FilePath, ByteString)
fetchFileUsingCache Cache
cache HashedDir
HashedInventoriesDir FilePath
h
            FilePath -> ByteString -> IO ()
forall p. FilePathLike p => p -> ByteString -> IO ()
writeAtomicFilePS (FilePath -> FilePath
makeDarcsdirPath FilePath
tentativeHashedInventory) ByteString
content
  where
    tediousName :: FilePath
tediousName = FilePath
"Writing inventory"
    writeInventoryPrivate :: RepoPatch p => PatchSet rt p Origin wX
                          -> IO (Maybe String)
    writeInventoryPrivate :: PatchSet rt p Origin wX -> IO (Maybe FilePath)
writeInventoryPrivate (PatchSet RL (Tagged rt p) Origin wX
NilRL RL (PatchInfoAnd rt p) wX wX
NilRL) = Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
    writeInventoryPrivate (PatchSet RL (Tagged rt p) Origin wX
NilRL RL (PatchInfoAnd rt p) wX wX
ps) = do
        [(PatchInfo, PatchHash)]
inventory <- [IO (PatchInfo, PatchHash)] -> IO [(PatchInfo, PatchHash)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([IO (PatchInfo, PatchHash)] -> IO [(PatchInfo, PatchHash)])
-> [IO (PatchInfo, PatchHash)] -> IO [(PatchInfo, PatchHash)]
forall a b. (a -> b) -> a -> b
$ (forall wW wZ.
 PatchInfoAnd rt p wW wZ -> IO (PatchInfo, PatchHash))
-> RL (PatchInfoAnd rt p) wX wX -> [IO (PatchInfo, PatchHash)]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL (Cache
-> Compression
-> PatchInfoAnd rt p wW wZ
-> IO (PatchInfo, PatchHash)
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
Cache
-> Compression
-> PatchInfoAnd rt p wX wY
-> IO (PatchInfo, PatchHash)
writePatchIfNecessary Cache
cache Compression
compr) RL (PatchInfoAnd rt p) wX wX
ps
        let inventorylist :: Doc
inventorylist = [(PatchInfo, PatchHash)] -> Doc
showInventoryPatches ([(PatchInfo, PatchHash)] -> [(PatchInfo, PatchHash)]
forall a. [a] -> [a]
reverse [(PatchInfo, PatchHash)]
inventory)
        FilePath
hash <- Cache -> Compression -> HashedDir -> Doc -> IO FilePath
writeHashFile Cache
cache Compression
compr HashedDir
HashedInventoriesDir Doc
inventorylist
        Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
hash
    writeInventoryPrivate
        (PatchSet xs :: RL (Tagged rt p) Origin wX
xs@(RL (Tagged rt p) Origin wY
_ :<: Tagged PatchInfoAnd rt p wY wX
t Maybe FilePath
_ RL (PatchInfoAnd rt p) wY wY
_) RL (PatchInfoAnd rt p) wX wX
x) = do
        Maybe FilePath
resthash <- RL (Tagged rt p) Origin wX -> IO (Maybe FilePath)
forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
RL (Tagged rt p) Origin wX -> IO (Maybe FilePath)
write_ts RL (Tagged rt p) Origin wX
xs
        FilePath -> FilePath -> IO ()
finishedOneIO FilePath
tediousName (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"" Maybe FilePath
resthash
        [(PatchInfo, PatchHash)]
inventory <- [IO (PatchInfo, PatchHash)] -> IO [(PatchInfo, PatchHash)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([IO (PatchInfo, PatchHash)] -> IO [(PatchInfo, PatchHash)])
-> [IO (PatchInfo, PatchHash)] -> IO [(PatchInfo, PatchHash)]
forall a b. (a -> b) -> a -> b
$ (forall wW wZ.
 PatchInfoAnd rt p wW wZ -> IO (PatchInfo, PatchHash))
-> RL (PatchInfoAnd rt p) wY wX -> [IO (PatchInfo, PatchHash)]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL (Cache
-> Compression
-> PatchInfoAnd rt p wW wZ
-> IO (PatchInfo, PatchHash)
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
Cache
-> Compression
-> PatchInfoAnd rt p wX wY
-> IO (PatchInfo, PatchHash)
writePatchIfNecessary Cache
cache Compression
compr)
                                    (RL (PatchInfoAnd rt p) wY wY
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL RL (PatchInfoAnd rt p) wY wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wX
t RL (PatchInfoAnd rt p) wY wX
-> RL (PatchInfoAnd rt p) wX wX -> RL (PatchInfoAnd rt p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> RL a wY wZ -> RL a wX wZ
+<+ RL (PatchInfoAnd rt p) wX wX
x)
        let inventorylist :: Doc
inventorylist = [Doc] -> Doc
hcat (((PatchInfo, PatchHash) -> Doc)
-> [(PatchInfo, PatchHash)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PatchInfo, PatchHash) -> Doc
showInventoryEntry ([(PatchInfo, PatchHash)] -> [Doc])
-> [(PatchInfo, PatchHash)] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [(PatchInfo, PatchHash)] -> [(PatchInfo, PatchHash)]
forall a. [a] -> [a]
reverse [(PatchInfo, PatchHash)]
inventory)
            inventorycontents :: Doc
inventorycontents =
                case Maybe FilePath
resthash of
                    Just FilePath
h -> FilePath -> Doc
text (FilePath
"Starting with inventory:\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
h) Doc -> Doc -> Doc
$$
                                  Doc
inventorylist
                    Maybe FilePath
Nothing -> Doc
inventorylist
        FilePath
hash <- Cache -> Compression -> HashedDir -> Doc -> IO FilePath
writeHashFile Cache
cache Compression
compr HashedDir
HashedInventoriesDir Doc
inventorycontents
        Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
hash
      where
        -- | write_ts writes out a tagged patchset. If it has already been
        -- written, we'll have the hash, so we can immediately return it.
        write_ts :: RepoPatch p => RL (Tagged rt p) Origin wX
                 -> IO (Maybe String)
        write_ts :: RL (Tagged rt p) Origin wX -> IO (Maybe FilePath)
write_ts (RL (Tagged rt p) Origin wY
_ :<: Tagged PatchInfoAnd rt p wY wX
_ (Just FilePath
h) RL (PatchInfoAnd rt p) wY wY
_) = Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
h)
        write_ts (RL (Tagged rt p) Origin wY
tts :<: Tagged PatchInfoAnd rt p wY wX
_ Maybe FilePath
Nothing RL (PatchInfoAnd rt p) wY wY
pps) =
            PatchSet rt p Origin wY -> IO (Maybe FilePath)
forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
PatchSet rt p Origin wX -> IO (Maybe FilePath)
writeInventoryPrivate (PatchSet rt p Origin wY -> IO (Maybe FilePath))
-> PatchSet rt p Origin wY -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wY -> PatchSet rt p Origin wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wY
tts RL (PatchInfoAnd rt p) wY wY
pps
        write_ts RL (Tagged rt p) Origin wX
NilRL = Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing

-- |writeHashIfNecessary writes the patch and returns the resulting info/hash,
-- if it has not already been written. If it has been written, we have the hash
-- in the PatchInfoAnd, so we extract and return the info/hash.
writePatchIfNecessary :: RepoPatch p => Cache -> Compression
                      -> PatchInfoAnd rt p wX wY -> IO InventoryEntry
writePatchIfNecessary :: Cache
-> Compression
-> PatchInfoAnd rt p wX wY
-> IO (PatchInfo, PatchHash)
writePatchIfNecessary Cache
c Compression
compr PatchInfoAnd rt p wX wY
hp = PatchInfo
infohp PatchInfo -> IO (PatchInfo, PatchHash) -> IO (PatchInfo, PatchHash)
`seq`
    case PatchInfoAnd rt p wX wY -> Either (Named p wX wY) FilePath
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> Either (p wA wB) FilePath
extractHash PatchInfoAnd rt p wX wY
hp of
        Right FilePath
h -> (PatchInfo, PatchHash) -> IO (PatchInfo, PatchHash)
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchInfo
infohp, FilePath -> PatchHash
forall a. ValidHash a => FilePath -> a
mkValidHash FilePath
h)
        Left Named p wX wY
p -> do
          FilePath
h <- Cache -> Compression -> HashedDir -> Doc -> IO FilePath
writeHashFile Cache
c Compression
compr HashedDir
HashedPatchesDir (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)
          (PatchInfo, PatchHash) -> IO (PatchInfo, PatchHash)
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchInfo
infohp, FilePath -> PatchHash
forall a. ValidHash a => FilePath -> a
mkValidHash FilePath
h)
  where
    infohp :: PatchInfo
infohp = PatchInfoAnd rt p wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wX wY
hp

tentativelyAddPatch :: (RepoPatch p, ApplyState p ~ Tree)
                    => Repository rt p wR wU wT
                    -> Compression
                    -> Verbosity
                    -> UpdatePending
                    -> PatchInfoAnd rt p wT wY
                    -> IO (Repository rt p wR wU wY)
tentativelyAddPatch :: Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdatePending
-> PatchInfoAnd rt p wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatch = UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdatePending
-> PatchInfoAnd rt p wT wY
-> IO (Repository rt p wR wU wY)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(RepoPatch p, ApplyState p ~ Tree) =>
UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdatePending
-> PatchInfoAnd rt p wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatch_ UpdatePristine
UpdatePristine

data UpdatePristine = UpdatePristine 
                    | DontUpdatePristine
                    | DontUpdatePristineNorRevert deriving UpdatePristine -> UpdatePristine -> Bool
(UpdatePristine -> UpdatePristine -> Bool)
-> (UpdatePristine -> UpdatePristine -> Bool) -> Eq UpdatePristine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePristine -> UpdatePristine -> Bool
$c/= :: UpdatePristine -> UpdatePristine -> Bool
== :: UpdatePristine -> UpdatePristine -> Bool
$c== :: UpdatePristine -> UpdatePristine -> Bool
Eq

tentativelyAddPatches_ :: (RepoPatch p, ApplyState p ~ Tree)
                       => UpdatePristine
                       -> Repository rt p wR wU wT
                       -> Compression
                       -> Verbosity
                       -> UpdatePending
                       -> FL (PatchInfoAnd rt p) wT wY
                       -> IO (Repository rt p wR wU wY)
tentativelyAddPatches_ :: UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdatePending
-> FL (PatchInfoAnd rt p) wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatches_ UpdatePristine
upr Repository rt p wR wU wT
r Compression
c Verbosity
v UpdatePending
upe FL (PatchInfoAnd rt p) wT wY
ps =
    (forall wA wB.
 Repository rt p wR wU wA
 -> PatchInfoAnd rt p wA wB -> IO (Repository rt p wR wU wB))
-> Repository rt p wR wU wT
-> FL (PatchInfoAnd rt p) wT wY
-> IO (Repository rt p wR wU wY)
forall (m :: * -> *) (r :: * -> *) (p :: * -> * -> *) wX wY.
Monad m =>
(forall wA wB. r wA -> p wA wB -> m (r wB))
-> r wX -> FL p wX wY -> m (r wY)
foldFL_M (\Repository rt p wR wU wA
r' PatchInfoAnd rt p wA wB
p -> UpdatePristine
-> Repository rt p wR wU wA
-> Compression
-> Verbosity
-> UpdatePending
-> PatchInfoAnd rt p wA wB
-> IO (Repository rt p wR wU wB)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(RepoPatch p, ApplyState p ~ Tree) =>
UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdatePending
-> PatchInfoAnd rt p wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatch_ UpdatePristine
upr Repository rt p wR wU wA
r' Compression
c Verbosity
v UpdatePending
upe PatchInfoAnd rt p wA wB
p) Repository rt p wR wU wT
r FL (PatchInfoAnd rt p) wT wY
ps

tentativelyAddPatch_ :: (RepoPatch p, ApplyState p ~ Tree)
                     => UpdatePristine
                     -> Repository rt p wR wU wT
                     -> Compression
                     -> Verbosity
                     -> UpdatePending
                     -> PatchInfoAnd rt p wT wY
                     -> IO (Repository rt p wR wU wY)
tentativelyAddPatch_ :: UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdatePending
-> PatchInfoAnd rt p wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatch_ UpdatePristine
upr Repository rt p wR wU wT
r Compression
compr Verbosity
verb UpdatePending
upe PatchInfoAnd rt p wT wY
p = do
    let r' :: Repository rt p wR wU wT'
r' = Repository rt p wR wU wT -> Repository rt p wR wU wT'
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wT'.
Repository rt p wR wU wT -> Repository rt p wR wU wT'
unsafeCoerceT Repository rt p wR wU wT
r
    Repository rt p wR wU wT
-> Repository rt p wR wU wY
-> (Suspended p wT wT -> Suspended p wY wY)
-> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
RepoPatch p =>
Repository rt p wR wU wT
-> Repository rt p wR wU wY
-> (Suspended p wT wT -> Suspended p wY wY)
-> IO ()
withTentativeRebase Repository rt p wR wU wT
r Repository rt p wR wU wY
forall wT'. Repository rt p wR wU wT'
r' (Named p wT wY -> Suspended p wT wT -> Suspended p wY wY
forall (p :: * -> * -> *) wX wY.
(PrimPatchBase p, Commute p, FromPrim p, Effect p) =>
Named p wX wY -> Suspended p wX wX -> Suspended p wY wY
removeFixupsFromSuspended (Named p wT wY -> Suspended p wT wT -> Suspended p wY wY)
-> Named p wT wY -> Suspended p wT wT -> Suspended p wY wY
forall a b. (a -> b) -> a -> b
$ PatchInfoAnd rt p wT wY -> Named p wT wY
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> p wA wB
hopefully PatchInfoAnd rt p wT wY
p)
    Repository rt p wR wU wT
-> IO (Repository rt p wR wU wY) -> IO (Repository rt p wR wU wY)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT a.
Repository rt p wR wU wT -> IO a -> IO a
withRepoLocation Repository rt p wR wU wT
r (IO (Repository rt p wR wU wY) -> IO (Repository rt p wR wU wY))
-> IO (Repository rt p wR wU wY) -> IO (Repository rt p wR wU wY)
forall a b. (a -> b) -> a -> b
$ do
       Cache -> Compression -> PatchInfoAnd rt p wT wY -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
Cache -> Compression -> PatchInfoAnd rt p wX wY -> IO ()
addToTentativeInventory (Repository rt p wR wU wT -> Cache
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p wR wU wT
r) Compression
compr PatchInfoAnd rt p wT wY
p
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UpdatePristine
upr UpdatePristine -> UpdatePristine -> Bool
forall a. Eq a => a -> a -> Bool
== UpdatePristine
UpdatePristine) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          FilePath -> IO ()
debugMessage FilePath
"Applying to pristine cache..."
          Repository rt p wR wU wT
-> ApplyDir -> Verbosity -> PatchInfoAnd rt p wT wY -> IO ()
forall (q :: * -> * -> *) (rt :: RepoType) (p :: * -> * -> *) wR wU
       wT wY.
(ApplyState q ~ Tree, Apply q, ShowPatch q) =>
Repository rt p wR wU wT
-> ApplyDir -> Verbosity -> q wT wY -> IO ()
applyToTentativePristine Repository rt p wR wU wT
r ApplyDir
ApplyNormal Verbosity
verb PatchInfoAnd rt p wT wY
p
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UpdatePending
upe UpdatePending -> UpdatePending -> Bool
forall a. Eq a => a -> a -> Bool
== UpdatePending
YesUpdatePending) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          FilePath -> IO ()
debugMessage FilePath
"Updating pending..."
          Repository rt p wR wU wY -> FL (PrimOf p) wT wY -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wO.
RepoPatch p =>
Repository rt p wR wU wT -> FL (PrimOf p) wO wT -> IO ()
tentativelyRemoveFromPending Repository rt p wR wU wY
forall wT'. Repository rt p wR wU wT'
r' (PatchInfoAnd rt p wT wY
-> FL (PrimOf (PatchInfoAndG rt (Named p))) wT wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect PatchInfoAnd rt p wT wY
p)
       Repository rt p wR wU wY -> IO (Repository rt p wR wU wY)
forall (m :: * -> *) a. Monad m => a -> m a
return Repository rt p wR wU wY
forall wT'. Repository rt p wR wU wT'
r'

tentativelyRemovePatches :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
                         => Repository rt p wR wU wT
                         -> Compression
                         -> UpdatePending
                         -> FL (PatchInfoAnd rt p) wX wT
                         -> IO (Repository rt p wR wU wX)
tentativelyRemovePatches :: Repository rt p wR wU wT
-> Compression
-> UpdatePending
-> FL (PatchInfoAnd rt p) wX wT
-> IO (Repository rt p wR wU wX)
tentativelyRemovePatches = UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> UpdatePending
-> FL (PatchInfoAnd rt p) wX wT
-> IO (Repository rt p wR wU wX)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> UpdatePending
-> FL (PatchInfoAnd rt p) wX wT
-> IO (Repository rt p wR wU wX)
tentativelyRemovePatches_ UpdatePristine
UpdatePristine

newtype Dup p wX = Dup { Dup p wX -> p wX wX
unDup :: p wX wX }

foldrwFL' :: (forall wA wB. p wA wB -> s wB wB -> s wA wA)
          -> FL p wX wY -> s wY wY -> s wX wX
foldrwFL' :: (forall wA wB. p wA wB -> s wB wB -> s wA wA)
-> FL p wX wY -> s wY wY -> s wX wX
foldrwFL' forall wA wB. p wA wB -> s wB wB -> s wA wA
f FL p wX wY
ps = Dup s wX -> s wX wX
forall (p :: * -> * -> *) wX. Dup p wX -> p wX wX
unDup (Dup s wX -> s wX wX)
-> (s wY wY -> Dup s wX) -> s wY wY -> s wX wX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wA wB. p wA wB -> Dup s wB -> Dup s wA)
-> FL p wX wY -> Dup s wY -> Dup s wX
forall (p :: * -> * -> *) (r :: * -> *) wX wY.
(forall wA wB. p wA wB -> r wB -> r wA)
-> FL p wX wY -> r wY -> r wX
foldrwFL (\p wA wB
p -> (s wA wA -> Dup s wA
forall (p :: * -> * -> *) wX. p wX wX -> Dup p wX
Dup (s wA wA -> Dup s wA)
-> (Dup s wB -> s wA wA) -> Dup s wB -> Dup s wA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p wA wB -> s wB wB -> s wA wA
forall wA wB. p wA wB -> s wB wB -> s wA wA
f p wA wB
p (s wB wB -> s wA wA)
-> (Dup s wB -> s wB wB) -> Dup s wB -> s wA wA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dup s wB -> s wB wB
forall (p :: * -> * -> *) wX. Dup p wX -> p wX wX
unDup)) FL p wX wY
ps (Dup s wY -> Dup s wX)
-> (s wY wY -> Dup s wY) -> s wY wY -> Dup s wX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s wY wY -> Dup s wY
forall (p :: * -> * -> *) wX. p wX wX -> Dup p wX
Dup

tentativelyRemovePatches_ :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
                          => UpdatePristine
                          -> Repository rt p wR wU wT
                          -> Compression
                          -> UpdatePending
                          -> FL (PatchInfoAnd rt p) wX wT
                          -> IO (Repository rt p wR wU wX)
tentativelyRemovePatches_ :: UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> UpdatePending
-> FL (PatchInfoAnd rt p) wX wT
-> IO (Repository rt p wR wU wX)
tentativelyRemovePatches_ UpdatePristine
upr Repository rt p wR wU wT
r Compression
compr UpdatePending
upe FL (PatchInfoAnd rt p) wX wT
ps
  | RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
HashedInventory (Repository rt p wR wU wT -> RepoFormat
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository rt p wR wU wT
r) = do
      Repository rt p wR wU wT
-> IO (Repository rt p wR wU wX) -> IO (Repository rt p wR wU wX)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT a.
Repository rt p wR wU wT -> IO a -> IO a
withRepoLocation Repository rt p wR wU wT
r (IO (Repository rt p wR wU wX) -> IO (Repository rt p wR wU wX))
-> IO (Repository rt p wR wU wX) -> IO (Repository rt p wR wU wX)
forall a b. (a -> b) -> a -> b
$ do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (UpdatePristine
upr UpdatePristine -> UpdatePristine -> Bool
forall a. Eq a => a -> a -> Bool
== UpdatePristine
DontUpdatePristineNorRevert) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Repository rt p wR wU wT -> FL (PatchInfoAnd rt p) wX wT -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> FL (PatchInfoAnd rt p) wX wT -> IO ()
removeFromUnrevertContext Repository rt p wR wU wT
r FL (PatchInfoAnd rt p) wX wT
ps
        Sealed FL (PrimOf p) wT wX
pend <- Repository rt p wR wU wT -> IO (Sealed (FL (PrimOf p) wT))
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> IO (Sealed (FL (PrimOf p) wT))
readTentativePending Repository rt p wR wU wT
r
        FilePath -> IO ()
debugMessage FilePath
"Removing changes from tentative inventory..."
        Repository rt p wR wU wX
r' <- Repository rt p wR wU wT
-> Compression
-> FL (PatchInfoAnd rt p) wX wT
-> IO (Repository rt p wR wU wX)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT
-> Compression
-> FL (PatchInfoAnd rt p) wX wT
-> IO (Repository rt p wR wU wX)
removeFromTentativeInventory Repository rt p wR wU wT
r Compression
compr FL (PatchInfoAnd rt p) wX wT
ps
        Repository rt p wR wU wT
-> Repository rt p wR wU wX
-> (Suspended p wT wT -> Suspended p wX wX)
-> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
RepoPatch p =>
Repository rt p wR wU wT
-> Repository rt p wR wU wY
-> (Suspended p wT wT -> Suspended p wY wY)
-> IO ()
withTentativeRebase Repository rt p wR wU wT
r Repository rt p wR wU wX
r'
          ((forall wA wB.
 PatchInfoAnd rt p wA wB -> Suspended p wB wB -> Suspended p wA wA)
-> FL (PatchInfoAnd rt p) wX wT
-> Suspended p wT wT
-> Suspended p wX wX
forall (p :: * -> * -> *) (s :: * -> * -> *) wX wY.
(forall wA wB. p wA wB -> s wB wB -> s wA wA)
-> FL p wX wY -> s wY wY -> s wX wX
foldrwFL' (Named p wA wB -> Suspended p wB wB -> Suspended p wA wA
forall (p :: * -> * -> *) wX wY.
(PrimPatchBase p, Commute p, FromPrim p, Effect p) =>
Named p wX wY -> Suspended p wY wY -> Suspended p wX wX
addFixupsToSuspended (Named p wA wB -> Suspended p wB wB -> Suspended p wA wA)
-> (PatchInfoAndG rt (Named p) wA wB -> Named p wA wB)
-> PatchInfoAndG rt (Named p) wA wB
-> Suspended p wB wB
-> Suspended p wA wA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAndG rt (Named p) wA wB -> Named p wA wB
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> p wA wB
hopefully) FL (PatchInfoAnd rt p) wX wT
ps)
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UpdatePristine
upr UpdatePristine -> UpdatePristine -> Bool
forall a. Eq a => a -> a -> Bool
== UpdatePristine
UpdatePristine) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          ApplyDir -> FL (PatchInfoAnd rt p) wX wT -> IO ()
forall (p :: * -> * -> *) wX wY.
(ApplyState p ~ Tree, Apply p) =>
ApplyDir -> p wX wY -> IO ()
applyToTentativePristineCwd ApplyDir
ApplyInverted (FL (PatchInfoAnd rt p) wX wT -> IO ())
-> FL (PatchInfoAnd rt p) wX wT -> IO ()
forall a b. (a -> b) -> a -> b
$
            FilePath
-> FL (PatchInfoAnd rt p) wX wT -> FL (PatchInfoAnd rt p) wX wT
forall (a :: * -> * -> *) wX wY.
FilePath -> FL a wX wY -> FL a wX wY
progressFL FilePath
"Applying inverse to pristine" FL (PatchInfoAnd rt p) wX wT
ps
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UpdatePending
upe UpdatePending -> UpdatePending -> Bool
forall a. Eq a => a -> a -> Bool
== UpdatePending
YesUpdatePending) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          FilePath -> IO ()
debugMessage FilePath
"Adding changes to pending..."
          Repository rt p wR wU wX -> FL (PrimOf p) wX wX -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
RepoPatch p =>
Repository rt p wR wU wT -> FL (PrimOf p) wT wY -> IO ()
writeTentativePending Repository rt p wR wU wX
r' (FL (PrimOf p) wX wX -> IO ()) -> FL (PrimOf p) wX wX -> IO ()
forall a b. (a -> b) -> a -> b
$ FL (PatchInfoAnd rt p) wX wT
-> FL (PrimOf (FL (PatchInfoAnd rt p))) wX wT
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect FL (PatchInfoAnd rt p) wX wT
ps FL (PrimOf p) wX wT -> FL (PrimOf p) wT wX -> FL (PrimOf p) wX wX
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (PrimOf p) wT wX
pend
        Repository rt p wR wU wX -> IO (Repository rt p wR wU wX)
forall (m :: * -> *) a. Monad m => a -> m a
return Repository rt p wR wU wX
r'
  | Bool
otherwise = FilePath -> IO (Repository rt p wR wU wX)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
Old.oldRepoFailMsg

-- | Attempt to remove an FL of patches from the tentative inventory.
--
-- Precondition: it must be possible to remove the patches, i.e.
--
-- * the patches are in the repository
--
-- * any necessary commutations will succeed
removeFromTentativeInventory :: forall rt p wR wU wT wX. (IsRepoType rt, RepoPatch p)
                             => Repository rt p wR wU wT
                             -> Compression
                             -> FL (PatchInfoAnd rt p) wX wT
                             -> IO (Repository rt p wR wU wX)
removeFromTentativeInventory :: Repository rt p wR wU wT
-> Compression
-> FL (PatchInfoAnd rt p) wX wT
-> IO (Repository rt p wR wU wX)
removeFromTentativeInventory Repository rt p wR wU wT
repo Compression
compr FL (PatchInfoAnd rt p) wX wT
to_remove = do
    FilePath -> IO ()
debugMessage (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Start removeFromTentativeInventory"
    PatchSet rt p Origin wT
allpatches :: PatchSet rt p Origin wT <- Repository rt p wR wU wT
-> FilePath -> IO (PatchSet rt p Origin wT)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
Repository rt p wR wU wT
-> FilePath -> IO (PatchSet rt p Origin wT)
readTentativeRepo Repository rt p wR wU wT
repo FilePath
"."
    PatchSet rt p Origin wX
remaining :: PatchSet rt p Origin wX <-
      case FL (PatchInfoAnd rt p) wX wT
-> PatchSet rt p Origin wT -> Maybe (PatchSet rt p Origin wX)
forall (p :: * -> * -> *) (rt :: RepoType) wX wY wStart.
(Commute p, Eq2 p) =>
FL (PatchInfoAnd rt p) wX wY
-> PatchSet rt p wStart wY -> Maybe (PatchSet rt p wStart wX)
removeFromPatchSet FL (PatchInfoAnd rt p) wX wT
to_remove PatchSet rt p Origin wT
allpatches of
        Maybe (PatchSet rt p Origin wX)
Nothing -> FilePath -> IO (PatchSet rt p Origin wX)
forall a. HasCallStack => FilePath -> a
error FilePath
"Hashed.removeFromTentativeInventory: precondition violated"
        Just PatchSet rt p Origin wX
r -> PatchSet rt p Origin wX -> IO (PatchSet rt p Origin wX)
forall (m :: * -> *) a. Monad m => a -> m a
return PatchSet rt p Origin wX
r
    Cache -> Compression -> PatchSet rt p Origin wX -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
Cache -> Compression -> PatchSet rt p Origin wX -> IO ()
writeTentativeInventory (Repository rt p wR wU wT -> Cache
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p wR wU wT
repo) Compression
compr PatchSet rt p Origin wX
remaining
    FilePath -> IO ()
debugMessage (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Done removeFromTentativeInventory"
    Repository rt p wR wU wX -> IO (Repository rt p wR wU wX)
forall (m :: * -> *) a. Monad m => a -> m a
return (Repository rt p wR wU wT -> Repository rt p wR wU wX
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wT'.
Repository rt p wR wU wT -> Repository rt p wR wU wT'
unsafeCoerceT Repository rt p wR wU wT
repo)

-- | Atomically copy the tentative state to the recorded state,
-- thereby committing the tentative changes that were made so far.
-- This includes inventories, pending, and the index.
finalizeRepositoryChanges :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
                          => Repository rt p wR wU wT
                          -> UpdatePending
                          -> Compression
                          -> IO (Repository rt p wT wU wT)
finalizeRepositoryChanges :: Repository rt p wR wU wT
-> UpdatePending -> Compression -> IO (Repository rt p wT wU wT)
finalizeRepositoryChanges Repository rt p wR wU wT
r UpdatePending
updatePending Compression
compr
    | RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
HashedInventory (Repository rt p wR wU wT -> RepoFormat
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository rt p wR wU wT
r) =
        Repository rt p wR wU wT
-> IO (Repository rt p wT wU wT) -> IO (Repository rt p wT wU wT)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT a.
Repository rt p wR wU wT -> IO a -> IO a
withRepoLocation Repository rt p wR wU wT
r (IO (Repository rt p wT wU wT) -> IO (Repository rt p wT wU wT))
-> IO (Repository rt p wT wU wT) -> IO (Repository rt p wT wU wT)
forall a b. (a -> b) -> a -> b
$ do
            FilePath -> IO ()
debugMessage FilePath
"Finalizing changes..."
            IO () -> IO ()
forall a. IO a -> IO a
withSignalsBlocked (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                FilePath -> FilePath -> IO ()
renameFile FilePath
tentativeRebasePath FilePath
rebasePath
                Repository rt p wR wU wT -> Compression -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> Compression -> IO ()
finalizeTentativeChanges Repository rt p wR wU wT
r Compression
compr
                Tree IO
recordedState <- Repository rt p wR wU wT -> IO (Tree IO)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO (Tree IO)
readRecorded Repository rt p wR wU wT
r
                Repository rt p wR wU wT -> UpdatePending -> Tree IO -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> UpdatePending -> Tree IO -> IO ()
finalizePending Repository rt p wR wU wT
r UpdatePending
updatePending Tree IO
recordedState
            let r' :: Repository rt p wR' wU wT
r' = Repository rt p wR wU wT -> Repository rt p wR' wU wT
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wR'.
Repository rt p wR wU wT -> Repository rt p wR' wU wT
unsafeCoerceR Repository rt p wR wU wT
r
            FilePath -> IO ()
debugMessage FilePath
"Done finalizing changes..."
            PatchSet rt p Origin Any
ps <- Repository rt p Any wU wT -> IO (PatchSet rt p Origin Any)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p Any wU wT
forall wR'. Repository rt p wR' wU wT
r'
            Bool
pi_exists <- FilePath -> IO Bool
doesPatchIndexExist (Repository rt p Any wU wT -> FilePath
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> FilePath
repoLocation Repository rt p Any wU wT
forall wR'. Repository rt p wR' wU wT
r')
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
pi_exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
              Repository rt p Any wU wT -> PatchSet rt p Origin Any -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
createOrUpdatePatchIndexDisk Repository rt p Any wU wT
forall wR'. Repository rt p wR' wU wT
r' PatchSet rt p Origin Any
ps
              IO () -> (IOError -> IO ()) -> IO ()
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` \IOError
e ->
                Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot create or update patch index: "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ IOError -> FilePath
forall a. Show a => a -> FilePath
show IOError
e
            Repository rt p wT wU wT -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO ()
updateIndex Repository rt p wT wU wT
forall wR'. Repository rt p wR' wU wT
r'
            Repository rt p wT wU wT -> IO (Repository rt p wT wU wT)
forall (m :: * -> *) a. Monad m => a -> m a
return Repository rt p wT wU wT
forall wR'. Repository rt p wR' wU wT
r'
    | Bool
otherwise = FilePath -> IO (Repository rt p wT wU wT)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
Old.oldRepoFailMsg

-- TODO: rename this and document the transaction protocol (revert/finalize)
-- clearly.
-- |Slightly confusingly named: as well as throwing away any tentative
-- changes, revertRepositoryChanges also re-initialises the tentative state.
-- It's therefore used before makign any changes to the repo.
revertRepositoryChanges :: RepoPatch p
                        => Repository rt p wR wU wT
                        -> UpdatePending
                        -> IO (Repository rt p wR wU wR)
revertRepositoryChanges :: Repository rt p wR wU wT
-> UpdatePending -> IO (Repository rt p wR wU wR)
revertRepositoryChanges Repository rt p wR wU wT
r UpdatePending
upe
  | RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
HashedInventory (Repository rt p wR wU wT -> RepoFormat
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository rt p wR wU wT
r) =
      Repository rt p wR wU wT
-> IO (Repository rt p wR wU wR) -> IO (Repository rt p wR wU wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT a.
Repository rt p wR wU wT -> IO a -> IO a
withRepoLocation Repository rt p wR wU wT
r (IO (Repository rt p wR wU wR) -> IO (Repository rt p wR wU wR))
-> IO (Repository rt p wR wU wR) -> IO (Repository rt p wR wU wR)
forall a b. (a -> b) -> a -> b
$ do
        IO ()
checkIndexIsWritable
          IO () -> (IOError -> IO ()) -> IO ()
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` \IOError
e -> FilePath -> IO ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail ([FilePath] -> FilePath
unlines [FilePath
"Cannot write index", IOError -> FilePath
forall a. Show a => a -> FilePath
show IOError
e])
        Repository rt p wR wU wT -> UpdatePending -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> UpdatePending -> IO ()
revertPending Repository rt p wR wU wT
r UpdatePending
upe
        IO ()
revertTentativeChanges
        let r' :: Repository rt p wR wU wT'
r' = Repository rt p wR wU wT -> Repository rt p wR wU wT'
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wT'.
Repository rt p wR wU wT -> Repository rt p wR wU wT'
unsafeCoerceT Repository rt p wR wU wT
r
        Repository rt p wR wU wR -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
RepoPatch p =>
Repository rt p wR wU wR -> IO ()
revertTentativeRebase Repository rt p wR wU wR
forall wT'. Repository rt p wR wU wT'
r'
        Repository rt p wR wU wR -> IO (Repository rt p wR wU wR)
forall (m :: * -> *) a. Monad m => a -> m a
return Repository rt p wR wU wR
forall wT'. Repository rt p wR wU wT'
r'
  | Bool
otherwise = FilePath -> IO (Repository rt p wR wU wR)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
Old.oldRepoFailMsg

revertTentativeRebase :: RepoPatch p => Repository rt p wR wU wR -> IO ()
revertTentativeRebase :: Repository rt p wR wU wR -> IO ()
revertTentativeRebase Repository rt p wR wU wR
repo =
  FilePath -> FilePath -> IO ()
copyFile FilePath
rebasePath FilePath
tentativeRebasePath
  IO () -> (IOError -> IO ()) -> IO ()
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` \IOError
e ->
    if IOError -> Bool
isDoesNotExistError IOError
e then
      Repository rt p wR wU wR -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
RepoPatch p =>
Repository rt p wR wU wR -> IO ()
createTentativeRebase Repository rt p wR wU wR
repo
    else
      FilePath -> IO ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ IOError -> FilePath
forall a. Show a => a -> FilePath
show IOError
e

checkIndexIsWritable :: IO ()
checkIndexIsWritable :: IO ()
checkIndexIsWritable = do
    FilePath -> IO ()
checkWritable FilePath
indexInvalidPath
    FilePath -> IO ()
checkWritable FilePath
indexPath
  where
    checkWritable :: FilePath -> IO ()
checkWritable FilePath
path = do
      Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
path
      FilePath -> IO ()
touchFile FilePath
path
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeFile FilePath
path
    touchFile :: FilePath -> IO ()
touchFile FilePath
path = FilePath -> IOMode -> IO Handle
openBinaryFile FilePath
path IOMode
AppendMode IO Handle -> (Handle -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> IO ()
hClose

removeFromUnrevertContext :: forall rt p wR wU wT wX
                           . (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
                          => Repository rt p wR wU wT
                          -> FL (PatchInfoAnd rt p) wX wT
                          -> IO ()
removeFromUnrevertContext :: Repository rt p wR wU wT -> FL (PatchInfoAnd rt p) wX wT -> IO ()
removeFromUnrevertContext Repository rt p wR wU wT
_ FL (PatchInfoAnd rt p) wX wT
NilFL = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- nothing to do
removeFromUnrevertContext Repository rt p wR wU wT
r FL (PatchInfoAnd rt p) wX wT
ps = do
  Sealed Bundle rt p Any wX
bundle <- IO (Sealed (Bundle rt p Any))
forall wB. IO (Sealed (Bundle rt p wB))
unrevert_patch_bundle IO (Sealed (Bundle rt p Any))
-> IO (Sealed (Bundle rt p Any)) -> IO (Sealed (Bundle rt p Any))
forall a. IO a -> IO a -> IO a
`catchall` Sealed (Bundle rt p Any) -> IO (Sealed (Bundle rt p Any))
forall (m :: * -> *) a. Monad m => a -> m a
return (Bundle rt p Any Any -> Sealed (Bundle rt p Any)
forall (a :: * -> *) wX. a wX -> Sealed a
seal ((:>) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) Any Any
-> Bundle rt p Any Any
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
(:>) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wX wY
-> Bundle rt p wX wY
Bundle (FL (PatchInfoAnd rt p) Any Any
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL FL (PatchInfoAnd rt p) Any Any
-> FL (PatchInfoAnd rt p) Any Any
-> (:>) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) Any Any
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (PatchInfoAnd rt p) Any Any
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)))
  Bundle rt p Any wX -> IO ()
forall wA wB. Bundle rt p wA wB -> IO ()
remove_from_unrevert_context_ Bundle rt p Any wX
bundle
  where unrevert_impossible :: IO ()
unrevert_impossible =
            do Bool
confirmed <- FilePath -> IO Bool
promptYorn FilePath
"This operation will make unrevert impossible!\nProceed?"
               if Bool
confirmed then FilePath -> IO ()
forall p. FilePathLike p => p -> IO ()
removeFileMayNotExist FilePath
unrevertPath
                            else FilePath -> IO ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Cancelled."
        unrevert_patch_bundle :: IO (Sealed (Bundle rt p wB))
        unrevert_patch_bundle :: IO (Sealed (Bundle rt p wB))
unrevert_patch_bundle = do ByteString
pf <- FilePath -> IO ByteString
B.readFile FilePath
unrevertPath
                                   case ByteString -> Either FilePath (Sealed (Bundle rt p wB))
forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
ByteString -> Either FilePath (Sealed (Bundle rt p wX))
parseBundle ByteString
pf of
                                     Right Sealed (Bundle rt p wB)
foo -> Sealed (Bundle rt p wB) -> IO (Sealed (Bundle rt p wB))
forall (m :: * -> *) a. Monad m => a -> m a
return Sealed (Bundle rt p wB)
foo
                                     Left FilePath
err -> FilePath -> IO (Sealed (Bundle rt p wB))
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO (Sealed (Bundle rt p wB)))
-> FilePath -> IO (Sealed (Bundle rt p wB))
forall a b. (a -> b) -> a -> b
$ FilePath
"Couldn't parse unrevert patch:\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err
        remove_from_unrevert_context_ :: Bundle rt p wA wB -> IO ()
        remove_from_unrevert_context_ :: Bundle rt p wA wB -> IO ()
remove_from_unrevert_context_ Bundle rt p wA wB
bundle =
         do FilePath -> IO ()
debugMessage FilePath
"Adjusting the context of the unrevert changes..."
            FilePath -> IO ()
debugMessage (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Removing "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (FL (PatchInfoAnd rt p) wX wT -> Int
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL (PatchInfoAnd rt p) wX wT
ps) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                                  FilePath
" patches in removeFromUnrevertContext!"
            PatchSet rt p Origin wT
ref <- Repository rt p wR wU wT
-> FilePath -> IO (PatchSet rt p Origin wT)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
Repository rt p wR wU wT
-> FilePath -> IO (PatchSet rt p Origin wT)
readTentativeRepo Repository rt p wR wU wT
r (Repository rt p wR wU wT -> FilePath
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> FilePath
repoLocation Repository rt p wR wU wT
r)
            let withSinglet :: Sealed (FL ppp wXxx)
                            -> (forall wYyy . ppp wXxx wYyy -> IO ()) -> IO ()
                withSinglet :: Sealed (FL ppp wXxx)
-> (forall wYyy. ppp wXxx wYyy -> IO ()) -> IO ()
withSinglet (Sealed (ppp wXxx wY
x :>: FL ppp wY wX
NilFL)) forall wYyy. ppp wXxx wYyy -> IO ()
j = ppp wXxx wY -> IO ()
forall wYyy. ppp wXxx wYyy -> IO ()
j ppp wXxx wY
x
                withSinglet Sealed (FL ppp wXxx)
_ forall wYyy. ppp wXxx wYyy -> IO ()
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Sealed PatchSet rt p Origin wX
bundle_ps <- PatchSet rt p Origin wT
-> Bundle rt p wA wB -> IO (Sealed (PatchSet rt p Origin))
forall wA wB.
PatchSet rt p Origin wT
-> Bundle rt p wA wB -> IO (Sealed (PatchSet rt p Origin))
bundle_to_patchset PatchSet rt p Origin wT
ref Bundle rt p wA wB
bundle
            Sealed (FL (PatchInfoAnd rt p) wT)
-> (forall wYyy. PatchInfoAnd rt p wT wYyy -> IO ()) -> IO ()
forall (ppp :: * -> * -> *) wXxx.
Sealed (FL ppp wXxx)
-> (forall wYyy. ppp wXxx wYyy -> IO ()) -> IO ()
withSinglet (PatchSet rt p Origin wT
-> PatchSet rt p Origin wX -> Sealed (FL (PatchInfoAnd rt p) wT)
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
(Commute p, Merge p) =>
PatchSet rt p Origin wX
-> PatchSet rt p Origin wY -> Sealed (FL (PatchInfoAnd rt p) wX)
mergeThem PatchSet rt p Origin wT
ref PatchSet rt p Origin wX
bundle_ps) ((forall wYyy. PatchInfoAnd rt p wT wYyy -> IO ()) -> IO ())
-> (forall wYyy. PatchInfoAnd rt p wT wYyy -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PatchInfoAnd rt p wT wYyy
h_us ->
                  case (:>) (RL (PatchInfoAnd rt p)) (PatchInfoAnd rt p) wX wYyy
-> Maybe
     ((:>) (PatchInfoAnd rt p) (RL (PatchInfoAnd rt p)) wX wYyy)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) (RL p) p wX wY -> Maybe ((:>) p (RL p) wX wY)
commuteRL (FL (PatchInfoAnd rt p) wX wT -> RL (PatchInfoAnd rt p) wX wT
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL (PatchInfoAnd rt p) wX wT
ps RL (PatchInfoAnd rt p) wX wT
-> PatchInfoAnd rt p wT wYyy
-> (:>) (RL (PatchInfoAnd rt p)) (PatchInfoAnd rt p) wX wYyy
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> PatchInfoAnd rt p wT wYyy
h_us) of
                    Maybe ((:>) (PatchInfoAnd rt p) (RL (PatchInfoAnd rt p)) wX wYyy)
Nothing -> IO ()
unrevert_impossible
                    Just (PatchInfoAnd rt p wX wZ
us' :> RL (PatchInfoAnd rt p) wZ wYyy
_) ->
                      case FL (PatchInfoAnd rt p) wX wT
-> PatchSet rt p Origin wT -> Maybe (PatchSet rt p Origin wX)
forall (p :: * -> * -> *) (rt :: RepoType) wX wY wStart.
(Commute p, Eq2 p) =>
FL (PatchInfoAnd rt p) wX wY
-> PatchSet rt p wStart wY -> Maybe (PatchSet rt p wStart wX)
removeFromPatchSet FL (PatchInfoAnd rt p) wX wT
ps PatchSet rt p Origin wT
ref of
                      Maybe (PatchSet rt p Origin wX)
Nothing -> IO ()
unrevert_impossible
                      Just PatchSet rt p Origin wX
common ->
                          do FilePath -> IO ()
debugMessage FilePath
"Have now found the new context..."
                             Doc
bundle' <- Maybe (Tree IO)
-> PatchSet rt p Origin wX -> FL (Named p) wX wZ -> IO Doc
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Maybe (Tree IO)
-> PatchSet rt p wStart wX -> FL (Named p) wX wY -> IO Doc
makeBundle Maybe (Tree IO)
forall a. Maybe a
Nothing PatchSet rt p Origin wX
common (PatchInfoAnd rt p wX wZ -> Named p wX wZ
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> p wA wB
hopefully PatchInfoAnd rt p wX wZ
us'Named p wX wZ -> FL (Named p) wZ wZ -> FL (Named p) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:FL (Named p) wZ wZ
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
                             FilePath -> Doc -> IO ()
forall p. FilePathLike p => p -> Doc -> IO ()
writeDocBinFile FilePath
unrevertPath Doc
bundle'
            FilePath -> IO ()
debugMessage FilePath
"Done adjusting the context of the unrevert changes!"

        bundle_to_patchset :: PatchSet rt p Origin wT
                           -> Bundle rt p wA wB
                           -> IO (SealedPatchSet rt p Origin)
        bundle_to_patchset :: PatchSet rt p Origin wT
-> Bundle rt p wA wB -> IO (Sealed (PatchSet rt p Origin))
bundle_to_patchset PatchSet rt p Origin wT
ref Bundle rt p wA wB
bundle =
          (FilePath -> IO (Sealed (PatchSet rt p Origin)))
-> (PatchSet rt p Origin wB -> IO (Sealed (PatchSet rt p Origin)))
-> Either FilePath (PatchSet rt p Origin wB)
-> IO (Sealed (PatchSet rt p Origin))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> IO (Sealed (PatchSet rt p Origin))
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (Sealed (PatchSet rt p Origin) -> IO (Sealed (PatchSet rt p Origin))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (PatchSet rt p Origin)
 -> IO (Sealed (PatchSet rt p Origin)))
-> (PatchSet rt p Origin wB -> Sealed (PatchSet rt p Origin))
-> PatchSet rt p Origin wB
-> IO (Sealed (PatchSet rt p Origin))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchSet rt p Origin wB -> Sealed (PatchSet rt p Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed) (Either FilePath (PatchSet rt p Origin wB)
 -> IO (Sealed (PatchSet rt p Origin)))
-> Either FilePath (PatchSet rt p Origin wB)
-> IO (Sealed (PatchSet rt p Origin))
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wT
-> Bundle rt p wA wB -> Either FilePath (PatchSet rt p Origin wB)
forall (p :: * -> * -> *) (rt :: RepoType) wT wA wB.
Commute p =>
PatchSet rt p Origin wT
-> Bundle rt p wA wB -> Either FilePath (PatchSet rt p Origin wB)
interpretBundle PatchSet rt p Origin wT
ref Bundle rt p wA wB
bundle

-- | Writes out a fresh copy of the inventory that minimizes the
-- amount of inventory that need be downloaded when people pull from
-- the repository.
--
-- Specifically, it breaks up the inventory on the most recent tag.
-- This speeds up most commands when run remotely, both because a
-- smaller file needs to be transfered (only the most recent
-- inventory).  It also gives a guarantee that all the patches prior
-- to a given tag are included in that tag, so less commutation and
-- history traversal is needed.  This latter issue can become very
-- important in large repositories.
reorderInventory :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
                 => Repository rt p wR wU wR
                 -> Compression
                 -> IO ()
reorderInventory :: Repository rt p wR wU wR -> Compression -> IO ()
reorderInventory Repository rt p wR wU wR
r Compression
compr
  | RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
HashedInventory (Repository rt p wR wU wR -> RepoFormat
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository rt p wR wU wR
r) = do
      PatchSet rt p Origin wR -> PatchSet rt p Origin wR
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
Commute p =>
PatchSet rt p wStart wX -> PatchSet rt p wStart wX
cleanLatestTag (PatchSet rt p Origin wR -> PatchSet rt p Origin wR)
-> IO (PatchSet rt p Origin wR) -> IO (PatchSet rt p Origin wR)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Repository rt p wR wU wR -> IO (PatchSet rt p Origin wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wR
r IO (PatchSet rt p Origin wR)
-> (PatchSet rt p Origin wR -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        Cache -> Compression -> PatchSet rt p Origin wR -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
Cache -> Compression -> PatchSet rt p Origin wX -> IO ()
writeTentativeInventory (Repository rt p wR wU wR -> Cache
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p wR wU wR
r) Compression
compr
      IO () -> IO ()
forall a. IO a -> IO a
withSignalsBlocked (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Repository rt p wR wU wR -> Compression -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> Compression -> IO ()
finalizeTentativeChanges Repository rt p wR wU wR
r Compression
compr
  | Bool
otherwise = FilePath -> IO ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
Old.oldRepoFailMsg

-- | Read inventories and patches from a repository and return them as a
-- 'PatchSet'. Note that patches and inventories are read lazily.
readRepo :: (IsRepoType rt, RepoPatch p)
         => Repository rt p wR wU wT
         -> IO (PatchSet rt p Origin wR)
readRepo :: Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wT
r
    | RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
HashedInventory (Repository rt p wR wU wT -> RepoFormat
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository rt p wR wU wT
r) = Repository rt p wR wU wT
-> FilePath -> IO (PatchSet rt p Origin wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT
-> FilePath -> IO (PatchSet rt p Origin wR)
readRepoHashed Repository rt p wR wU wT
r (Repository rt p wR wU wT -> FilePath
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> FilePath
repoLocation Repository rt p wR wU wT
r)
    | Bool
otherwise = do Sealed PatchSet rt p Origin wX
ps <- FilePath -> IO (Sealed (PatchSet rt p Origin))
forall (p :: * -> * -> *) (rt :: RepoType).
RepoPatch p =>
FilePath -> IO (SealedPatchSet rt p Origin)
Old.readOldRepo (Repository rt p wR wU wT -> FilePath
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> FilePath
repoLocation Repository rt p wR wU wT
r)
                     PatchSet rt p Origin wR -> IO (PatchSet rt p Origin wR)
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchSet rt p Origin wR -> IO (PatchSet rt p Origin wR))
-> PatchSet rt p Origin wR -> IO (PatchSet rt p Origin wR)
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wX -> PatchSet rt p Origin wR
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP PatchSet rt p Origin wX
ps

-- | XOR of all hashes of the patches' metadata.
-- It enables to quickly see whether two repositories
-- have the same patches, independently of their order.
-- It relies on the assumption that the same patch cannot
-- be present twice in a repository.
-- This checksum is not cryptographically secure,
-- see http://robotics.stanford.edu/~xb/crypto06b/ .
repoXor :: (IsRepoType rt, RepoPatch p)
        => Repository rt p wR wU wR -> IO SHA1
repoXor :: Repository rt p wR wU wR -> IO SHA1
repoXor Repository rt p wR wU wR
repo = do
  [SHA1]
hashes <- (forall wW wZ. PatchInfoAnd rt p wW wZ -> SHA1)
-> RL (PatchInfoAnd rt p) Origin wR -> [SHA1]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL (PatchInfo -> SHA1
makePatchname (PatchInfo -> SHA1)
-> (PatchInfoAndG rt (Named p) wW wZ -> PatchInfo)
-> PatchInfoAndG rt (Named p) wW wZ
-> SHA1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAndG rt (Named p) wW wZ -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info) (RL (PatchInfoAnd rt p) Origin wR -> [SHA1])
-> (PatchSet rt p Origin wR -> RL (PatchInfoAnd rt p) Origin wR)
-> PatchSet rt p Origin wR
-> [SHA1]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchSet rt p Origin wR -> RL (PatchInfoAnd rt p) Origin wR
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> RL (PatchInfoAnd rt p) wStart wX
patchSet2RL (PatchSet rt p Origin wR -> [SHA1])
-> IO (PatchSet rt p Origin wR) -> IO [SHA1]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Repository rt p wR wU wR -> IO (PatchSet rt p Origin wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wR
repo
  SHA1 -> IO SHA1
forall (m :: * -> *) a. Monad m => a -> m a
return (SHA1 -> IO SHA1) -> SHA1 -> IO SHA1
forall a b. (a -> b) -> a -> b
$ (SHA1 -> SHA1 -> SHA1) -> SHA1 -> [SHA1] -> SHA1
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SHA1 -> SHA1 -> SHA1
sha1Xor SHA1
sha1zero [SHA1]
hashes

-- | Upgrade a possible old-style rebase in progress to the new style.
upgradeOldStyleRebase :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
                      => Repository rt p wR wU wT -> Compression -> IO ()
upgradeOldStyleRebase :: Repository rt p wR wU wT -> Compression -> IO ()
upgradeOldStyleRebase Repository rt p wR wU wT
repo Compression
compr = do
  PatchSet RL (Tagged rt p) Origin wX
ts RL (PatchInfoAnd rt p) wX wT
_ <- Repository rt p wR wU wT
-> FilePath -> IO (PatchSet rt p Origin wT)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
Repository rt p wR wU wT
-> FilePath -> IO (PatchSet rt p Origin wT)
readTentativeRepo Repository rt p wR wU wT
repo (Repository rt p wR wU wT -> FilePath
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> FilePath
repoLocation Repository rt p wR wU wT
repo)
  Inventory Maybe InventoryHash
_ [(PatchInfo, PatchHash)]
invEntries <- FilePath -> IO Inventory
readInventoryPrivate FilePath
tentativeHashedInventoryPath
  Sealed RL (PatchInfoAndG rt (WrappedNamed rt p)) wX wX
wps <- Cache
-> [(PatchInfo, PatchHash)]
-> IO (Sealed (RL (PatchInfoAndG rt (WrappedNamed rt p)) wX))
forall (np :: * -> * -> *) (rt :: RepoType) wX.
ReadPatch np =>
Cache
-> [(PatchInfo, PatchHash)]
-> IO (Sealed (RL (PatchInfoAndG rt np) wX))
readPatchesFromInventory (Repository rt p wR wU wT -> Cache
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p wR wU wT
repo) [(PatchInfo, PatchHash)]
invEntries
  case RL (PatchInfoAndG rt (WrappedNamed rt p)) wX wX
-> Maybe
     ((:>)
        (RL (PatchInfoAndG rt (WrappedNamed rt p)))
        (PatchInfoAndG rt (WrappedNamed rt p))
        wX
        wX)
forall (p :: * -> * -> *) (rt :: RepoType) wA wB.
RepoPatch p =>
RL (PiaW rt p) wA wB
-> Maybe ((:>) (RL (PiaW rt p)) (PiaW rt p) wA wB)
commuteOutOldStyleRebase RL (PatchInfoAndG rt (WrappedNamed rt p)) wX wX
wps of
    Maybe
  ((:>)
     (RL (PatchInfoAndG rt (WrappedNamed rt p)))
     (PatchInfoAndG rt (WrappedNamed rt p))
     wX
     wX)
Nothing ->
      Doc -> IO ()
ePutDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
text FilePath
"Rebase is already in new style, no upgrade needed."
    Just (RL (PatchInfoAndG rt (WrappedNamed rt p)) wX wZ
wps' :> PiaW rt p wZ wX
wr) -> do
      -- FIXME inlining this action below where it is used
      -- results in lots of ambiguous type variable errors
      -- which is rather strange behavior of ghc IMHO
      let update_repo :: IO ()
update_repo =
            -- low-level call, must not try to update an existing rebase patch,
            -- nor update anything else beside the inventory
            Cache -> Compression -> PatchSet rt p Origin wZ -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
Cache -> Compression -> PatchSet rt p Origin wX -> IO ()
writeTentativeInventory
              (Repository rt p wR wU wT -> Cache
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p wR wU wT
repo)
              Compression
compr
              (RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wZ -> PatchSet rt p Origin wZ
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wX
ts ((forall wW wY. PiaW rt p wW wY -> PatchInfoAnd rt p wW wY)
-> RL (PatchInfoAndG rt (WrappedNamed rt p)) wX wZ
-> RL (PatchInfoAnd rt p) wX wZ
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> RL a wX wZ -> RL b wX wZ
mapRL_RL ((WrappedNamed rt p wW wY -> Named p wW wY)
-> PatchInfoAndG rt (WrappedNamed rt p) wW wY
-> PatchInfoAndG rt (Named p) wW wY
forall (p :: * -> * -> *) wX wY (q :: * -> * -> *)
       (rt :: RepoType).
(p wX wY -> q wX wY)
-> PatchInfoAndG rt p wX wY -> PatchInfoAndG rt q wX wY
fmapPIAP WrappedNamed rt p wW wY -> Named p wW wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
WrappedNamed rt p wX wY -> Named p wX wY
W.fromRebasing) RL (PatchInfoAndG rt (WrappedNamed rt p)) wX wZ
wps'))
      -- double check if we really have a rebase patch
      case PiaW rt p wZ wX -> WrappedNamed rt p wZ wX
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> p wA wB
hopefully PiaW rt p wZ wX
wr of
        W.NormalP Named p wZ wX
wtf ->
          FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> FilePath
renderString (Doc -> FilePath) -> Doc -> FilePath
forall a b. (a -> b) -> a -> b
$
            Doc
"internal error: expected rebase patch but found normal patch:"
            Doc -> Doc -> Doc
$$ Named p wZ wX -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch Named p wZ wX
wtf
        W.RebaseP PatchInfo
_ Suspended p wZ wZ
r -> do
          IO ()
update_repo
          Items FL (RebaseChange (PrimOf p)) Any wY
old_r <- Repository rt p wR wU Any -> IO (Suspended p Any Any)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> IO (Suspended p wT wT)
readTentativeRebase (Repository rt p wR wU wT -> Repository rt p wR wU Any
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wT'.
Repository rt p wR wU wT -> Repository rt p wR wU wT'
unsafeCoerceT Repository rt p wR wU wT
repo)
          case FL (RebaseChange (PrimOf p)) Any wY
old_r of
            FL (RebaseChange (PrimOf p)) Any wY
NilFL -> do
              Repository rt p wR wU wZ -> Suspended p wZ wZ -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> Suspended p wT wT -> IO ()
writeTentativeRebase (Repository rt p wR wU wT -> Repository rt p wR wU wZ
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wT'.
Repository rt p wR wU wT -> Repository rt p wR wU wT'
unsafeCoerceT Repository rt p wR wU wT
repo) Suspended p wZ wZ
r
              Repository rt p wT wU wT
_ <- Repository rt p wR wU wT
-> UpdatePending -> Compression -> IO (Repository rt p wT wU wT)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> UpdatePending -> Compression -> IO (Repository rt p wT wU wT)
finalizeRepositoryChanges Repository rt p wR wU wT
repo UpdatePending
NoUpdatePending Compression
compr
              RepoFormat -> FilePath -> IO ()
writeRepoFormat
                ( RepoProperty -> RepoFormat -> RepoFormat
addToFormat RepoProperty
RebaseInProgress_2_16
                (RepoFormat -> RepoFormat) -> RepoFormat -> RepoFormat
forall a b. (a -> b) -> a -> b
$ RepoProperty -> RepoFormat -> RepoFormat
removeFromFormat RepoProperty
RebaseInProgress
                (RepoFormat -> RepoFormat) -> RepoFormat -> RepoFormat
forall a b. (a -> b) -> a -> b
$ Repository rt p wR wU wT -> RepoFormat
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository rt p wR wU wT
repo)
                FilePath
formatPath
              () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            FL (RebaseChange (PrimOf p)) Any wY
_ -> do
              Doc -> IO ()
ePutDocLn
                (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$  Doc
"A new-style rebase is already in progress, not overwriting it."
                Doc -> Doc -> Doc
$$ Doc
"This should not have happened! This is the old-style rebase I found"
                Doc -> Doc -> Doc
$$ Doc
"and removed from the repository:"
                Doc -> Doc -> Doc
$$ PiaW rt p wZ wX -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch PiaW rt p wZ wX
wr