module Darcs.Repository.Resolution
( standardResolution
, externalResolution
, patchsetConflictResolutions
, StandardResolution(..)
, announceConflicts
, warnUnmangled
, showUnmangled
, showUnravelled
) where
import Darcs.Prelude
import System.FilePath.Posix ( (</>) )
import System.Exit ( ExitCode( ExitSuccess ) )
import System.Directory ( setCurrentDirectory, getCurrentDirectory )
import Data.List ( intersperse, zip4 )
import Data.List.Ordered ( nubSort )
import Data.Maybe ( catMaybes, isNothing )
import Control.Monad ( when )
import Darcs.Repository.Diff( treeDiff )
import Darcs.Patch
( PrimOf
, PrimPatchBase
, RepoPatch
, applyToTree
, effect
, effectOnPaths
, invert
, listConflictedFiles
, resolveConflicts
)
import Darcs.Patch.Apply( ApplyState )
import Darcs.Patch.Commute ( Commute )
import Darcs.Patch.Conflict ( Conflict, ConflictDetails(..), Mangled, Unravelled )
import Darcs.Patch.Inspect ( listTouchedFiles )
import Darcs.Patch.Merge ( mergeList )
import Darcs.Patch.Prim ( PrimPatch )
import Darcs.Util.Path
( AnchoredPath
, anchorPath
, displayPath
, filterPaths
, toFilePath
)
import Darcs.Patch.Witnesses.Ordered ( FL(..), RL(..) )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), unseal, unFreeLeft )
import Darcs.Util.CommandLine ( parseCmd )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd )
import Darcs.Util.Prompt ( askEnter )
import Darcs.Patch.Set ( PatchSet(..), Origin, patchSet2RL )
import Darcs.Repository.Prefs ( filetypeFunction )
import Darcs.Util.Exec ( exec, Redirect(..) )
import Darcs.Util.Lock ( withTempDir )
import Darcs.Util.External ( cloneTree )
import Darcs.Repository.Flags
( AllowConflicts (..)
, ExternalMerge (..)
, WantGuiPause (..)
, DiffAlgorithm (..)
)
import qualified Darcs.Util.Tree as Tree
import Darcs.Util.Tree.Plain ( writePlainTree, readPlainTree )
import Darcs.Util.Global ( darcsdir )
import Darcs.Util.Printer ( Doc, renderString, ($$), text, redText, vcat )
import Darcs.Util.Printer.Color ( ePutDocLn )
import Darcs.Patch ( displayPatch )
data StandardResolution prim wX =
StandardResolution {
forall (prim :: * -> * -> *) wX.
StandardResolution prim wX -> Mangled prim wX
mangled :: Mangled prim wX,
forall (prim :: * -> * -> *) wX.
StandardResolution prim wX -> [Unravelled prim wX]
unmangled :: [Unravelled prim wX],
forall (prim :: * -> * -> *) wX.
StandardResolution prim wX -> [AnchoredPath]
conflictedPaths :: [AnchoredPath]
}
standardResolution :: (Commute p, PrimPatchBase p, Conflict p)
=> RL (PatchInfoAnd rt p) wO wX
-> RL (PatchInfoAnd rt p) wX wY
-> StandardResolution (PrimOf p) wY
standardResolution :: forall (p :: * -> * -> *) (rt :: RepoType) wO wX wY.
(Commute p, PrimPatchBase p, Conflict p) =>
RL (PatchInfoAnd rt p) wO wX
-> RL (PatchInfoAnd rt p) wX wY -> StandardResolution (PrimOf p) wY
standardResolution RL (PatchInfoAnd rt p) wO wX
context RL (PatchInfoAnd rt p) wX wY
interesting =
case forall (p :: * -> * -> *) wX.
CleanMerge p =>
[Sealed (FL p wX)]
-> Either (Sealed (FL p wX), Sealed (FL p wX)) (Sealed (FL p wX))
mergeList forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (prim :: * -> * -> *) wX.
ConflictDetails prim wX -> Maybe (Mangled prim wX)
conflictMangled [ConflictDetails (PrimOf p) wY]
conflicts of
Right Sealed (FL (PrimOf p) wY)
mangled -> StandardResolution {[[Sealed (FL (PrimOf p) wY)]]
[AnchoredPath]
Sealed (FL (PrimOf p) wY)
conflictedPaths :: [AnchoredPath]
unmangled :: [[Sealed (FL (PrimOf p) wY)]]
mangled :: Sealed (FL (PrimOf p) wY)
conflictedPaths :: [AnchoredPath]
unmangled :: [[Sealed (FL (PrimOf p) wY)]]
mangled :: Sealed (FL (PrimOf p) wY)
..}
Left (Sealed FL (PrimOf p) wY wX
ps, Sealed FL (PrimOf p) wY wX
qs) ->
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ Doc -> [Char]
renderString
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
redText [Char]
"resolutions conflict:"
Doc -> Doc -> Doc
$$ forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch FL (PrimOf p) wY wX
ps
Doc -> Doc -> Doc
$$ [Char] -> Doc
redText [Char]
"conflicts with"
Doc -> Doc -> Doc
$$ forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch FL (PrimOf p) wY wX
qs
where
conflicts :: [ConflictDetails (PrimOf (PatchInfoAnd rt p)) wY]
conflicts = forall (p :: * -> * -> *) wO wX wY.
Conflict p =>
RL p wO wX -> RL p wX wY -> [ConflictDetails (PrimOf p) wY]
resolveConflicts RL (PatchInfoAnd rt p) wO wX
context RL (PatchInfoAnd rt p) wX wY
interesting
unmangled :: [[Sealed (FL (PrimOf p) wY)]]
unmangled = forall a b. (a -> b) -> [a] -> [b]
map forall (prim :: * -> * -> *) wX.
ConflictDetails prim wX -> Unravelled prim wX
conflictParts forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (prim :: * -> * -> *) wX.
ConflictDetails prim wX -> Maybe (Mangled prim wX)
conflictMangled) [ConflictDetails (PrimOf p) wY]
conflicts
conflictedPaths :: [AnchoredPath]
conflictedPaths =
forall a. Ord a => [a] -> [a]
nubSort forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (prim :: * -> * -> *) wX.
ConflictDetails prim wX -> Unravelled prim wX
conflictParts [ConflictDetails (PrimOf p) wY]
conflicts)
warnUnmangled :: PrimPatch prim => StandardResolution prim wX -> IO ()
warnUnmangled :: forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
StandardResolution prim wX -> IO ()
warnUnmangled StandardResolution {[Unravelled prim wX]
[AnchoredPath]
Mangled prim wX
conflictedPaths :: [AnchoredPath]
unmangled :: [Unravelled prim wX]
mangled :: Mangled prim wX
conflictedPaths :: forall (prim :: * -> * -> *) wX.
StandardResolution prim wX -> [AnchoredPath]
unmangled :: forall (prim :: * -> * -> *) wX.
StandardResolution prim wX -> [Unravelled prim wX]
mangled :: forall (prim :: * -> * -> *) wX.
StandardResolution prim wX -> Mangled prim wX
..}
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Unravelled prim wX]
unmangled = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = Doc -> IO ()
ePutDocLn forall a b. (a -> b) -> a -> b
$ forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
[Unravelled prim wX] -> Doc
showUnmangled [Unravelled prim wX]
unmangled
showUnmangled :: PrimPatch prim => [Unravelled prim wX] -> Doc
showUnmangled :: forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
[Unravelled prim wX] -> Doc
showUnmangled = [Doc] -> Doc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {prim :: * -> * -> *} {wX}.
(CleanMerge prim, Commute prim, Invert prim, Eq2 prim, IsHunk prim,
PatchInspect prim, RepairToFL prim, Show2 prim, PrimConstruct prim,
PrimCanonize prim, PrimClassify prim, PrimDetails prim,
PrimApply prim, PrimSift prim, PrimMangleUnravelled prim,
ReadPatch prim, ShowPatch prim, ShowContextPatch prim,
PatchListFormat prim) =>
Unravelled prim wX -> Doc
showUnmangledConflict
where
showUnmangledConflict :: Unravelled prim wX -> Doc
showUnmangledConflict Unravelled prim wX
unravelled =
[Char] -> Doc
redText [Char]
"Cannot mark these conflicting patches:" Doc -> Doc -> Doc
$$
forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
Doc -> Unravelled prim wX -> Doc
showUnravelled ([Char] -> Doc
redText [Char]
"versus") Unravelled prim wX
unravelled
showUnravelled :: PrimPatch prim => Doc -> Unravelled prim wX -> Doc
showUnravelled :: forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
Doc -> Unravelled prim wX -> Doc
showUnravelled Doc
sep =
[Doc] -> Doc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse Doc
sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch)
announceConflicts :: PrimPatch prim
=> String
-> AllowConflicts
-> ExternalMerge
-> StandardResolution prim wX
-> IO Bool
announceConflicts :: forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
[Char]
-> AllowConflicts
-> ExternalMerge
-> StandardResolution prim wX
-> IO Bool
announceConflicts [Char]
cmd AllowConflicts
allowConflicts ExternalMerge
externalMerge StandardResolution prim wX
conflicts =
case forall a. Ord a => [a] -> [a]
nubSort (forall (prim :: * -> * -> *) wX.
StandardResolution prim wX -> [AnchoredPath]
conflictedPaths StandardResolution prim wX
conflicts) of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
[AnchoredPath]
cfs -> do
Doc -> IO ()
ePutDocLn forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
redText
[Char]
"We have conflicts in the following files:" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredPath -> [Char]
displayPath) [AnchoredPath]
cfs
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AllowConflicts
allowConflicts forall a. Eq a => a -> a -> Bool
== AllowConflicts
YesAllowConflictsAndMark) forall a b. (a -> b) -> a -> b
$ forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
StandardResolution prim wX -> IO ()
warnUnmangled StandardResolution prim wX
conflicts
if AllowConflicts
allowConflicts forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [AllowConflicts
YesAllowConflicts,AllowConflicts
YesAllowConflictsAndMark]
Bool -> Bool -> Bool
|| ExternalMerge
externalMerge forall a. Eq a => a -> a -> Bool
/= ExternalMerge
NoExternalMerge
then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
[Char]
"Refusing to "forall a. [a] -> [a] -> [a]
++[Char]
cmdforall a. [a] -> [a] -> [a]
++[Char]
" patches leading to conflicts.\n"forall a. [a] -> [a] -> [a]
++
[Char]
"If you would rather apply the patch and mark the conflicts,\n"forall a. [a] -> [a] -> [a]
++
[Char]
"use the --mark-conflicts or --allow-conflicts options to "forall a. [a] -> [a] -> [a]
++[Char]
cmdforall a. [a] -> [a] -> [a]
++[Char]
"\n"forall a. [a] -> [a] -> [a]
++
[Char]
"These can set as defaults by adding\n"forall a. [a] -> [a] -> [a]
++
[Char]
" "forall a. [a] -> [a] -> [a]
++[Char]
cmdforall a. [a] -> [a] -> [a]
++[Char]
" mark-conflicts\n"forall a. [a] -> [a] -> [a]
++
[Char]
"to "forall a. [a] -> [a] -> [a]
++[Char]
darcsdirforall a. [a] -> [a] -> [a]
++[Char]
"/prefs/defaults in the target repo. "
externalResolution :: forall p wX wY wZ wA. (RepoPatch p, ApplyState p ~ Tree.Tree)
=> DiffAlgorithm
-> Tree.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 :: forall (p :: * -> * -> *) wX wY wZ wA.
(RepoPatch p, ApplyState p ~ Tree) =>
DiffAlgorithm
-> Tree IO
-> [Char]
-> WantGuiPause
-> FL (PrimOf p) wX wY
-> FL (PrimOf p) wX wZ
-> FL p wY wA
-> IO (Sealed (FL (PrimOf p) wA))
externalResolution DiffAlgorithm
diffa Tree IO
s1 [Char]
c WantGuiPause
wantGuiPause FL (PrimOf p) wX wY
p1 FL (PrimOf p) wX wZ
p2 FL p wY wA
pmerged = do
Tree IO
sa <- forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, Monad m, ApplyState p ~ Tree) =>
p wX wY -> Tree m -> m (Tree m)
applyToTree (forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FL (PrimOf p) wX wY
p1) Tree IO
s1
Tree IO
sm <- forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, Monad m, ApplyState p ~ Tree) =>
p wX wY -> Tree m -> m (Tree m)
applyToTree FL p wY wA
pmerged Tree IO
s1
Tree IO
s2 <- forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, Monad m, ApplyState p ~ Tree) =>
p wX wY -> Tree m -> m (Tree m)
applyToTree FL (PrimOf p) wX wZ
p2 Tree IO
sa
let nms :: [AnchoredPath]
nms = forall (p :: * -> * -> *) wX wY.
(Summary p, PatchInspect (PrimOf p)) =>
p wX wY -> [AnchoredPath]
listConflictedFiles FL p wY wA
pmerged
nas :: [AnchoredPath]
nas = forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
p wX wY -> [AnchoredPath] -> [AnchoredPath]
effectOnPaths (forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert (forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect FL p wY wA
pmerged)) [AnchoredPath]
nms
n1s :: [AnchoredPath]
n1s = forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
p wX wY -> [AnchoredPath] -> [AnchoredPath]
effectOnPaths FL (PrimOf p) wX wY
p1 [AnchoredPath]
nas
n2s :: [AnchoredPath]
n2s = forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
p wX wY -> [AnchoredPath] -> [AnchoredPath]
effectOnPaths FL (PrimOf p) wX wZ
p2 [AnchoredPath]
nas
ns :: [([Char], [Char], [Char], [Char])]
ns = forall a b c d. [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
zip4 ([AnchoredPath] -> [[Char]]
tofp [AnchoredPath]
nas) ([AnchoredPath] -> [[Char]]
tofp [AnchoredPath]
n1s) ([AnchoredPath] -> [[Char]]
tofp [AnchoredPath]
n2s) ([AnchoredPath] -> [[Char]]
tofp [AnchoredPath]
nms)
tofp :: [AnchoredPath] -> [[Char]]
tofp = forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> AnchoredPath -> [Char]
anchorPath [Char]
"")
write_files :: Tree IO -> [AnchoredPath] -> IO ()
write_files Tree IO
tree [AnchoredPath]
fs = Tree IO -> [Char] -> IO ()
writePlainTree (forall (a :: (* -> *) -> *) (m :: * -> *).
FilterTree a m =>
(AnchoredPath -> TreeItem m -> Bool) -> a m -> a m
Tree.filter (forall t. [AnchoredPath] -> AnchoredPath -> t -> Bool
filterPaths [AnchoredPath]
fs) Tree IO
tree) [Char]
"."
in do
[Char]
former_dir <- IO [Char]
getCurrentDirectory
forall a. [Char] -> (AbsolutePath -> IO a) -> IO a
withTempDir [Char]
"version1" forall a b. (a -> b) -> a -> b
$ \AbsolutePath
absd1 -> do
let d1 :: [Char]
d1 = forall a. FilePathLike a => a -> [Char]
toFilePath AbsolutePath
absd1
Tree IO -> [AnchoredPath] -> IO ()
write_files Tree IO
s1 [AnchoredPath]
n1s
[Char] -> IO ()
setCurrentDirectory [Char]
former_dir
forall a. [Char] -> (AbsolutePath -> IO a) -> IO a
withTempDir [Char]
"ancestor" forall a b. (a -> b) -> a -> b
$ \AbsolutePath
absda -> do
let da :: [Char]
da = forall a. FilePathLike a => a -> [Char]
toFilePath AbsolutePath
absda
Tree IO -> [AnchoredPath] -> IO ()
write_files Tree IO
sa [AnchoredPath]
nas
[Char] -> IO ()
setCurrentDirectory [Char]
former_dir
forall a. [Char] -> (AbsolutePath -> IO a) -> IO a
withTempDir [Char]
"merged" forall a b. (a -> b) -> a -> b
$ \AbsolutePath
absdm -> do
let dm :: [Char]
dm = forall a. FilePathLike a => a -> [Char]
toFilePath AbsolutePath
absdm
Tree IO -> [AnchoredPath] -> IO ()
write_files Tree IO
sm [AnchoredPath]
nms
[Char] -> IO ()
setCurrentDirectory [Char]
former_dir
forall a. [Char] -> (AbsolutePath -> IO a) -> IO a
withTempDir [Char]
"cleanmerged" forall a b. (a -> b) -> a -> b
$ \AbsolutePath
absdc -> do
let dc :: [Char]
dc = forall a. FilePathLike a => a -> [Char]
toFilePath AbsolutePath
absdc
[Char] -> [Char] -> IO ()
cloneTree [Char]
dm [Char]
"."
[Char] -> IO ()
setCurrentDirectory [Char]
former_dir
forall a. [Char] -> (AbsolutePath -> IO a) -> IO a
withTempDir [Char]
"version2" forall a b. (a -> b) -> a -> b
$ \AbsolutePath
absd2 -> do
let d2 :: [Char]
d2 = forall a. FilePathLike a => a -> [Char]
toFilePath AbsolutePath
absd2
Tree IO -> [AnchoredPath] -> IO ()
write_files Tree IO
s2 [AnchoredPath]
n2s
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Char]
-> WantGuiPause
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> ([Char], [Char], [Char], [Char])
-> IO ()
externallyResolveFile [Char]
c WantGuiPause
wantGuiPause [Char]
da [Char]
d1 [Char]
d2 [Char]
dm) [([Char], [Char], [Char], [Char])]
ns
Tree IO
sc <- [Char] -> IO (Tree IO)
readPlainTree [Char]
dc
Tree IO
sfixed <- [Char] -> IO (Tree IO)
readPlainTree [Char]
dm
[Char] -> FileType
ftf <- IO ([Char] -> FileType)
filetypeFunction
forall (p :: * -> * -> *) wX. FreeLeft p -> Sealed (p wX)
unFreeLeft forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) (w :: (* -> * -> *) -> *)
(prim :: * -> * -> *).
(Monad m, Gap w, PrimPatch prim) =>
DiffAlgorithm
-> ([Char] -> FileType) -> Tree m -> Tree m -> m (w (FL prim))
treeDiff DiffAlgorithm
diffa [Char] -> FileType
ftf Tree IO
sc Tree IO
sfixed
externallyResolveFile :: String
-> WantGuiPause
-> String
-> String
-> String
-> String
-> (FilePath, FilePath, FilePath, FilePath)
-> IO ()
externallyResolveFile :: [Char]
-> WantGuiPause
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> ([Char], [Char], [Char], [Char])
-> IO ()
externallyResolveFile [Char]
c WantGuiPause
wantGuiPause [Char]
da [Char]
d1 [Char]
d2 [Char]
dm ([Char]
fa, [Char]
f1, [Char]
f2, [Char]
fm) = do
[Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"Merging file "forall a. [a] -> [a] -> [a]
++[Char]
fmforall a. [a] -> [a] -> [a]
++[Char]
" by hand."
ExitCode
ec <- [Char] -> [(Char, [Char])] -> IO ExitCode
run [Char]
c [(Char
'1', [Char]
d1[Char] -> [Char] -> [Char]
</>[Char]
f1), (Char
'2', [Char]
d2[Char] -> [Char] -> [Char]
</>[Char]
f2), (Char
'a', [Char]
da[Char] -> [Char] -> [Char]
</>[Char]
fa), (Char
'o', [Char]
dm[Char] -> [Char] -> [Char]
</>[Char]
fm), (Char
'%', [Char]
"%")]
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
ec forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) forall a b. (a -> b) -> a -> b
$
[Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"External merge command exited with " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ExitCode
ec
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WantGuiPause
wantGuiPause forall a. Eq a => a -> a -> Bool
== WantGuiPause
YesWantGuiPause) forall a b. (a -> b) -> a -> b
$
[Char] -> IO ()
askEnter [Char]
"Hit return to move on, ^C to abort the whole operation..."
run :: String -> [(Char,String)] -> IO ExitCode
run :: [Char] -> [(Char, [Char])] -> IO ExitCode
run [Char]
c [(Char, [Char])]
replacements =
case [(Char, [Char])] -> [Char] -> Either ParseError ([[Char]], Bool)
parseCmd [(Char, [Char])]
replacements [Char]
c of
Left ParseError
err -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show ParseError
err
Right ([[Char]]
c2,Bool
_) -> [[Char]] -> IO ExitCode
rr [[Char]]
c2
where rr :: [[Char]] -> IO ExitCode
rr ([Char]
command:[[Char]]
args) = do [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"Running command '" forall a. [a] -> [a] -> [a]
++
[[Char]] -> [Char]
unwords ([Char]
commandforall a. a -> [a] -> [a]
:[[Char]]
args) forall a. [a] -> [a] -> [a]
++ [Char]
"'"
[Char] -> [[Char]] -> Redirects -> IO ExitCode
exec [Char]
command [[Char]]
args (Redirect
Null,Redirect
Null,Redirect
Null)
rr [] = forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess
patchsetConflictResolutions :: RepoPatch p
=> PatchSet rt p Origin wX
-> StandardResolution (PrimOf p) wX
patchsetConflictResolutions :: forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
PatchSet rt p Origin wX -> StandardResolution (PrimOf p) wX
patchsetConflictResolutions (PatchSet RL (Tagged rt p) Origin wX
ts RL (PatchInfoAnd rt p) wX wX
xs) =
forall (p :: * -> * -> *) (rt :: RepoType) wO wX wY.
(Commute p, PrimPatchBase p, Conflict p) =>
RL (PatchInfoAnd rt p) wO wX
-> RL (PatchInfoAnd rt p) wX wY -> StandardResolution (PrimOf p) wY
standardResolution (forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> RL (PatchInfoAnd rt p) wStart wX
patchSet2RL (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 (a :: * -> * -> *) wX. RL a wX wX
NilRL)) RL (PatchInfoAnd rt p) wX wX
xs