module Darcs.Repository.Pending
( readPending
, siftForPending
, tentativelyRemoveFromPending
, finalizePending
, makeNewPending
, tentativelyAddToPending
, setTentativePending
, prepend
, pendingName
) where
import Prelude ()
import Darcs.Prelude
import Control.Applicative
import qualified Data.ByteString as B ( empty )
import Control.Exception ( catch, IOException )
import Data.Maybe ( fromJust, fromMaybe )
import Darcs.Util.Printer ( errorDoc )
import Darcs.Util.Global ( darcsdir )
import Darcs.Util.Lock
( writeDocBinFile
, removeFileMayNotExist
)
import Darcs.Repository.InternalTypes ( Repository, withRepoLocation )
import Darcs.Repository.Flags
( UpdateWorking (..))
import Darcs.Patch
( readPatch, RepoPatch, PrimOf, tryToShrink
, primIsHunk, primIsBinary, commute, invert
, primIsAddfile, primIsAdddir, commuteFLorComplain
, effect, primIsSetpref, applyToTree )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd )
import Darcs.Patch.Progress (progressFL)
import Darcs.Patch.Permutations ( commuteWhatWeCanFL
, removeFL
)
import Darcs.Patch.Prim ( tryShrinkingInverse
, PrimPatch
)
import Darcs.Patch.Read ( ReadPatch(..), bracketedFL )
import Darcs.Patch.ReadMonads ( ParserM )
import Darcs.Patch.Show ( ShowPatchBasic(..), ShowPatchFor(ForStorage) )
import Darcs.Patch.Apply ( ApplyState )
import Darcs.Util.Tree ( Tree )
import Darcs.Util.Exception ( catchall )
import Darcs.Util.Workaround ( renameFile )
import Darcs.Patch.Witnesses.Eq ( EqCheck(..) )
import Darcs.Patch.Witnesses.Sealed
( Sealed(Sealed), mapSeal, seal
, FlippedSeal(FlippedSeal)
, flipSeal
)
import Darcs.Patch.Witnesses.Unsafe
( unsafeCoerceP, unsafeCoercePStart )
import Darcs.Patch.Witnesses.Ordered
( FL(..), RL(..), (:>)(..), (+>+)
, lengthFL, allFL, filterOutFLFL
, reverseFL, mapFL )
import Darcs.Util.ByteString ( gzReadFilePS )
import Darcs.Util.Printer ( Doc, ($$), text, vcat, (<+>) )
import Darcs.Util.Progress ( debugMessage )
pendingName :: String
pendingName :: String
pendingName = String
darcsdir String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/patches/pending"
newSuffix, tentativeSuffix :: String
newSuffix :: String
newSuffix = ".new"
tentativeSuffix :: String
tentativeSuffix = ".tentative"
readPending :: RepoPatch p => Repository rt p wR wU wT
-> IO (Sealed (FL (PrimOf p) wT))
readPending :: Repository rt p wR wU wT -> IO (Sealed (FL (PrimOf p) wT))
readPending = String
-> Repository rt p wR wU wT -> IO (Sealed (FL (PrimOf p) wT))
forall (prim :: * -> * -> *) (rt :: RepoType) (p :: * -> * -> *) wR
wU wT wX.
ReadPatch prim =>
String -> Repository rt p wR wU wT -> IO (Sealed (FL prim wX))
readPendingFile ""
readTentativePending :: RepoPatch p => Repository rt p wR wU wT
-> IO (Sealed (FL (PrimOf p) wT))
readTentativePending :: Repository rt p wR wU wT -> IO (Sealed (FL (PrimOf p) wT))
readTentativePending = String
-> Repository rt p wR wU wT -> IO (Sealed (FL (PrimOf p) wT))
forall (prim :: * -> * -> *) (rt :: RepoType) (p :: * -> * -> *) wR
wU wT wX.
ReadPatch prim =>
String -> Repository rt p wR wU wT -> IO (Sealed (FL prim wX))
readPendingFile String
tentativeSuffix
readNewPending :: RepoPatch p => Repository rt p wR wU wT
-> IO (Sealed (FL (PrimOf p) wT))
readNewPending :: Repository rt p wR wU wT -> IO (Sealed (FL (PrimOf p) wT))
readNewPending = String
-> Repository rt p wR wU wT -> IO (Sealed (FL (PrimOf p) wT))
forall (prim :: * -> * -> *) (rt :: RepoType) (p :: * -> * -> *) wR
wU wT wX.
ReadPatch prim =>
String -> Repository rt p wR wU wT -> IO (Sealed (FL prim wX))
readPendingFile String
newSuffix
readPendingFile :: ReadPatch prim => String -> Repository rt p wR wU wT
-> IO (Sealed (FL prim wX))
readPendingFile :: String -> Repository rt p wR wU wT -> IO (Sealed (FL prim wX))
readPendingFile suffix :: String
suffix _ = do
ByteString
pend <- String -> IO ByteString
gzReadFilePS (String
pendingName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suffix) IO ByteString -> IO ByteString -> IO ByteString
forall a. IO a -> IO a -> IO a
`catchall` ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
Sealed (FL prim wX) -> IO (Sealed (FL prim wX))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL prim wX) -> IO (Sealed (FL prim wX)))
-> (ByteString -> Sealed (FL prim wX))
-> ByteString
-> IO (Sealed (FL prim wX))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sealed (FL prim wX)
-> (Sealed (FLM prim wX) -> Sealed (FL prim wX))
-> Maybe (Sealed (FLM prim wX))
-> Sealed (FL prim wX)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FL prim wX wX -> Sealed (FL prim wX)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed FL prim wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL) ((forall wX. FLM prim wX wX -> FL prim wX wX)
-> Sealed (FLM prim wX) -> Sealed (FL prim wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall wX. FLM prim wX wX -> FL prim wX wX
forall (p :: * -> * -> *) wX wY. FLM p wX wY -> FL p wX wY
unFLM) (Maybe (Sealed (FLM prim wX)) -> Sealed (FL prim wX))
-> (ByteString -> Maybe (Sealed (FLM prim wX)))
-> ByteString
-> Sealed (FL prim wX)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Sealed (FLM prim wX))
forall (p :: * -> * -> *) wX.
ReadPatch p =>
ByteString -> Maybe (Sealed (p wX))
readPatch (ByteString -> IO (Sealed (FL prim wX)))
-> ByteString -> IO (Sealed (FL prim wX))
forall a b. (a -> b) -> a -> b
$ ByteString
pend
newtype FLM p wX wY = FLM { FLM p wX wY -> FL p wX wY
unFLM :: FL p wX wY }
instance ReadPatch p => ReadPatch (FLM p) where
readPatch' :: m (Sealed (FLM p wX))
readPatch' = (forall wX. FL p wX wX -> FLM p wX wX)
-> Sealed (FL p wX) -> Sealed (FLM p wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall wX. FL p wX wX -> FLM p wX wX
forall (p :: * -> * -> *) wX wY. FL p wX wY -> FLM p wX wY
FLM (Sealed (FL p wX) -> Sealed (FLM p wX))
-> m (Sealed (FL p wX)) -> m (Sealed (FLM p wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall wY. m (Sealed (p wY)))
-> Char -> Char -> m (Sealed (FL p wX))
forall (m :: * -> *) (p :: * -> * -> *) wX.
ParserM m =>
(forall wY. m (Sealed (p wY)))
-> Char -> Char -> m (Sealed (FL p wX))
readMaybeBracketedFL forall wY. m (Sealed (p wY))
forall (p :: * -> * -> *) (m :: * -> *) wX.
(ReadPatch p, ParserM m) =>
m (Sealed (p wX))
readPatch' '{' '}'
instance ShowPatchBasic p => ShowPatchBasic (FLM p) where
showPatch :: ShowPatchFor -> FLM p wX wY -> Doc
showPatch f :: ShowPatchFor
f = (forall wX wY. p wX wY -> Doc) -> Char -> Char -> FL p wX wY -> Doc
forall (p :: * -> * -> *) wA wB.
(forall wX wY. p wX wY -> Doc) -> Char -> Char -> FL p wA wB -> Doc
showMaybeBracketedFL (ShowPatchFor -> p wX wY -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
f) '{' '}' (FL p wX wY -> Doc)
-> (FLM p wX wY -> FL p wX wY) -> FLM p wX wY -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FLM p wX wY -> FL p wX wY
forall (p :: * -> * -> *) wX wY. FLM p wX wY -> FL p wX wY
unFLM
readMaybeBracketedFL :: forall m p wX . ParserM m
=> (forall wY . m (Sealed (p wY))) -> Char -> Char
-> m (Sealed (FL p wX))
readMaybeBracketedFL :: (forall wY. m (Sealed (p wY)))
-> Char -> Char -> m (Sealed (FL p wX))
readMaybeBracketedFL parser :: forall wY. m (Sealed (p wY))
parser pre :: Char
pre post :: Char
post =
(forall wY. m (Sealed (p wY)))
-> Char -> Char -> m (Sealed (FL p wX))
forall (p :: * -> * -> *) (m :: * -> *) wX.
ParserM m =>
(forall wY. m (Sealed (p wY)))
-> Char -> Char -> m (Sealed (FL p wX))
bracketedFL forall wY. m (Sealed (p wY))
parser Char
pre Char
post m (Sealed (FL p wX))
-> m (Sealed (FL p wX)) -> m (Sealed (FL p wX))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((forall wX. p wX wX -> FL p wX wX)
-> Sealed (p wX) -> Sealed (FL p wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal (p wX wX -> FL p wX wX -> FL p wX wX
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:FL p wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL) (Sealed (p wX) -> Sealed (FL p wX))
-> m (Sealed (p wX)) -> m (Sealed (FL p wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Sealed (p wX))
forall wY. m (Sealed (p wY))
parser)
showMaybeBracketedFL :: (forall wX wY . p wX wY -> Doc) -> Char -> Char
-> FL p wA wB -> Doc
showMaybeBracketedFL :: (forall wX wY. p wX wY -> Doc) -> Char -> Char -> FL p wA wB -> Doc
showMaybeBracketedFL _ pre :: Char
pre post :: Char
post NilFL = String -> Doc
text [Char
pre] Doc -> Doc -> Doc
$$ String -> Doc
text [Char
post]
showMaybeBracketedFL printer :: forall wX wY. p wX wY -> Doc
printer _ _ (p :: p wA wY
p :>: NilFL) = p wA wY -> Doc
forall wX wY. p wX wY -> Doc
printer p wA wY
p
showMaybeBracketedFL printer :: forall wX wY. p wX wY -> Doc
printer pre :: Char
pre post :: Char
post ps :: FL p wA wB
ps = String -> Doc
text [Char
pre] Doc -> Doc -> Doc
$$
[Doc] -> Doc
vcat ((forall wX wY. p wX wY -> Doc) -> FL p wA wB -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall wX wY. p wX wY -> Doc
printer FL p wA wB
ps) Doc -> Doc -> Doc
$$
String -> Doc
text [Char
post]
writeTentativePending :: RepoPatch p => Repository rt p wR wU wT
-> FL (PrimOf p) wT wY -> IO ()
writeTentativePending :: Repository rt p wR wU wT -> FL (PrimOf p) wT wY -> IO ()
writeTentativePending = String -> Repository rt p wR wU wT -> FL (PrimOf p) wT wY -> IO ()
forall (prim :: * -> * -> *) (rt :: RepoType) (p :: * -> * -> *) wR
wU wT wX wY.
ShowPatchBasic prim =>
String -> Repository rt p wR wU wT -> FL prim wX wY -> IO ()
writePendingFile String
tentativeSuffix
writeNewPending :: RepoPatch p => Repository rt p wR wU wT
-> FL (PrimOf p) wT wY -> IO ()
writeNewPending :: Repository rt p wR wU wT -> FL (PrimOf p) wT wY -> IO ()
writeNewPending = String -> Repository rt p wR wU wT -> FL (PrimOf p) wT wY -> IO ()
forall (prim :: * -> * -> *) (rt :: RepoType) (p :: * -> * -> *) wR
wU wT wX wY.
ShowPatchBasic prim =>
String -> Repository rt p wR wU wT -> FL prim wX wY -> IO ()
writePendingFile String
newSuffix
writePendingFile :: ShowPatchBasic prim => String -> Repository rt p wR wU wT
-> FL prim wX wY -> IO ()
writePendingFile :: String -> Repository rt p wR wU wT -> FL prim wX wY -> IO ()
writePendingFile suffix :: String
suffix _ = String -> FLM prim wX wY -> IO ()
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
String -> p wX wY -> IO ()
writePatch String
name (FLM prim wX wY -> IO ())
-> (FL prim wX wY -> FLM prim wX wY) -> FL prim wX wY -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FL prim wX wY -> FLM prim wX wY
forall (p :: * -> * -> *) wX wY. FL p wX wY -> FLM p wX wY
FLM
where
name :: String
name = String
pendingName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suffix
writePatch :: ShowPatchBasic p => FilePath -> p wX wY -> IO ()
writePatch :: String -> p wX wY -> IO ()
writePatch f :: String
f p :: p wX wY
p = String -> Doc -> IO ()
forall p. FilePathLike p => p -> Doc -> IO ()
writeDocBinFile String
f (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowPatchFor -> p wX wY -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForStorage p wX wY
p Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text "\n"
siftForPending :: forall prim wX wY . PrimPatch prim => FL prim wX wY -> Sealed (FL prim wX)
siftForPending :: FL prim wX wY -> Sealed (FL prim wX)
siftForPending simple_ps :: FL prim wX wY
simple_ps =
if (forall wX wY. prim wX wY -> Bool) -> FL prim wX wY -> Bool
forall (a :: * -> * -> *) wW wZ.
(forall wX wY. a wX wY -> Bool) -> FL a wW wZ -> Bool
allFL (\p :: prim wX wY
p -> prim wX wY -> Bool
forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsAddfile prim wX wY
p Bool -> Bool -> Bool
|| prim wX wY -> Bool
forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsAdddir prim wX wY
p) FL prim wX wY
oldps
then FL prim wX wY -> Sealed (FL prim wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal FL prim wX wY
oldps
else Maybe (Sealed (FL prim wX)) -> Sealed (FL prim wX)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Sealed (FL prim wX)) -> Sealed (FL prim wX))
-> Maybe (Sealed (FL prim wX)) -> Sealed (FL prim wX)
forall a b. (a -> b) -> a -> b
$ do
Sealed x :: FL prim wX wX
x <- Sealed (FL prim wX) -> Maybe (Sealed (FL prim wX))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL prim wX) -> Maybe (Sealed (FL prim wX)))
-> Sealed (FL prim wX) -> Maybe (Sealed (FL prim wX))
forall a b. (a -> b) -> a -> b
$ FL prim wY wY -> RL prim wX wY -> Sealed (FL prim wX)
forall wA wB wC.
FL prim wA wB -> RL prim wC wA -> Sealed (FL prim wC)
sift FL prim wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL (RL prim wX wY -> Sealed (FL prim wX))
-> RL prim wX wY -> Sealed (FL prim wX)
forall a b. (a -> b) -> a -> b
$ FL prim wX wY -> RL prim wX wY
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL prim wX wY
oldps
Sealed (FL prim wX) -> Maybe (Sealed (FL prim wX))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL prim wX) -> Maybe (Sealed (FL prim wX)))
-> Sealed (FL prim wX) -> Maybe (Sealed (FL prim wX))
forall a b. (a -> b) -> a -> b
$ case FL prim wX wX -> FL prim wX wX
forall (prim :: * -> * -> *) wX wY.
PrimCanonize prim =>
FL prim wX wY -> FL prim wX wY
tryToShrink FL prim wX wX
x of
ps :: FL prim wX wX
ps | FL prim wX wX -> Int
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL prim wX wX
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< FL prim wX wY -> Int
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL prim wX wY
oldps -> FL prim wX wX -> Sealed (FL prim wX)
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
FL prim wX wY -> Sealed (FL prim wX)
siftForPending FL prim wX wX
ps
| Bool
otherwise -> FL prim wX wX -> Sealed (FL prim wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal FL prim wX wX
ps
where
oldps :: FL prim wX wY
oldps = FL prim wX wY -> Maybe (FL prim wX wY) -> FL prim wX wY
forall a. a -> Maybe a -> a
fromMaybe FL prim wX wY
simple_ps (Maybe (FL prim wX wY) -> FL prim wX wY)
-> Maybe (FL prim wX wY) -> FL prim wX wY
forall a b. (a -> b) -> a -> b
$ FL prim wX wY -> Maybe (FL prim wX wY)
forall (prim :: * -> * -> *) wX wY.
PrimCanonize prim =>
FL prim wX wY -> Maybe (FL prim wX wY)
tryShrinkingInverse (FL prim wX wY -> Maybe (FL prim wX wY))
-> FL prim wX wY -> Maybe (FL prim wX wY)
forall a b. (a -> b) -> a -> b
$ FL prim wX wY -> FL prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
FL prim wX wY -> FL prim wX wY
crudeSift FL prim wX wY
simple_ps
sift :: FL prim wA wB -> RL prim wC wA -> Sealed (FL prim wC)
sift :: FL prim wA wB -> RL prim wC wA -> Sealed (FL prim wC)
sift sofar :: FL prim wA wB
sofar NilRL = FL prim wA wB -> Sealed (FL prim wA)
forall (a :: * -> *) wX. a wX -> Sealed a
seal FL prim wA wB
sofar
sift sofar :: FL prim wA wB
sofar (ps :: RL prim wC wY
ps:<:p :: prim wY wA
p) | prim wY wA -> Bool
forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsHunk prim wY wA
p Bool -> Bool -> Bool
|| prim wY wA -> Bool
forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsBinary prim wY wA
p =
case (:>) prim (FL prim) wY wB
-> Either (Sealed2 prim) ((:>) (FL prim) prim wY wB)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p (FL p) wX wY -> Either (Sealed2 p) ((:>) (FL p) p wX wY)
commuteFLorComplain (prim wY wA
p prim wY wA -> FL prim wA wB -> (:>) prim (FL prim) wY wB
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL prim wA wB
sofar) of
Right (sofar' :: FL prim wY wZ
sofar' :> _) -> FL prim wY wZ -> RL prim wC wY -> Sealed (FL prim wC)
forall wA wB wC.
FL prim wA wB -> RL prim wC wA -> Sealed (FL prim wC)
sift FL prim wY wZ
sofar' RL prim wC wY
ps
Left _ -> FL prim wY wB -> RL prim wC wY -> Sealed (FL prim wC)
forall wA wB wC.
FL prim wA wB -> RL prim wC wA -> Sealed (FL prim wC)
sift (prim wY wA
pprim wY wA -> FL prim wA wB -> FL prim wY wB
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:FL prim wA wB
sofar) RL prim wC wY
ps
sift sofar :: FL prim wA wB
sofar (ps :: RL prim wC wY
ps:<:p :: prim wY wA
p) = FL prim wY wB -> RL prim wC wY -> Sealed (FL prim wC)
forall wA wB wC.
FL prim wA wB -> RL prim wC wA -> Sealed (FL prim wC)
sift (prim wY wA
pprim wY wA -> FL prim wA wB -> FL prim wY wB
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:FL prim wA wB
sofar) RL prim wC wY
ps
crudeSift :: forall prim wX wY . PrimPatch prim => FL prim wX wY -> FL prim wX wY
crudeSift :: FL prim wX wY -> FL prim wX wY
crudeSift xs :: FL prim wX wY
xs =
if FL prim wX wY -> Bool
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
FL prim wX wY -> Bool
isSimple FL prim wX wY
xs then (forall wX wY. prim wX wY -> EqCheck wX wY)
-> FL prim wX wY -> FL prim wX wY
forall (p :: * -> * -> *) wW wZ.
(forall wX wY. p wX wY -> EqCheck wX wY)
-> FL p wW wZ -> FL p wW wZ
filterOutFLFL forall wX wY. prim wX wY -> EqCheck wX wY
ishunkbinary FL prim wX wY
xs else FL prim wX wY
xs
where
ishunkbinary :: prim wA wB -> EqCheck wA wB
ishunkbinary :: prim wA wB -> EqCheck wA wB
ishunkbinary x :: prim wA wB
x | prim wA wB -> Bool
forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsHunk prim wA wB
x Bool -> Bool -> Bool
|| prim wA wB -> Bool
forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsBinary prim wA wB
x = EqCheck Any Any -> EqCheck wA wB
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP EqCheck Any Any
forall wA. EqCheck wA wA
IsEq
| Bool
otherwise = EqCheck wA wB
forall wA wB. EqCheck wA wB
NotEq
tentativelyRemoveFromPending :: forall rt p wR wU wT wX wY. (RepoPatch p)
=> Repository rt p wR wU wT
-> UpdateWorking
-> PatchInfoAnd rt p wX wY
-> IO ()
tentativelyRemoveFromPending :: Repository rt p wR wU wT
-> UpdateWorking -> PatchInfoAnd rt p wX wY -> IO ()
tentativelyRemoveFromPending _ NoUpdateWorking _ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
tentativelyRemoveFromPending repo :: Repository rt p wR wU wT
repo YesUpdateWorking p :: PatchInfoAnd rt p wX wY
p = do
Sealed pend :: 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
repo
let effectp :: FL (PrimOf p) wX wY
effectp = if FL (PrimOf p) wT wX -> Bool
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
FL prim wX wY -> Bool
isSimple FL (PrimOf p) wT wX
pend
then FL (PrimOf p) wX wY -> FL (PrimOf p) wX wY
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
FL prim wX wY -> FL prim wX wY
crudeSift (FL (PrimOf p) wX wY -> FL (PrimOf p) wX wY)
-> FL (PrimOf p) wX wY -> FL (PrimOf p) wX wY
forall a b. (a -> b) -> a -> b
$ PatchInfoAnd rt p wX wY -> FL (PrimOf (PatchInfoAnd rt p)) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect PatchInfoAnd rt p wX wY
p
else PatchInfoAnd rt p wX wY -> FL (PrimOf (PatchInfoAnd rt p)) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect PatchInfoAnd rt p wX wY
p
Sealed newpend :: FL (PrimOf p) wY wX
newpend <- Sealed (FL (PrimOf p) wY) -> IO (Sealed (FL (PrimOf p) wY))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL (PrimOf p) wY) -> IO (Sealed (FL (PrimOf p) wY)))
-> Sealed (FL (PrimOf p) wY) -> IO (Sealed (FL (PrimOf p) wY))
forall a b. (a -> b) -> a -> b
$ FL (PrimOf p) wX wY
-> FL (PrimOf p) wX wX -> Sealed (FL (PrimOf p) wY)
forall wA wB wC.
FL (PrimOf p) wA wB
-> FL (PrimOf p) wA wC -> Sealed (FL (PrimOf p) wB)
rmpend (String -> FL (PrimOf p) wX wY -> FL (PrimOf p) wX wY
forall (a :: * -> * -> *) wX wY. String -> FL a wX wY -> FL a wX wY
progressFL "Removing from pending:" FL (PrimOf p) wX wY
effectp)
(FL (PrimOf p) wT wX -> FL (PrimOf p) wX wX
forall (a :: * -> * -> *) wX1 wY wX2. a wX1 wY -> a wX2 wY
unsafeCoercePStart FL (PrimOf p) wT wX
pend)
Repository rt p wR wU wT -> FL (PrimOf p) wT 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 wT
repo (FL (PrimOf p) wY wX -> FL (PrimOf p) wT wX
forall (a :: * -> * -> *) wX1 wY wX2. a wX1 wY -> a wX2 wY
unsafeCoercePStart FL (PrimOf p) wY wX
newpend)
where
rmpend :: FL (PrimOf p) wA wB -> FL (PrimOf p) wA wC -> Sealed (FL (PrimOf p) wB)
rmpend :: FL (PrimOf p) wA wB
-> FL (PrimOf p) wA wC -> Sealed (FL (PrimOf p) wB)
rmpend NilFL x :: FL (PrimOf p) wA wC
x = FL (PrimOf p) wA wC -> Sealed (FL (PrimOf p) wA)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed FL (PrimOf p) wA wC
x
rmpend _ NilFL = FL (PrimOf p) wB wB -> Sealed (FL (PrimOf p) wB)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed FL (PrimOf p) wB wB
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
rmpend (x :: PrimOf p wA wY
x:>:xs :: FL (PrimOf p) wY wB
xs) xys :: FL (PrimOf p) wA wC
xys | Just ys :: FL (PrimOf p) wY wC
ys <- PrimOf p wA wY
-> FL (PrimOf p) wA wC -> Maybe (FL (PrimOf p) wY wC)
forall (p :: * -> * -> *) wX wY wZ.
(Eq2 p, Commute p) =>
p wX wY -> FL p wX wZ -> Maybe (FL p wY wZ)
removeFL PrimOf p wA wY
x FL (PrimOf p) wA wC
xys = FL (PrimOf p) wY wB
-> FL (PrimOf p) wY wC -> Sealed (FL (PrimOf p) wB)
forall wA wB wC.
FL (PrimOf p) wA wB
-> FL (PrimOf p) wA wC -> Sealed (FL (PrimOf p) wB)
rmpend FL (PrimOf p) wY wB
xs FL (PrimOf p) wY wC
ys
rmpend (x :: PrimOf p wA wY
x:>:xs :: FL (PrimOf p) wY wB
xs) ys :: FL (PrimOf p) wA wC
ys =
case (:>) (PrimOf p) (FL (PrimOf p)) wA wB
-> (:>) (FL (PrimOf p)) (PrimOf p :> FL (PrimOf p)) wA wB
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p (FL p) wX wY -> (:>) (FL p) (p :> FL p) wX wY
commuteWhatWeCanFL (PrimOf p wA wY
xPrimOf p wA wY
-> FL (PrimOf p) wY wB -> (:>) (PrimOf p) (FL (PrimOf p)) wA wB
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:>FL (PrimOf p) wY wB
xs) of
a :: FL (PrimOf p) wA wZ
a:>x' :: PrimOf p wZ wZ
x':>b :: FL (PrimOf p) wZ wB
b -> case FL (PrimOf p) wA wZ
-> FL (PrimOf p) wA wC -> Sealed (FL (PrimOf p) wZ)
forall wA wB wC.
FL (PrimOf p) wA wB
-> FL (PrimOf p) wA wC -> Sealed (FL (PrimOf p) wB)
rmpend FL (PrimOf p) wA wZ
a FL (PrimOf p) wA wC
ys of
Sealed ys' :: FL (PrimOf p) wZ wX
ys' -> case (:>) (FL (PrimOf p)) (FL (PrimOf p)) wB wX
-> Maybe ((:>) (FL (PrimOf p)) (FL (PrimOf p)) wB wX)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (FL (PrimOf p) wZ wB -> FL (PrimOf p) wB wZ
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert (PrimOf p wZ wZ
x'PrimOf p wZ wZ -> FL (PrimOf p) wZ wB -> FL (PrimOf p) wZ wB
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:FL (PrimOf p) wZ wB
b) FL (PrimOf p) wB wZ
-> FL (PrimOf p) wZ wX
-> (:>) (FL (PrimOf p)) (FL (PrimOf p)) wB wX
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (PrimOf p) wZ wX
ys') of
Just (ys'' :: FL (PrimOf p) wB wZ
ys'' :> _) -> FL (PrimOf p) wB wZ -> Sealed (FL (PrimOf p) wB)
forall (a :: * -> *) wX. a wX -> Sealed a
seal FL (PrimOf p) wB wZ
ys''
Nothing -> FL (PrimOf p) wB wX -> Sealed (FL (PrimOf p) wB)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (FL (PrimOf p) wB wX -> Sealed (FL (PrimOf p) wB))
-> FL (PrimOf p) wB wX -> Sealed (FL (PrimOf p) wB)
forall a b. (a -> b) -> a -> b
$ FL (PrimOf p) wZ wB -> FL (PrimOf p) wB wZ
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert (PrimOf p wZ wZ
x'PrimOf p wZ wZ -> FL (PrimOf p) wZ wB -> FL (PrimOf p) wZ wB
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:FL (PrimOf p) wZ wB
b)FL (PrimOf p) wB wZ -> FL (PrimOf p) wZ wX -> FL (PrimOf p) wB wX
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+FL (PrimOf p) wZ wX
ys'
isSimple :: PrimPatch prim => FL prim wX wY -> Bool
isSimple :: FL prim wX wY -> Bool
isSimple =
(forall wX wY. prim wX wY -> Bool) -> FL prim wX wY -> Bool
forall (a :: * -> * -> *) wW wZ.
(forall wX wY. a wX wY -> Bool) -> FL a wW wZ -> Bool
allFL forall wX wY. prim wX wY -> Bool
forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
isSimp
where
isSimp :: prim wX wY -> Bool
isSimp x :: prim wX wY
x = prim wX wY -> Bool
forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsHunk prim wX wY
x Bool -> Bool -> Bool
|| prim wX wY -> Bool
forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsBinary prim wX wY
x Bool -> Bool -> Bool
|| prim wX wY -> Bool
forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsSetpref prim wX wY
x
makeNewPending :: (RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wR wU wT
-> UpdateWorking
-> FL (PrimOf p) wT wY
-> Tree IO
-> IO ()
makeNewPending :: Repository rt p wR wU wT
-> UpdateWorking -> FL (PrimOf p) wT wY -> Tree IO -> IO ()
makeNewPending _ NoUpdateWorking _ _ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
makeNewPending repo :: Repository rt p wR wU wT
repo YesUpdateWorking origp :: FL (PrimOf p) wT wY
origp recordedState :: Tree IO
recordedState =
Repository rt p wR wU wT -> IO () -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT a.
Repository rt p wR wU wT -> IO a -> IO a
withRepoLocation Repository rt p wR wU wT
repo (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
do let newname :: String
newname = String
pendingName String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".new"
String -> IO ()
debugMessage (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Writing new pending: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
newname
Sealed sfp :: FL (PrimOf p) wT wX
sfp <- Sealed (FL (PrimOf p) wT) -> IO (Sealed (FL (PrimOf p) wT))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL (PrimOf p) wT) -> IO (Sealed (FL (PrimOf p) wT)))
-> Sealed (FL (PrimOf p) wT) -> IO (Sealed (FL (PrimOf p) wT))
forall a b. (a -> b) -> a -> b
$ FL (PrimOf p) wT wY -> Sealed (FL (PrimOf p) wT)
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
FL prim wX wY -> Sealed (FL prim wX)
siftForPending FL (PrimOf p) wT wY
origp
Repository rt p wR wU wT -> FL (PrimOf p) wT wX -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
RepoPatch p =>
Repository rt p wR wU wT -> FL (PrimOf p) wT wY -> IO ()
writeNewPending Repository rt p wR wU wT
repo FL (PrimOf p) wT wX
sfp
Sealed p :: FL (PrimOf p) wT wX
p <- 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))
readNewPending Repository rt p wR wU wT
repo
Tree IO
_ <- IO (Tree IO) -> (IOException -> IO (Tree IO)) -> IO (Tree IO)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (FL (PrimOf p) wT wX -> Tree IO -> IO (Tree IO)
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, Monad m, ApplyState p ~ Tree) =>
p wX wY -> Tree m -> m (Tree m)
applyToTree FL (PrimOf p) wT wX
p Tree IO
recordedState) ((IOException -> IO (Tree IO)) -> IO (Tree IO))
-> (IOException -> IO (Tree IO)) -> IO (Tree IO)
forall a b. (a -> b) -> a -> b
$ \(IOException
err :: IOException) -> do
let buggyname :: String
buggyname = String
pendingName String -> String -> String
forall a. [a] -> [a] -> [a]
++ "_buggy"
String -> String -> IO ()
renameFile String
newname String
buggyname
Doc -> IO (Tree IO)
forall a. Doc -> a
errorDoc (Doc -> IO (Tree IO)) -> Doc -> IO (Tree IO)
forall a b. (a -> b) -> a -> b
$ String -> Doc
text ("There was an attempt to write an invalid pending! " String -> String -> String
forall a. [a] -> [a] -> [a]
++ IOException -> String
forall a. Show a => a -> String
show IOException
err)
Doc -> Doc -> Doc
$$ String -> Doc
text "If possible, please send the contents of"
Doc -> Doc -> Doc
<+> String -> Doc
text String
buggyname
Doc -> Doc -> Doc
$$ String -> Doc
text "along with a bug report."
String -> String -> IO ()
renameFile String
newname String
pendingName
String -> IO ()
debugMessage (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Finished writing new pending: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
newname
finalizePending :: (RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wR wU wT
-> UpdateWorking
-> Tree IO
-> IO ()
finalizePending :: Repository rt p wR wU wT -> UpdateWorking -> Tree IO -> IO ()
finalizePending repo :: Repository rt p wR wU wT
repo NoUpdateWorking _ =
Repository rt p wR wU wT -> IO () -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT a.
Repository rt p wR wU wT -> IO a -> IO a
withRepoLocation Repository rt p wR wU wT
repo (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall p. FilePathLike p => p -> IO ()
removeFileMayNotExist String
pendingName
finalizePending repo :: Repository rt p wR wU wT
repo updateWorking :: UpdateWorking
updateWorking@UpdateWorking
YesUpdateWorking recordedState :: Tree IO
recordedState =
Repository rt p wR wU wT -> IO () -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT a.
Repository rt p wR wU wT -> IO a -> IO a
withRepoLocation Repository rt p wR wU wT
repo (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Sealed tpend :: FL (PrimOf p) wT wX
tpend <- 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
repo
Sealed new_pending :: FL (PrimOf p) wT wX
new_pending <- Sealed (FL (PrimOf p) wT) -> IO (Sealed (FL (PrimOf p) wT))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL (PrimOf p) wT) -> IO (Sealed (FL (PrimOf p) wT)))
-> Sealed (FL (PrimOf p) wT) -> IO (Sealed (FL (PrimOf p) wT))
forall a b. (a -> b) -> a -> b
$ FL (PrimOf p) wT wX -> Sealed (FL (PrimOf p) wT)
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
FL prim wX wY -> Sealed (FL prim wX)
siftForPending FL (PrimOf p) wT wX
tpend
Repository rt p wR wU wT
-> UpdateWorking -> FL (PrimOf p) wT wX -> Tree IO -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> UpdateWorking -> FL (PrimOf p) wT wY -> Tree IO -> IO ()
makeNewPending Repository rt p wR wU wT
repo UpdateWorking
updateWorking FL (PrimOf p) wT wX
new_pending Tree IO
recordedState
tentativelyAddToPending :: forall rt p wR wU wT wX wY. RepoPatch p
=> Repository rt p wR wU wT
-> UpdateWorking
-> FL (PrimOf p) wX wY
-> IO ()
tentativelyAddToPending :: Repository rt p wR wU wT
-> UpdateWorking -> FL (PrimOf p) wX wY -> IO ()
tentativelyAddToPending _ NoUpdateWorking _ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
tentativelyAddToPending repo :: Repository rt p wR wU wT
repo YesUpdateWorking patch :: FL (PrimOf p) wX wY
patch =
Repository rt p wR wU wT -> IO () -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT a.
Repository rt p wR wU wT -> IO a -> IO a
withRepoLocation Repository rt p wR wU wT
repo (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Sealed pend :: 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
repo
FlippedSeal newpend_ :: FL (PrimOf p) wX wY
newpend_ <- FlippedSeal (FL (PrimOf p)) wY
-> IO (FlippedSeal (FL (PrimOf p)) wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (FlippedSeal (FL (PrimOf p)) wY
-> IO (FlippedSeal (FL (PrimOf p)) wY))
-> FlippedSeal (FL (PrimOf p)) wY
-> IO (FlippedSeal (FL (PrimOf p)) wY)
forall a b. (a -> b) -> a -> b
$
FL (PrimOf p) Any wX
-> FL (PrimOf p) wX wY -> FlippedSeal (FL (PrimOf p)) wY
forall (prim :: * -> * -> *) wA wB wC.
FL prim wA wB -> FL prim wB wC -> FlippedSeal (FL prim) wC
newpend (FL (PrimOf p) wT wX -> FL (PrimOf p) wA wX
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP FL (PrimOf p) wT wX
pend :: FL (PrimOf p) wA wX) FL (PrimOf p) wX wY
patch
Repository rt p wR wU wT -> FL (PrimOf p) wT wY -> 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 wT
repo (FL (PrimOf p) wX wY -> FL (PrimOf p) wT wY
forall (a :: * -> * -> *) wX1 wY wX2. a wX1 wY -> a wX2 wY
unsafeCoercePStart FL (PrimOf p) wX wY
newpend_)
where
newpend :: FL prim wA wB -> FL prim wB wC -> FlippedSeal (FL prim) wC
newpend :: FL prim wA wB -> FL prim wB wC -> FlippedSeal (FL prim) wC
newpend NilFL patch_ :: FL prim wB wC
patch_ = FL prim wB wC -> FlippedSeal (FL prim) wC
forall (a :: * -> * -> *) wX wY. a wX wY -> FlippedSeal a wY
flipSeal FL prim wB wC
patch_
newpend p :: FL prim wA wB
p patch_ :: FL prim wB wC
patch_ = FL prim wA wC -> FlippedSeal (FL prim) wC
forall (a :: * -> * -> *) wX wY. a wX wY -> FlippedSeal a wY
flipSeal (FL prim wA wC -> FlippedSeal (FL prim) wC)
-> FL prim wA wC -> FlippedSeal (FL prim) wC
forall a b. (a -> b) -> a -> b
$ FL prim wA wB
p FL prim wA wB -> FL prim wB wC -> FL prim wA wC
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL prim wB wC
patch_
setTentativePending :: forall rt p wR wU wT wX wY. RepoPatch p
=> Repository rt p wR wU wT
-> UpdateWorking
-> FL (PrimOf p) wX wY
-> IO ()
setTentativePending :: Repository rt p wR wU wT
-> UpdateWorking -> FL (PrimOf p) wX wY -> IO ()
setTentativePending _ NoUpdateWorking _ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
setTentativePending repo :: Repository rt p wR wU wT
repo YesUpdateWorking patch :: FL (PrimOf p) wX wY
patch = do
Sealed prims :: FL (PrimOf p) wX wX
prims <- Sealed (FL (PrimOf p) wX) -> IO (Sealed (FL (PrimOf p) wX))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL (PrimOf p) wX) -> IO (Sealed (FL (PrimOf p) wX)))
-> Sealed (FL (PrimOf p) wX) -> IO (Sealed (FL (PrimOf p) wX))
forall a b. (a -> b) -> a -> b
$ FL (PrimOf p) wX wY -> Sealed (FL (PrimOf p) wX)
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
FL prim wX wY -> Sealed (FL prim wX)
siftForPending FL (PrimOf p) wX wY
patch
Repository rt p wR wU wT -> IO () -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT a.
Repository rt p wR wU wT -> IO a -> IO a
withRepoLocation Repository rt p wR wU wT
repo (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Repository rt p wR wU wT -> FL (PrimOf p) wT 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 wT
repo (FL (PrimOf p) wX wX -> FL (PrimOf p) wT wX
forall (a :: * -> * -> *) wX1 wY wX2. a wX1 wY -> a wX2 wY
unsafeCoercePStart FL (PrimOf p) wX wX
prims)
prepend :: forall rt p wR wU wT wX wY. RepoPatch p
=> Repository rt p wR wU wT
-> UpdateWorking
-> FL (PrimOf p) wX wY
-> IO ()
prepend :: Repository rt p wR wU wT
-> UpdateWorking -> FL (PrimOf p) wX wY -> IO ()
prepend _ NoUpdateWorking _ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
prepend repo :: Repository rt p wR wU wT
repo YesUpdateWorking patch :: FL (PrimOf p) wX wY
patch = do
Sealed pend :: 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
repo
Sealed newpend_ :: FL (PrimOf p) wX wX
newpend_ <- Sealed (FL (PrimOf p) wX) -> IO (Sealed (FL (PrimOf p) wX))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL (PrimOf p) wX) -> IO (Sealed (FL (PrimOf p) wX)))
-> Sealed (FL (PrimOf p) wX) -> IO (Sealed (FL (PrimOf p) wX))
forall a b. (a -> b) -> a -> b
$ FL (PrimOf p) wY Any
-> FL (PrimOf p) wX wY -> Sealed (FL (PrimOf p) wX)
forall (prim :: * -> * -> *) wB wC wA.
FL prim wB wC -> FL prim wA wB -> Sealed (FL prim wA)
newpend (FL (PrimOf p) wT wX -> FL (PrimOf p) wY Any
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP FL (PrimOf p) wT wX
pend) FL (PrimOf p) wX wY
patch
Repository rt p wR wU wT -> FL (PrimOf p) wT 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 wT
repo (FL (PrimOf p) wX wX -> FL (PrimOf p) wT wX
forall (a :: * -> * -> *) wX1 wY wX2. a wX1 wY -> a wX2 wY
unsafeCoercePStart (FL (PrimOf p) wX wX -> FL (PrimOf p) wT wX)
-> FL (PrimOf p) wX wX -> FL (PrimOf p) wT wX
forall a b. (a -> b) -> a -> b
$ FL (PrimOf p) wX wX -> FL (PrimOf p) wX wX
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
FL prim wX wY -> FL prim wX wY
crudeSift FL (PrimOf p) wX wX
newpend_)
where
newpend :: FL prim wB wC -> FL prim wA wB -> Sealed (FL prim wA)
newpend :: FL prim wB wC -> FL prim wA wB -> Sealed (FL prim wA)
newpend NilFL patch_ :: FL prim wA wB
patch_ = FL prim wA wB -> Sealed (FL prim wA)
forall (a :: * -> *) wX. a wX -> Sealed a
seal FL prim wA wB
patch_
newpend p :: FL prim wB wC
p patch_ :: FL prim wA wB
patch_ = FL prim wA wC -> Sealed (FL prim wA)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (FL prim wA wC -> Sealed (FL prim wA))
-> FL prim wA wC -> Sealed (FL prim wA)
forall a b. (a -> b) -> a -> b
$ FL prim wA wB
patch_ FL prim wA wB -> FL prim wB wC -> FL prim wA wC
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL prim wB wC
p