module Darcs.Repository.Merge
( tentativelyMergePatches
, considerMergeToWorking
, announceMergeConflicts
) where
import Prelude ()
import Darcs.Prelude
import Control.Monad ( when, unless )
import Data.List.Ordered ( nubSort )
import System.Exit ( exitSuccess )
import Darcs.Util.Tree( Tree )
import Darcs.Util.External ( backupByCopying )
import Darcs.Patch
( RepoPatch, IsRepoType, PrimOf, merge, listTouchedFiles
, fromPrims, effect, WrappedNamed
, listConflictedFiles )
import Darcs.Patch.Prim ( PrimPatch )
import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch.Depends( merge2FL )
import Darcs.Patch.Named.Wrapped ( activecontents, anonymous, namedIsInternal )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, n2pia, hopefully )
import Darcs.Patch.Progress( progressFL )
import Darcs.Patch.Witnesses.Ordered
( FL(..), (:\/:)(..), (:/\:)(..), (+>+),
mapFL_FL, concatFL, filterOutFLFL )
import Darcs.Patch.Witnesses.Sealed ( Sealed(Sealed), seal )
import Darcs.Repository.Flags
( UseIndex
, ScanKnown
, AllowConflicts (..)
, Reorder (..)
, UpdateWorking (..)
, ExternalMerge (..)
, Verbosity (..)
, Compression (..)
, WantGuiPause (..)
, DiffAlgorithm (..)
, UseCache(..)
, LookForMoves(..)
, LookForReplaces(..)
)
import Darcs.Repository.Hashed
( tentativelyAddPatches_
, applyToTentativePristine
, tentativelyRemovePatches_
, UpdatePristine(..) )
import Darcs.Repository.Identify ( identifyRepository )
import Darcs.Repository.InternalTypes ( Repository )
import Darcs.Repository.Pending ( setTentativePending, readPending )
import Darcs.Repository.Resolution ( standardResolution, externalResolution )
import Darcs.Repository.State ( unrecordedChanges, readUnrecorded )
import Darcs.Util.Prompt ( promptYorn )
import Darcs.Util.Global ( darcsdir )
import Darcs.Util.Progress( debugMessage )
import Darcs.Util.Printer.Color (fancyPrinters)
import Darcs.Util.Printer ( text, ($$), redText, putDocLnWith, ($$) )
data MakeChanges = MakeChanges | DontMakeChanges deriving ( MakeChanges -> MakeChanges -> Bool
(MakeChanges -> MakeChanges -> Bool)
-> (MakeChanges -> MakeChanges -> Bool) -> Eq MakeChanges
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MakeChanges -> MakeChanges -> Bool
$c/= :: MakeChanges -> MakeChanges -> Bool
== :: MakeChanges -> MakeChanges -> Bool
$c== :: MakeChanges -> MakeChanges -> Bool
Eq )
tentativelyMergePatches_ :: forall rt p wR wU wT wY wX
. (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
=> MakeChanges
-> Repository rt p wR wU wT -> String
-> AllowConflicts -> UpdateWorking
-> ExternalMerge -> WantGuiPause
-> Compression -> Verbosity -> Reorder
-> ( UseIndex, ScanKnown, DiffAlgorithm )
-> FL (PatchInfoAnd rt p) wX wT
-> FL (PatchInfoAnd rt p) wX wY
-> IO (Sealed (FL (PrimOf p) wU))
tentativelyMergePatches_ :: MakeChanges
-> Repository rt p wR wU wT
-> String
-> AllowConflicts
-> UpdateWorking
-> ExternalMerge
-> WantGuiPause
-> Compression
-> Verbosity
-> Reorder
-> (UseIndex, ScanKnown, DiffAlgorithm)
-> FL (PatchInfoAnd rt p) wX wT
-> FL (PatchInfoAnd rt p) wX wY
-> IO (Sealed (FL (PrimOf p) wU))
tentativelyMergePatches_ mc :: MakeChanges
mc r :: Repository rt p wR wU wT
r cmd :: String
cmd allowConflicts :: AllowConflicts
allowConflicts updateWorking :: UpdateWorking
updateWorking externalMerge :: ExternalMerge
externalMerge
wantGuiPause :: WantGuiPause
wantGuiPause compression :: Compression
compression verbosity :: Verbosity
verbosity reorder :: Reorder
reorder diffingOpts :: (UseIndex, ScanKnown, DiffAlgorithm)
diffingOpts@(_, _, dflag :: DiffAlgorithm
dflag) us :: FL (PatchInfoAnd rt p) wX wT
us them :: FL (PatchInfoAnd rt p) wX wY
them = do
(them_merged :: FL (PatchInfoAnd rt p) wT wZ
them_merged :/\: us_merged :: FL (PatchInfoAnd rt p) wY wZ
us_merged)
<- (:/\:) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wT wY
-> IO
((:/\:) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wT wY)
forall (m :: * -> *) a. Monad m => a -> m a
return ((:/\:) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wT wY
-> IO
((:/\:) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wT wY))
-> (:/\:) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wT wY
-> IO
((:/\:) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wT wY)
forall a b. (a -> b) -> a -> b
$ FL (PatchInfoAnd rt p) wX wT
-> FL (PatchInfoAnd rt p) wX wY
-> (:/\:) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wT wY
forall (p :: * -> * -> *) (rt :: RepoType) wX wY wZ.
Merge p =>
FL (PatchInfoAnd rt p) wX wY
-> FL (PatchInfoAnd rt p) wX wZ
-> (:/\:) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wY wZ
merge2FL (String
-> FL (PatchInfoAnd rt p) wX wT -> FL (PatchInfoAnd rt p) wX wT
forall (a :: * -> * -> *) wX wY. String -> FL a wX wY -> FL a wX wY
progressFL "Merging us" FL (PatchInfoAnd rt p) wX wT
us)
(String
-> FL (PatchInfoAnd rt p) wX wY -> FL (PatchInfoAnd rt p) wX wY
forall (a :: * -> * -> *) wX wY. String -> FL a wX wY -> FL a wX wY
progressFL "Merging them" FL (PatchInfoAnd rt p) wX wY
them)
FL (PrimOf p) wT wU
pend <- (UseIndex, ScanKnown, DiffAlgorithm)
-> LookForMoves
-> LookForReplaces
-> Repository rt p wR wU wT
-> Maybe [SubPath]
-> IO (FL (PrimOf p) wT wU)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
(UseIndex, ScanKnown, DiffAlgorithm)
-> LookForMoves
-> LookForReplaces
-> Repository rt p wR wU wT
-> Maybe [SubPath]
-> IO (FL (PrimOf p) wT wU)
unrecordedChanges (UseIndex, ScanKnown, DiffAlgorithm)
diffingOpts LookForMoves
NoLookForMoves LookForReplaces
NoLookForReplaces Repository rt p wR wU wT
r Maybe [SubPath]
forall a. Maybe a
Nothing
PatchInfoAnd rt p wT wU
anonpend <- WrappedNamed rt p wT wU -> PatchInfoAnd rt p wT wU
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
WrappedNamed rt p wX wY -> PatchInfoAnd rt p wX wY
n2pia (WrappedNamed rt p wT wU -> PatchInfoAnd rt p wT wU)
-> IO (WrappedNamed rt p wT wU) -> IO (PatchInfoAnd rt p wT wU)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` FL p wT wU -> IO (WrappedNamed rt p wT wU)
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
FL p wX wY -> IO (WrappedNamed rt p wX wY)
anonymous (FL (PrimOf (FL p)) wT wU -> FL p wT wU
forall (p :: * -> * -> *) wX wY.
FromPrims p =>
FL (PrimOf p) wX wY -> p wX wY
fromPrims FL (PrimOf p) wT wU
FL (PrimOf (FL p)) wT wU
pend)
pend' :: FL (PatchInfoAnd rt p) wZ wZ
pend' :/\: pw :: FL (PatchInfoAnd rt p) wU wZ
pw <- (:/\:) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wZ wU
-> IO
((:/\:) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wZ wU)
forall (m :: * -> *) a. Monad m => a -> m a
return ((:/\:) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wZ wU
-> IO
((:/\:) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wZ wU))
-> (:/\:) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wZ wU
-> IO
((:/\:) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wZ wU)
forall a b. (a -> b) -> a -> b
$ (:\/:) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wZ wU
-> (:/\:) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wZ wU
forall (p :: * -> * -> *) wX wY.
Merge p =>
(:\/:) p p wX wY -> (:/\:) p p wX wY
merge (FL (PatchInfoAnd rt p) wT wZ
them_merged FL (PatchInfoAnd rt p) wT wZ
-> FL (PatchInfoAnd rt p) wT wU
-> (:\/:) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wZ wU
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: PatchInfoAnd rt p wT wU
anonpend PatchInfoAnd rt p wT wU
-> FL (PatchInfoAnd rt p) wU wU -> FL (PatchInfoAnd rt p) wT wU
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (PatchInfoAnd rt p) wU wU
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
let pwprim :: FL p wU wZ
pwprim = FL (FL p) wU wZ -> FL p wU wZ
forall (a :: * -> * -> *) wX wZ. FL (FL a) wX wZ -> FL a wX wZ
concatFL (FL (FL p) wU wZ -> FL p wU wZ) -> FL (FL p) wU wZ -> FL p wU wZ
forall a b. (a -> b) -> a -> b
$ String -> FL (FL p) wU wZ -> FL (FL p) wU wZ
forall (a :: * -> * -> *) wX wY. String -> FL a wX wY -> FL a wX wY
progressFL "Examining patches for conflicts" (FL (FL p) wU wZ -> FL (FL p) wU wZ)
-> FL (FL p) wU wZ -> FL (FL p) wU wZ
forall a b. (a -> b) -> a -> b
$
(forall wW wY. PatchInfoAnd rt p wW wY -> FL p wW wY)
-> FL (PatchInfoAnd rt p) wU wZ -> FL (FL p) wU wZ
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL (WrappedNamed rt p wW wY -> FL p wW wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
WrappedNamed rt p wX wY -> FL p wX wY
activecontents (WrappedNamed rt p wW wY -> FL p wW wY)
-> (PatchInfoAnd rt p wW wY -> WrappedNamed rt p wW wY)
-> PatchInfoAnd rt p wW wY
-> FL p wW wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAnd rt p wW wY -> WrappedNamed rt p wW wY
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> WrappedNamed rt p wA wB
hopefully) FL (PatchInfoAnd rt p) wU wZ
pw
Sealed standard_resolved_pw :: FL (PrimOf p) wZ wX
standard_resolved_pw <- Sealed (FL (PrimOf p) wZ) -> IO (Sealed (FL (PrimOf p) wZ))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL (PrimOf p) wZ) -> IO (Sealed (FL (PrimOf p) wZ)))
-> Sealed (FL (PrimOf p) wZ) -> IO (Sealed (FL (PrimOf p) wZ))
forall a b. (a -> b) -> a -> b
$ FL p wU wZ -> Sealed (FL (PrimOf p) wZ)
forall (p :: * -> * -> *) wX wY.
(PrimPatchBase p, Conflict p, CommuteNoConflicts p) =>
FL p wX wY -> Sealed (FL (PrimOf p) wY)
standardResolution FL p wU wZ
pwprim
String -> IO ()
debugMessage "Checking for conflicts..."
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AllowConflicts
allowConflicts AllowConflicts -> AllowConflicts -> Bool
forall a. Eq a => a -> a -> Bool
== AllowConflicts
YesAllowConflictsAndMark) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
(String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
backupByCopying ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ FL (PrimOf p) wZ wX -> [String]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [String]
listTouchedFiles FL (PrimOf p) wZ wX
standard_resolved_pw
String -> IO ()
debugMessage "Announcing conflicts..."
Bool
have_conflicts <-
String
-> AllowConflicts
-> ExternalMerge
-> FL (PrimOf p) wZ wX
-> IO Bool
forall (p :: * -> * -> *) wX wY.
PrimPatch p =>
String -> AllowConflicts -> ExternalMerge -> FL p wX wY -> IO Bool
announceMergeConflicts String
cmd AllowConflicts
allowConflicts ExternalMerge
externalMerge FL (PrimOf p) wZ wX
standard_resolved_pw
String -> IO ()
debugMessage "Checking for unrecorded conflicts..."
Bool
have_unrecorded_conflicts <- UpdateWorking -> FL (WrappedNamed rt p) wT wZ -> IO Bool
forall (rt :: RepoType) (p :: * -> * -> *) wT wY.
RepoPatch p =>
UpdateWorking -> FL (WrappedNamed rt p) wT wY -> IO Bool
checkUnrecordedConflicts UpdateWorking
updateWorking (FL (WrappedNamed rt p) wT wZ -> IO Bool)
-> FL (WrappedNamed rt p) wT wZ -> IO Bool
forall a b. (a -> b) -> a -> b
$
(forall wW wY. PatchInfoAnd rt p wW wY -> WrappedNamed rt p wW wY)
-> FL (PatchInfoAnd rt p) wT wZ -> FL (WrappedNamed rt p) wT wZ
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall wW wY. PatchInfoAnd rt p wW wY -> WrappedNamed rt p wW wY
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> WrappedNamed rt p wA wB
hopefully FL (PatchInfoAnd rt p) wT wZ
them_merged
String -> IO ()
debugMessage "Reading working directory..."
Tree IO
working <- Repository rt p wR wU wT -> Maybe [SubPath] -> IO (Tree IO)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> Maybe [SubPath] -> IO (Tree IO)
readUnrecorded Repository rt p wR wU wT
r Maybe [SubPath]
forall a. Maybe a
Nothing
String -> IO ()
debugMessage "Working out conflicts in actual working directory..."
let haveConflicts :: Bool
haveConflicts = Bool
have_conflicts Bool -> Bool -> Bool
|| Bool
have_unrecorded_conflicts
Sealed pw_resolution :: FL (PrimOf p) wZ wX
pw_resolution <-
case (ExternalMerge
externalMerge , Bool
haveConflicts) of
(NoExternalMerge, _) -> Sealed (FL (PrimOf p) wZ) -> IO (Sealed (FL (PrimOf p) wZ))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL (PrimOf p) wZ) -> IO (Sealed (FL (PrimOf p) wZ)))
-> Sealed (FL (PrimOf p) wZ) -> IO (Sealed (FL (PrimOf p) wZ))
forall a b. (a -> b) -> a -> b
$ if AllowConflicts
allowConflicts AllowConflicts -> AllowConflicts -> Bool
forall a. Eq a => a -> a -> Bool
== AllowConflicts
YesAllowConflicts
then FL (PrimOf p) wZ wZ -> Sealed (FL (PrimOf p) wZ)
forall (a :: * -> *) wX. a wX -> Sealed a
seal FL (PrimOf p) wZ wZ
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
else FL (PrimOf p) wZ wX -> Sealed (FL (PrimOf p) wZ)
forall (a :: * -> *) wX. a wX -> Sealed a
seal FL (PrimOf p) wZ wX
standard_resolved_pw
(_, False) -> Sealed (FL (PrimOf p) wZ) -> IO (Sealed (FL (PrimOf p) wZ))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL (PrimOf p) wZ) -> IO (Sealed (FL (PrimOf p) wZ)))
-> Sealed (FL (PrimOf p) wZ) -> IO (Sealed (FL (PrimOf p) wZ))
forall a b. (a -> b) -> a -> b
$ FL (PrimOf p) wZ wX -> Sealed (FL (PrimOf p) wZ)
forall (a :: * -> *) wX. a wX -> Sealed a
seal FL (PrimOf p) wZ wX
standard_resolved_pw
(YesExternalMerge c :: String
c, True) -> DiffAlgorithm
-> Tree IO
-> String
-> WantGuiPause
-> FL (PrimOf p) wX wU
-> FL (PrimOf p) wX wY
-> FL p wU wZ
-> IO (Sealed (FL (PrimOf p) wZ))
forall (p :: * -> * -> *) wX wY wZ wA.
(RepoPatch p, ApplyState p ~ Tree) =>
DiffAlgorithm
-> Tree IO
-> String
-> WantGuiPause
-> FL (PrimOf p) wX wY
-> FL (PrimOf p) wX wZ
-> FL p wY wA
-> IO (Sealed (FL (PrimOf p) wA))
externalResolution DiffAlgorithm
dflag Tree IO
working String
c WantGuiPause
wantGuiPause
(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
us FL (PrimOf p) wX wT -> FL (PrimOf p) wT wU -> FL (PrimOf p) wX wU
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (PrimOf p) wT wU
pend) (FL (PatchInfoAnd rt p) wX wY
-> FL (PrimOf (FL (PatchInfoAnd rt p))) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect FL (PatchInfoAnd rt p) wX wY
them) FL p wU wZ
pwprim
String -> IO ()
debugMessage "Applying patches to the local directories..."
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MakeChanges
mc MakeChanges -> MakeChanges -> Bool
forall a. Eq a => a -> a -> Bool
== MakeChanges
MakeChanges) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Repository rt p wR wU wZ
r' <- case Reorder
reorder of
NoReorder -> do
UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdateWorking
-> FL (PatchInfoAnd rt p) wT wZ
-> IO (Repository rt p wR wU wZ)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(RepoPatch p, ApplyState p ~ Tree) =>
UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdateWorking
-> FL (PatchInfoAnd rt p) wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatches_ UpdatePristine
DontUpdatePristine Repository rt p wR wU wT
r
Compression
compression Verbosity
verbosity UpdateWorking
updateWorking FL (PatchInfoAnd rt p) wT wZ
them_merged
Reorder -> do
Repository rt p wR wU wX
r1 <- UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> UpdateWorking
-> 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
-> UpdateWorking
-> FL (PatchInfoAnd rt p) wX wT
-> IO (Repository rt p wR wU wX)
tentativelyRemovePatches_ UpdatePristine
DontUpdatePristineNorRevert Repository rt p wR wU wT
r
Compression
compression UpdateWorking
NoUpdateWorking
((forall wX wY. PatchInfoAnd rt p wX wY -> EqCheck wX wY)
-> FL (PatchInfoAnd rt p) wX wT -> FL (PatchInfoAnd rt p) wX wT
forall (p :: * -> * -> *) wW wZ.
(forall wX wY. p wX wY -> EqCheck wX wY)
-> FL p wW wZ -> FL p wW wZ
filterOutFLFL (WrappedNamed rt p wX wY -> EqCheck wX wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
IsRepoType rt =>
WrappedNamed rt p wX wY -> EqCheck wX wY
namedIsInternal (WrappedNamed rt p wX wY -> EqCheck wX wY)
-> (PatchInfoAnd rt p wX wY -> WrappedNamed rt p wX wY)
-> PatchInfoAnd rt p wX wY
-> EqCheck wX wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAnd rt p wX wY -> WrappedNamed rt p wX wY
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> WrappedNamed rt p wA wB
hopefully) FL (PatchInfoAnd rt p) wX wT
us)
Repository rt p wR wU wY
r2 <- UpdatePristine
-> Repository rt p wR wU wX
-> Compression
-> Verbosity
-> UpdateWorking
-> FL (PatchInfoAnd rt p) wX 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
-> UpdateWorking
-> FL (PatchInfoAnd rt p) wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatches_ UpdatePristine
DontUpdatePristine Repository rt p wR wU wX
r1
Compression
compression Verbosity
verbosity UpdateWorking
NoUpdateWorking FL (PatchInfoAnd rt p) wX wY
them
UpdatePristine
-> Repository rt p wR wU wY
-> Compression
-> Verbosity
-> UpdateWorking
-> FL (PatchInfoAnd rt p) wY wZ
-> IO (Repository rt p wR wU wZ)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(RepoPatch p, ApplyState p ~ Tree) =>
UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdateWorking
-> FL (PatchInfoAnd rt p) wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatches_ UpdatePristine
DontUpdatePristine Repository rt p wR wU wY
r2
Compression
compression Verbosity
verbosity UpdateWorking
NoUpdateWorking
((forall wX wY. PatchInfoAnd rt p wX wY -> EqCheck wX wY)
-> FL (PatchInfoAnd rt p) wY wZ -> FL (PatchInfoAnd rt p) wY wZ
forall (p :: * -> * -> *) wW wZ.
(forall wX wY. p wX wY -> EqCheck wX wY)
-> FL p wW wZ -> FL p wW wZ
filterOutFLFL (WrappedNamed rt p wX wY -> EqCheck wX wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
IsRepoType rt =>
WrappedNamed rt p wX wY -> EqCheck wX wY
namedIsInternal (WrappedNamed rt p wX wY -> EqCheck wX wY)
-> (PatchInfoAnd rt p wX wY -> WrappedNamed rt p wX wY)
-> PatchInfoAnd rt p wX wY
-> EqCheck wX wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAnd rt p wX wY -> WrappedNamed rt p wX wY
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> WrappedNamed rt p wA wB
hopefully) FL (PatchInfoAnd rt p) wY wZ
us_merged)
Repository rt p wR wU wT
-> Verbosity -> FL (PatchInfoAnd rt p) wT wZ -> IO ()
forall (q :: * -> * -> *) (rt :: RepoType) (p :: * -> * -> *) wR wU
wT wY.
(ApplyState q ~ Tree, Apply q, ShowPatch q) =>
Repository rt p wR wU wT -> Verbosity -> q wT wY -> IO ()
applyToTentativePristine Repository rt p wR wU wT
r Verbosity
verbosity FL (PatchInfoAnd rt p) wT wZ
them_merged
Repository rt p wR wU wZ
-> UpdateWorking -> FL (PrimOf p) wZ wX -> IO ()
forall (rt :: RepoType) (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 wZ
r' UpdateWorking
updateWorking (FL (PatchInfoAnd rt p) wZ wZ
-> FL (PrimOf (FL (PatchInfoAnd rt p))) wZ wZ
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect FL (PatchInfoAnd rt p) wZ wZ
pend' FL (PrimOf p) wZ wZ -> FL (PrimOf p) wZ wX -> FL (PrimOf p) wZ wX
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (PrimOf p) wZ wX
pw_resolution)
Sealed (FL (PrimOf p) wU) -> IO (Sealed (FL (PrimOf p) wU))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL (PrimOf p) wU) -> IO (Sealed (FL (PrimOf p) wU)))
-> Sealed (FL (PrimOf p) wU) -> IO (Sealed (FL (PrimOf p) wU))
forall a b. (a -> b) -> a -> b
$ FL (PrimOf p) wU wX -> Sealed (FL (PrimOf p) wU)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (FL p wU wZ -> FL (PrimOf (FL p)) wU wZ
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect FL p wU wZ
pwprim FL (PrimOf p) wU wZ -> FL (PrimOf p) wZ wX -> FL (PrimOf p) wU wX
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (PrimOf p) wZ wX
pw_resolution)
tentativelyMergePatches :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wR wU wT -> String
-> AllowConflicts -> UpdateWorking
-> ExternalMerge -> WantGuiPause
-> Compression -> Verbosity -> Reorder
-> ( UseIndex, ScanKnown, DiffAlgorithm )
-> FL (PatchInfoAnd rt p) wX wT
-> FL (PatchInfoAnd rt p) wX wY
-> IO (Sealed (FL (PrimOf p) wU))
tentativelyMergePatches :: Repository rt p wR wU wT
-> String
-> AllowConflicts
-> UpdateWorking
-> ExternalMerge
-> WantGuiPause
-> Compression
-> Verbosity
-> Reorder
-> (UseIndex, ScanKnown, DiffAlgorithm)
-> FL (PatchInfoAnd rt p) wX wT
-> FL (PatchInfoAnd rt p) wX wY
-> IO (Sealed (FL (PrimOf p) wU))
tentativelyMergePatches = MakeChanges
-> Repository rt p wR wU wT
-> String
-> AllowConflicts
-> UpdateWorking
-> ExternalMerge
-> WantGuiPause
-> Compression
-> Verbosity
-> Reorder
-> (UseIndex, ScanKnown, DiffAlgorithm)
-> FL (PatchInfoAnd rt p) wX wT
-> FL (PatchInfoAnd rt p) wX wY
-> IO (Sealed (FL (PrimOf p) wU))
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wY wX.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
MakeChanges
-> Repository rt p wR wU wT
-> String
-> AllowConflicts
-> UpdateWorking
-> ExternalMerge
-> WantGuiPause
-> Compression
-> Verbosity
-> Reorder
-> (UseIndex, ScanKnown, DiffAlgorithm)
-> FL (PatchInfoAnd rt p) wX wT
-> FL (PatchInfoAnd rt p) wX wY
-> IO (Sealed (FL (PrimOf p) wU))
tentativelyMergePatches_ MakeChanges
MakeChanges
considerMergeToWorking :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wR wU wT -> String
-> AllowConflicts -> UpdateWorking
-> ExternalMerge -> WantGuiPause
-> Compression -> Verbosity -> Reorder
-> ( UseIndex, ScanKnown, DiffAlgorithm )
-> FL (PatchInfoAnd rt p) wX wT
-> FL (PatchInfoAnd rt p) wX wY
-> IO (Sealed (FL (PrimOf p) wU))
considerMergeToWorking :: Repository rt p wR wU wT
-> String
-> AllowConflicts
-> UpdateWorking
-> ExternalMerge
-> WantGuiPause
-> Compression
-> Verbosity
-> Reorder
-> (UseIndex, ScanKnown, DiffAlgorithm)
-> FL (PatchInfoAnd rt p) wX wT
-> FL (PatchInfoAnd rt p) wX wY
-> IO (Sealed (FL (PrimOf p) wU))
considerMergeToWorking = MakeChanges
-> Repository rt p wR wU wT
-> String
-> AllowConflicts
-> UpdateWorking
-> ExternalMerge
-> WantGuiPause
-> Compression
-> Verbosity
-> Reorder
-> (UseIndex, ScanKnown, DiffAlgorithm)
-> FL (PatchInfoAnd rt p) wX wT
-> FL (PatchInfoAnd rt p) wX wY
-> IO (Sealed (FL (PrimOf p) wU))
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wY wX.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
MakeChanges
-> Repository rt p wR wU wT
-> String
-> AllowConflicts
-> UpdateWorking
-> ExternalMerge
-> WantGuiPause
-> Compression
-> Verbosity
-> Reorder
-> (UseIndex, ScanKnown, DiffAlgorithm)
-> FL (PatchInfoAnd rt p) wX wT
-> FL (PatchInfoAnd rt p) wX wY
-> IO (Sealed (FL (PrimOf p) wU))
tentativelyMergePatches_ MakeChanges
DontMakeChanges
announceMergeConflicts :: (PrimPatch p)
=> String
-> AllowConflicts
-> ExternalMerge
-> FL p wX wY
-> IO Bool
announceMergeConflicts :: String -> AllowConflicts -> ExternalMerge -> FL p wX wY -> IO Bool
announceMergeConflicts cmd :: String
cmd allowConflicts :: AllowConflicts
allowConflicts externalMerge :: ExternalMerge
externalMerge resolved_pw :: FL p wX wY
resolved_pw =
case [String] -> [String]
forall a. Ord a => [a] -> [a]
nubSort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ FL p wX wY -> [String]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [String]
listTouchedFiles FL p wX wY
resolved_pw of
[] -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
cfs :: [String]
cfs -> if AllowConflicts
allowConflicts AllowConflicts -> [AllowConflicts] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [AllowConflicts
YesAllowConflicts,AllowConflicts
YesAllowConflictsAndMark]
Bool -> Bool -> Bool
|| ExternalMerge
externalMerge ExternalMerge -> ExternalMerge -> Bool
forall a. Eq a => a -> a -> Bool
/= ExternalMerge
NoExternalMerge
then do Printers -> Doc -> IO ()
putDocLnWith Printers
fancyPrinters (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> Doc
redText "We have conflicts in the following files:" Doc -> Doc -> Doc
$$ String -> Doc
text ([String] -> String
unlines [String]
cfs)
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else do Printers -> Doc -> IO ()
putDocLnWith Printers
fancyPrinters (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> Doc
redText "There are conflicts in the following files:" Doc -> Doc -> Doc
$$ String -> Doc
text ([String] -> String
unlines [String]
cfs)
String -> IO Bool
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ "Refusing to "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
cmdString -> String -> String
forall a. [a] -> [a] -> [a]
++" patches leading to conflicts.\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
"If you would rather apply the patch and mark the conflicts,\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
"use the --mark-conflicts or --allow-conflicts options to "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
cmdString -> String -> String
forall a. [a] -> [a] -> [a]
++"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
"These can set as defaults by adding\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
cmdString -> String -> String
forall a. [a] -> [a] -> [a]
++" mark-conflicts\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
"to "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
darcsdirString -> String -> String
forall a. [a] -> [a] -> [a]
++"/prefs/defaults in the target repo. "
checkUnrecordedConflicts :: forall rt p wT wY. RepoPatch p
=> UpdateWorking
-> FL (WrappedNamed rt p) wT wY
-> IO Bool
checkUnrecordedConflicts :: UpdateWorking -> FL (WrappedNamed rt p) wT wY -> IO Bool
checkUnrecordedConflicts NoUpdateWorking _
= Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
checkUnrecordedConflicts _ pc :: FL (WrappedNamed rt p) wT wY
pc =
do Repository rt p Any Any wT
repository <- UseCache -> String -> IO (Repository rt p Any Any wT)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
UseCache -> String -> IO (Repository rt p wR wU wT)
identifyRepository UseCache
NoUseCache "."
Repository rt p Any Any wT -> IO Bool
forall wR wU. Repository rt p wR wU wT -> IO Bool
cuc Repository rt p Any Any wT
repository
where cuc :: Repository rt p wR wU wT -> IO Bool
cuc :: Repository rt p wR wU wT -> IO Bool
cuc r :: Repository rt p wR wU wT
r = do Sealed (mpend :: FL (PrimOf p) wT wX) <- 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))
readPending Repository rt p wR wU wT
r :: IO (Sealed (FL (PrimOf p) wT))
case FL (PrimOf p) wT wX
mpend of
NilFL -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
pend :: FL (PrimOf p) wT wX
pend ->
case (:\/:) (FL p) (FL p) wX wY -> (:/\:) (FL p) (FL p) wX wY
forall (p :: * -> * -> *) wX wY.
Merge p =>
(:\/:) p p wX wY -> (:/\:) p p wX wY
merge (FL (PrimOf p) wT wX -> FL p wT wX
forall wA wB. FL (PrimOf p) wA wB -> FL p wA wB
fromPrims_ FL (PrimOf p) wT wX
pend FL p wT wX -> FL p wT wY -> (:\/:) (FL p) (FL p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: FL (PrimOf p) wT wY -> FL p wT wY
forall wA wB. FL (PrimOf p) wA wB -> FL p wA wB
fromPrims_ (FL (FL (PrimOf p)) wT wY -> FL (PrimOf p) wT wY
forall (a :: * -> * -> *) wX wZ. FL (FL a) wX wZ -> FL a wX wZ
concatFL (FL (FL (PrimOf p)) wT wY -> FL (PrimOf p) wT wY)
-> FL (FL (PrimOf p)) wT wY -> FL (PrimOf p) wT wY
forall a b. (a -> b) -> a -> b
$ (forall wW wY. WrappedNamed rt p wW wY -> FL (PrimOf p) wW wY)
-> FL (WrappedNamed rt p) wT wY -> FL (FL (PrimOf p)) wT wY
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall wW wY. WrappedNamed rt p wW wY -> FL (PrimOf p) wW wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect FL (WrappedNamed rt p) wT wY
pc)) of
_ :/\: pend' :: FL p wY wZ
pend' ->
case FL p wY wZ -> [String]
forall (p :: * -> * -> *) wX wY. Conflict p => p wX wY -> [String]
listConflictedFiles FL p wY wZ
pend' of
[] -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
fs :: [String]
fs -> do String -> IO ()
putStrLn ("You have conflicting local changes to:\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
fs)
Bool
confirmed <- String -> IO Bool
promptYorn "Proceed?"
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
confirmed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
do String -> IO ()
putStrLn "Cancelled."
IO ()
forall a. IO a
exitSuccess
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
fromPrims_ :: FL (PrimOf p) wA wB -> FL p wA wB
fromPrims_ :: FL (PrimOf p) wA wB -> FL p wA wB
fromPrims_ = FL (PrimOf p) wA wB -> FL p wA wB
forall (p :: * -> * -> *) wX wY.
FromPrims p =>
FL (PrimOf p) wX wY -> p wX wY
fromPrims