--  Copyright (C) 2003,2005 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; see the file COPYING.  If not, write to
--  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
--  Boston, MA 02110-1301, USA.
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        -- ^ working tree
                   -> String              -- ^ external merge tool command
                   -> WantGuiPause        -- ^ tell whether we want GUI pause
                   -> FL (PrimOf p) wX wY -- ^ our effect
                   -> FL (PrimOf p) wX wZ -- ^ their effect
                   -> FL p wY wA          -- ^ them merged (standard_resolution)
                   -> 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 -- ^ external merge tool command
                      -> WantGuiPause -- ^ tell whether we want GUI pause
                      -> String -- ^ path to merge base
                      -> String -- ^ path to side 1 of the merge
                      -> String -- ^ path to side 2 of the merge
                      -> String -- ^ path where resolved content should go
                      -> (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) =
  -- optimization: all patches before the latest known clean tag
  -- are known to be resolved
  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