--  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
    , rebaseResolution
    , externalResolution
    , patchsetConflictResolutions
    , StandardResolution(..)
    , announceConflicts
    , haveConflicts
    , 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 ( unless, when )

import Darcs.Repository.Diff( treeDiff )
import Darcs.Patch
    ( Named
    , PrimOf
    , RepoPatch
    , applyToTree
    , effect
    , effectOnPaths
    , invert
    , listConflictedFiles
    , patchcontents
    , resolveConflicts
    )
import Darcs.Patch.Apply( ApplyState )
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(..), concatRLFL, mapRL_RL, nullFL )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), unseal, unFreeLeft )

import Darcs.Util.CommandLine ( parseCmd )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, hopefully )
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.File ( copyTree )
import Darcs.Repository.Flags
    ( AllowConflicts (..)
    , ResolveConflicts (..)
    , 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]
  }

haveConflicts :: StandardResolution prim wX -> Bool
haveConflicts :: forall (prim :: * -> * -> *) wX. StandardResolution prim wX -> Bool
haveConflicts StandardResolution prim wX
res = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Unravelled prim wX] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (StandardResolution prim wX -> [Unravelled prim wX]
forall (prim :: * -> * -> *) wX.
StandardResolution prim wX -> [Unravelled prim wX]
unmangled StandardResolution prim wX
res) Bool -> Bool -> Bool
&& (forall wX. FL prim wX wX -> Bool) -> Sealed (FL prim wX) -> Bool
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal FL prim wX wX -> Bool
forall wX. FL prim wX wX -> Bool
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL (StandardResolution prim wX -> Sealed (FL prim wX)
forall (prim :: * -> * -> *) wX.
StandardResolution prim wX -> Mangled prim wX
mangled StandardResolution prim wX
res)

standardResolution :: (RepoPatch p)
                   => RL (PatchInfoAnd p) wO wX
                   -> RL (PatchInfoAnd p) wX wY
                   -> StandardResolution (PrimOf p) wY
standardResolution :: forall (p :: * -> * -> *) wO wX wY.
RepoPatch p =>
RL (PatchInfoAnd p) wO wX
-> RL (PatchInfoAnd p) wX wY -> StandardResolution (PrimOf p) wY
standardResolution RL (PatchInfoAnd p) wO wX
context RL (PatchInfoAnd p) wX wY
interesting =
  [ConflictDetails (PrimOf p) wY] -> StandardResolution (PrimOf p) wY
forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
[ConflictDetails prim wX] -> StandardResolution prim wX
mangleConflicts ([ConflictDetails (PrimOf p) wY]
 -> StandardResolution (PrimOf p) wY)
-> [ConflictDetails (PrimOf p) wY]
-> StandardResolution (PrimOf p) wY
forall a b. (a -> b) -> a -> b
$ RL (PatchInfoAnd p) wO wX
-> RL (PatchInfoAnd p) wX wY
-> [ConflictDetails (PrimOf (PatchInfoAnd p)) wY]
forall wO wX wY.
RL (PatchInfoAnd p) wO wX
-> RL (PatchInfoAnd p) wX wY
-> [ConflictDetails (PrimOf (PatchInfoAnd p)) wY]
forall (p :: * -> * -> *) wO wX wY.
Conflict p =>
RL p wO wX -> RL p wX wY -> [ConflictDetails (PrimOf p) wY]
resolveConflicts RL (PatchInfoAnd p) wO wX
context RL (PatchInfoAnd p) wX wY
interesting

-- | Like 'standardResolution' but it doesn't use the @instance (Named p)@
-- because the traling list of patches may contain "fake" conflictors.
rebaseResolution
  :: (Conflict p, PrimPatch (PrimOf p))
  => RL (PatchInfoAnd p) wO wX
  -> RL (Named p) wX wY
  -> StandardResolution (PrimOf p) wY
rebaseResolution :: forall (p :: * -> * -> *) wO wX wY.
(Conflict p, PrimPatch (PrimOf p)) =>
RL (PatchInfoAnd p) wO wX
-> RL (Named p) wX wY -> StandardResolution (PrimOf p) wY
rebaseResolution RL (PatchInfoAnd p) wO wX
context RL (Named p) wX wY
interesting =
    [ConflictDetails (PrimOf p) wY] -> StandardResolution (PrimOf p) wY
forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
[ConflictDetails prim wX] -> StandardResolution prim wX
mangleConflicts ([ConflictDetails (PrimOf p) wY]
 -> StandardResolution (PrimOf p) wY)
-> [ConflictDetails (PrimOf p) wY]
-> StandardResolution (PrimOf p) wY
forall a b. (a -> b) -> a -> b
$ RL p wO wX -> RL p wX wY -> [ConflictDetails (PrimOf p) wY]
forall wO wX wY.
RL p wO wX -> RL p wX wY -> [ConflictDetails (PrimOf p) wY]
forall (p :: * -> * -> *) wO wX wY.
Conflict p =>
RL p wO wX -> RL p wX wY -> [ConflictDetails (PrimOf p) wY]
resolveConflicts RL p wO wX
context_patches RL p wX wY
interesting_patches
  where
    context_patches :: RL p wO wX
context_patches = RL (FL p) wO wX -> RL p wO wX
forall (p :: * -> * -> *) wX wY. RL (FL p) wX wY -> RL p wX wY
concatRLFL ((forall wW wY. PatchInfoAnd p wW wY -> FL p wW wY)
-> RL (PatchInfoAnd p) wO wX -> RL (FL p) wO wX
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> RL a wX wZ -> RL b wX wZ
mapRL_RL (Named p wW wY -> FL p wW wY
forall (p :: * -> * -> *) wX wY. Named p wX wY -> FL p wX wY
patchcontents (Named p wW wY -> FL p wW wY)
-> (PatchInfoAnd p wW wY -> Named p wW wY)
-> PatchInfoAnd p wW wY
-> FL p wW wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAnd p wW wY -> Named p wW wY
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> p wA wB
hopefully) RL (PatchInfoAnd p) wO wX
context)
    interesting_patches :: RL p wX wY
interesting_patches = RL (FL p) wX wY -> RL p wX wY
forall (p :: * -> * -> *) wX wY. RL (FL p) wX wY -> RL p wX wY
concatRLFL ((forall wW wY. Named p wW wY -> FL p wW wY)
-> RL (Named p) wX wY -> RL (FL p) wX wY
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> RL a wX wZ -> RL b wX wZ
mapRL_RL Named p wW wY -> FL p wW wY
forall wW wY. Named p wW wY -> FL p wW wY
forall (p :: * -> * -> *) wX wY. Named p wX wY -> FL p wX wY
patchcontents RL (Named p) wX wY
interesting)

mangleConflicts
  :: (PrimPatch prim) => [ConflictDetails prim wX] -> StandardResolution prim wX
mangleConflicts :: forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
[ConflictDetails prim wX] -> StandardResolution prim wX
mangleConflicts [ConflictDetails prim wX]
conflicts =
  case [Sealed (FL prim wX)]
-> Either
     (Sealed (FL prim wX), Sealed (FL prim wX)) (Sealed (FL prim wX))
forall (p :: * -> * -> *) wX.
CleanMerge p =>
[Sealed (FL p wX)]
-> Either (Sealed (FL p wX), Sealed (FL p wX)) (Sealed (FL p wX))
mergeList ([Sealed (FL prim wX)]
 -> Either
      (Sealed (FL prim wX), Sealed (FL prim wX)) (Sealed (FL prim wX)))
-> [Sealed (FL prim wX)]
-> Either
     (Sealed (FL prim wX), Sealed (FL prim wX)) (Sealed (FL prim wX))
forall a b. (a -> b) -> a -> b
$ [Maybe (Sealed (FL prim wX))] -> [Sealed (FL prim wX)]
forall a. [Maybe a] -> [a]
catMaybes ([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
$ (ConflictDetails prim wX -> Maybe (Sealed (FL prim wX)))
-> [ConflictDetails prim wX] -> [Maybe (Sealed (FL prim wX))]
forall a b. (a -> b) -> [a] -> [b]
map ConflictDetails prim wX -> Maybe (Sealed (FL prim wX))
forall (prim :: * -> * -> *) wX.
ConflictDetails prim wX -> Maybe (Mangled prim wX)
conflictMangled [ConflictDetails prim wX]
conflicts of
    Right Sealed (FL prim wX)
mangled -> StandardResolution {[[Sealed (FL prim wX)]]
[AnchoredPath]
Sealed (FL prim wX)
mangled :: Sealed (FL prim wX)
unmangled :: [[Sealed (FL prim wX)]]
conflictedPaths :: [AnchoredPath]
mangled :: Sealed (FL prim wX)
unmangled :: [[Sealed (FL prim wX)]]
conflictedPaths :: [AnchoredPath]
..}
    Left (Sealed FL prim wX wX
ps, Sealed FL prim wX wX
qs) ->
      [Char] -> StandardResolution prim wX
forall a. HasCallStack => [Char] -> a
error ([Char] -> StandardResolution prim wX)
-> [Char] -> StandardResolution prim wX
forall a b. (a -> b) -> a -> b
$ Doc -> [Char]
renderString
        (Doc -> [Char]) -> Doc -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
redText [Char]
"resolutions conflict:"
        Doc -> Doc -> Doc
$$ FL prim wX wX -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch FL prim wX wX
ps
        Doc -> Doc -> Doc
$$ [Char] -> Doc
redText [Char]
"conflicts with"
        Doc -> Doc -> Doc
$$ FL prim wX wX -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch FL prim wX wX
qs
  where
    unmangled :: [[Sealed (FL prim wX)]]
unmangled = (ConflictDetails prim wX -> [Sealed (FL prim wX)])
-> [ConflictDetails prim wX] -> [[Sealed (FL prim wX)]]
forall a b. (a -> b) -> [a] -> [b]
map ConflictDetails prim wX -> [Sealed (FL prim wX)]
forall (prim :: * -> * -> *) wX.
ConflictDetails prim wX -> Unravelled prim wX
conflictParts ([ConflictDetails prim wX] -> [[Sealed (FL prim wX)]])
-> [ConflictDetails prim wX] -> [[Sealed (FL prim wX)]]
forall a b. (a -> b) -> a -> b
$ (ConflictDetails prim wX -> Bool)
-> [ConflictDetails prim wX] -> [ConflictDetails prim wX]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (Sealed (FL prim wX)) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (Sealed (FL prim wX)) -> Bool)
-> (ConflictDetails prim wX -> Maybe (Sealed (FL prim wX)))
-> ConflictDetails prim wX
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConflictDetails prim wX -> Maybe (Sealed (FL prim wX))
forall (prim :: * -> * -> *) wX.
ConflictDetails prim wX -> Maybe (Mangled prim wX)
conflictMangled) [ConflictDetails prim wX]
conflicts
    conflictedPaths :: [AnchoredPath]
conflictedPaths =
      [AnchoredPath] -> [AnchoredPath]
forall a. Ord a => [a] -> [a]
nubSort ([AnchoredPath] -> [AnchoredPath])
-> [AnchoredPath] -> [AnchoredPath]
forall a b. (a -> b) -> a -> b
$
      (Sealed (FL prim wX) -> [AnchoredPath])
-> [Sealed (FL prim wX)] -> [AnchoredPath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((forall wX. FL prim wX wX -> [AnchoredPath])
-> Sealed (FL prim wX) -> [AnchoredPath]
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal FL prim wX wX -> [AnchoredPath]
forall wX. FL prim wX wX -> [AnchoredPath]
forall wX wY. FL prim wX wY -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles) ((ConflictDetails prim wX -> [Sealed (FL prim wX)])
-> [ConflictDetails prim wX] -> [Sealed (FL prim wX)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ConflictDetails prim wX -> [Sealed (FL prim wX)]
forall (prim :: * -> * -> *) wX.
ConflictDetails prim wX -> Unravelled prim wX
conflictParts [ConflictDetails prim wX]
conflicts)

warnUnmangled
  :: PrimPatch prim => Maybe [AnchoredPath] -> StandardResolution prim wX -> IO ()
warnUnmangled :: forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
Maybe [AnchoredPath] -> StandardResolution prim wX -> IO ()
warnUnmangled Maybe [AnchoredPath]
mpaths StandardResolution {[Unravelled prim wX]
[AnchoredPath]
Mangled prim wX
mangled :: forall (prim :: * -> * -> *) wX.
StandardResolution prim wX -> Mangled prim wX
unmangled :: forall (prim :: * -> * -> *) wX.
StandardResolution prim wX -> [Unravelled prim wX]
conflictedPaths :: forall (prim :: * -> * -> *) wX.
StandardResolution prim wX -> [AnchoredPath]
mangled :: Mangled prim wX
unmangled :: [Unravelled prim wX]
conflictedPaths :: [AnchoredPath]
..}
  | [Unravelled prim wX] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Unravelled prim wX]
unmangled = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise = Doc -> IO ()
ePutDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe [AnchoredPath] -> [Unravelled prim wX] -> Doc
forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
Maybe [AnchoredPath] -> [Unravelled prim wX] -> Doc
showUnmangled Maybe [AnchoredPath]
mpaths [Unravelled prim wX]
unmangled

showUnmangled
  :: PrimPatch prim => Maybe [AnchoredPath] -> [Unravelled prim wX] -> Doc
showUnmangled :: forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
Maybe [AnchoredPath] -> [Unravelled prim wX] -> Doc
showUnmangled Maybe [AnchoredPath]
mpaths = [Doc] -> Doc
vcat ([Doc] -> Doc)
-> ([Unravelled prim wX] -> [Doc]) -> [Unravelled prim wX] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unravelled prim wX -> Doc) -> [Unravelled prim wX] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Unravelled prim wX -> Doc
forall {prim :: * -> * -> *} {wX}.
(Annotate prim, CleanMerge prim, IsHunk prim, PatchInspect prim,
 RepairToFL prim, Show2 prim, PrimConstruct prim, PrimCoalesce prim,
 PrimDetails prim, PrimApply prim, PrimSift prim,
 PrimMangleUnravelled prim, ReadPatch prim, ShowPatch prim,
 ShowContextPatch prim, PatchListFormat prim) =>
Unravelled prim wX -> Doc
showUnmangledConflict ([Unravelled prim wX] -> [Doc])
-> ([Unravelled prim wX] -> [Unravelled prim wX])
-> [Unravelled prim wX]
-> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unravelled prim wX -> Bool)
-> [Unravelled prim wX] -> [Unravelled prim wX]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe [AnchoredPath] -> Unravelled prim wX -> Bool
forall {t :: * -> *} {t :: * -> *} {p :: * -> * -> *} {wX}.
(Foldable t, Foldable t, PatchInspect p) =>
Maybe (t AnchoredPath) -> t (Sealed (p wX)) -> Bool
affected Maybe [AnchoredPath]
mpaths)
  where
    showUnmangledConflict :: Unravelled prim wX -> Doc
showUnmangledConflict Unravelled prim wX
unravelled =
      [Char] -> Doc
redText [Char]
"Cannot mark these conflicting patches:" Doc -> Doc -> Doc
$$
      Doc -> Unravelled prim wX -> Doc
forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
Doc -> Unravelled prim wX -> Doc
showUnravelled ([Char] -> Doc
redText [Char]
"versus") Unravelled prim wX
unravelled
    affected :: Maybe (t AnchoredPath) -> t (Sealed (p wX)) -> Bool
affected Maybe (t AnchoredPath)
Nothing t (Sealed (p wX))
_ = Bool
True
    affected (Just t AnchoredPath
paths) t (Sealed (p wX))
unravelled =
      (AnchoredPath -> Bool) -> [AnchoredPath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (AnchoredPath -> t AnchoredPath -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t AnchoredPath
paths) ([AnchoredPath] -> Bool) -> [AnchoredPath] -> Bool
forall a b. (a -> b) -> a -> b
$ (Sealed (p wX) -> [AnchoredPath])
-> t (Sealed (p wX)) -> [AnchoredPath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((forall wX. p wX wX -> [AnchoredPath])
-> Sealed (p wX) -> [AnchoredPath]
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal p wX wX -> [AnchoredPath]
forall wX. p wX wX -> [AnchoredPath]
forall wX wY. p wX wY -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles) t (Sealed (p 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 ([Doc] -> Doc)
-> (Unravelled prim wX -> [Doc]) -> Unravelled prim wX -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse Doc
sep ([Doc] -> [Doc])
-> (Unravelled prim wX -> [Doc]) -> Unravelled prim wX -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sealed (FL prim wX) -> Doc) -> Unravelled prim wX -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((forall wX. FL prim wX wX -> Doc) -> Sealed (FL prim wX) -> Doc
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal FL prim wX wX -> Doc
forall wX. FL prim wX wX -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch)

announceConflicts :: PrimPatch prim
                  => String
                  -> AllowConflicts
                  -> StandardResolution prim wX
                  -> IO Bool
announceConflicts :: forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
[Char] -> AllowConflicts -> StandardResolution prim wX -> IO Bool
announceConflicts [Char]
cmd AllowConflicts
allowConflicts StandardResolution prim wX
conflicts = do
  let result :: Bool
result = StandardResolution prim wX -> Bool
forall (prim :: * -> * -> *) wX. StandardResolution prim wX -> Bool
haveConflicts StandardResolution prim wX
conflicts
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
result (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    let cfs :: [AnchoredPath]
cfs = [AnchoredPath] -> [AnchoredPath]
forall a. Ord a => [a] -> [a]
nubSort (StandardResolution prim wX -> [AnchoredPath]
forall (prim :: * -> * -> *) wX.
StandardResolution prim wX -> [AnchoredPath]
conflictedPaths StandardResolution prim wX
conflicts)
    Doc -> IO ()
ePutDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
redText [Char]
"We have conflicts!"
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([AnchoredPath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AnchoredPath]
cfs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Doc -> IO ()
ePutDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
"Affected paths:" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (AnchoredPath -> Doc) -> [AnchoredPath] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Doc
text ([Char] -> Doc) -> (AnchoredPath -> [Char]) -> AnchoredPath -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredPath -> [Char]
displayPath) [AnchoredPath]
cfs
    case AllowConflicts
allowConflicts of
      AllowConflicts
NoAllowConflicts ->
        [Char] -> IO ()
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
        [Char]
"Refusing to "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
cmd[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" patches leading to conflicts.\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
        [Char]
"If you would rather apply the patch and mark the conflicts,\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
        [Char]
"use the --mark-conflicts or --allow-conflicts options to "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
cmd[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
        [Char]
"These can set as defaults by adding\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
        [Char]
" "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
cmd[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" mark-conflicts\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
        [Char]
"to "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
darcsdir[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"/prefs/defaults in the target repo. "
      YesAllowConflicts ResolveConflicts
MarkConflicts ->
        Maybe [AnchoredPath] -> StandardResolution prim wX -> IO ()
forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
Maybe [AnchoredPath] -> StandardResolution prim wX -> IO ()
warnUnmangled Maybe [AnchoredPath]
forall a. Maybe a
Nothing StandardResolution prim wX
conflicts
      AllowConflicts
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result

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
                   -> 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 <- FL (PrimOf p) wY wX -> Tree IO -> IO (Tree IO)
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, MonadThrow m, ApplyState p ~ Tree) =>
p wX wY -> Tree m -> m (Tree m)
applyToTree (FL (PrimOf p) wX wY -> FL (PrimOf p) wY wX
forall wX wY. FL (PrimOf p) wX wY -> FL (PrimOf p) wY wX
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 <- FL p wY wA -> Tree IO -> IO (Tree IO)
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, MonadThrow m, ApplyState p ~ Tree) =>
p wX wY -> Tree m -> m (Tree m)
applyToTree FL p wY wA
pmerged Tree IO
s1
 Tree IO
s2 <- FL (PrimOf p) wX wZ -> Tree IO -> IO (Tree IO)
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, MonadThrow 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 = FL p wY wA -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
(Summary p, PatchInspect (PrimOf p)) =>
p wX wY -> [AnchoredPath]
listConflictedFiles FL p wY wA
pmerged
     n1s :: [AnchoredPath]
n1s = FL (PrimOf p) wA wY -> [AnchoredPath] -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
p wX wY -> [AnchoredPath] -> [AnchoredPath]
effectOnPaths (FL (PrimOf p) wY wA -> FL (PrimOf p) wA wY
forall wX wY. FL (PrimOf p) wX wY -> FL (PrimOf p) wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert (FL p wY wA -> FL (PrimOf (FL p)) wY wA
forall wX wY. FL p wX wY -> FL (PrimOf (FL p)) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect FL p wY wA
pmerged)) [AnchoredPath]
nms
     nas :: [AnchoredPath]
nas = FL (PrimOf p) wY wX -> [AnchoredPath] -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
p wX wY -> [AnchoredPath] -> [AnchoredPath]
effectOnPaths (FL (PrimOf p) wX wY -> FL (PrimOf p) wY wX
forall wX wY. FL (PrimOf p) wX wY -> FL (PrimOf p) wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FL (PrimOf p) wX wY
p1) [AnchoredPath]
n1s
     n2s :: [AnchoredPath]
n2s = FL (PrimOf p) wX wZ -> [AnchoredPath] -> [AnchoredPath]
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 = [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [([Char], [Char], [Char], [Char])]
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 = (AnchoredPath -> [Char]) -> [AnchoredPath] -> [[Char]]
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 ((AnchoredPath -> TreeItem IO -> Bool) -> Tree IO -> Tree IO
forall (a :: (* -> *) -> *) (m :: * -> *).
FilterTree a m =>
(AnchoredPath -> TreeItem m -> Bool) -> a m -> a m
Tree.filter ([AnchoredPath] -> AnchoredPath -> TreeItem IO -> Bool
forall t. [AnchoredPath] -> AnchoredPath -> t -> Bool
filterPaths [AnchoredPath]
fs) Tree IO
tree) [Char]
"."
  in do
   [Char]
former_dir <- IO [Char]
getCurrentDirectory
   [Char]
-> (AbsolutePath -> IO (Sealed (FL (PrimOf p) wA)))
-> IO (Sealed (FL (PrimOf p) wA))
forall a. [Char] -> (AbsolutePath -> IO a) -> IO a
withTempDir [Char]
"version1" ((AbsolutePath -> IO (Sealed (FL (PrimOf p) wA)))
 -> IO (Sealed (FL (PrimOf p) wA)))
-> (AbsolutePath -> IO (Sealed (FL (PrimOf p) wA)))
-> IO (Sealed (FL (PrimOf p) wA))
forall a b. (a -> b) -> a -> b
$ \AbsolutePath
absd1 -> do
     let d1 :: [Char]
d1 = AbsolutePath -> [Char]
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
     [Char]
-> (AbsolutePath -> IO (Sealed (FL (PrimOf p) wA)))
-> IO (Sealed (FL (PrimOf p) wA))
forall a. [Char] -> (AbsolutePath -> IO a) -> IO a
withTempDir [Char]
"ancestor" ((AbsolutePath -> IO (Sealed (FL (PrimOf p) wA)))
 -> IO (Sealed (FL (PrimOf p) wA)))
-> (AbsolutePath -> IO (Sealed (FL (PrimOf p) wA)))
-> IO (Sealed (FL (PrimOf p) wA))
forall a b. (a -> b) -> a -> b
$ \AbsolutePath
absda -> do
       let da :: [Char]
da = AbsolutePath -> [Char]
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
       [Char]
-> (AbsolutePath -> IO (Sealed (FL (PrimOf p) wA)))
-> IO (Sealed (FL (PrimOf p) wA))
forall a. [Char] -> (AbsolutePath -> IO a) -> IO a
withTempDir [Char]
"merged" ((AbsolutePath -> IO (Sealed (FL (PrimOf p) wA)))
 -> IO (Sealed (FL (PrimOf p) wA)))
-> (AbsolutePath -> IO (Sealed (FL (PrimOf p) wA)))
-> IO (Sealed (FL (PrimOf p) wA))
forall a b. (a -> b) -> a -> b
$ \AbsolutePath
absdm -> do
         let dm :: [Char]
dm = AbsolutePath -> [Char]
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
         [Char]
-> (AbsolutePath -> IO (Sealed (FL (PrimOf p) wA)))
-> IO (Sealed (FL (PrimOf p) wA))
forall a. [Char] -> (AbsolutePath -> IO a) -> IO a
withTempDir [Char]
"cleanmerged" ((AbsolutePath -> IO (Sealed (FL (PrimOf p) wA)))
 -> IO (Sealed (FL (PrimOf p) wA)))
-> (AbsolutePath -> IO (Sealed (FL (PrimOf p) wA)))
-> IO (Sealed (FL (PrimOf p) wA))
forall a b. (a -> b) -> a -> b
$ \AbsolutePath
absdc -> do
           let dc :: [Char]
dc = AbsolutePath -> [Char]
forall a. FilePathLike a => a -> [Char]
toFilePath AbsolutePath
absdc
           [Char] -> [Char] -> IO ()
copyTree [Char]
dm [Char]
"."
           [Char] -> IO ()
setCurrentDirectory [Char]
former_dir
           [Char]
-> (AbsolutePath -> IO (Sealed (FL (PrimOf p) wA)))
-> IO (Sealed (FL (PrimOf p) wA))
forall a. [Char] -> (AbsolutePath -> IO a) -> IO a
withTempDir [Char]
"version2" ((AbsolutePath -> IO (Sealed (FL (PrimOf p) wA)))
 -> IO (Sealed (FL (PrimOf p) wA)))
-> (AbsolutePath -> IO (Sealed (FL (PrimOf p) wA)))
-> IO (Sealed (FL (PrimOf p) wA))
forall a b. (a -> b) -> a -> b
$ \AbsolutePath
absd2 -> do
             let d2 :: [Char]
d2 = AbsolutePath -> [Char]
forall a. FilePathLike a => a -> [Char]
toFilePath AbsolutePath
absd2
             Tree IO -> [AnchoredPath] -> IO ()
write_files Tree IO
s2 [AnchoredPath]
n2s
             (([Char], [Char], [Char], [Char]) -> IO ())
-> [([Char], [Char], [Char], [Char])] -> IO ()
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
             FreeLeft (FL (PrimOf p)) -> Sealed (FL (PrimOf p) wA)
forall (p :: * -> * -> *) wX. FreeLeft p -> Sealed (p wX)
unFreeLeft (FreeLeft (FL (PrimOf p)) -> Sealed (FL (PrimOf p) wA))
-> IO (FreeLeft (FL (PrimOf p))) -> IO (Sealed (FL (PrimOf p) wA))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` DiffAlgorithm
-> ([Char] -> FileType)
-> Tree IO
-> Tree IO
-> IO (FreeLeft (FL (PrimOf p)))
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 ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Merging file "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
fm[Char] -> [Char] -> [Char]
forall 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]
"%")]
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
ec ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
         [Char] -> IO ()
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"External merge command exited with " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ExitCode -> [Char]
forall a. Show a => a -> [Char]
show ExitCode
ec
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WantGuiPause
wantGuiPause WantGuiPause -> WantGuiPause -> Bool
forall a. Eq a => a -> a -> Bool
== WantGuiPause
YesWantGuiPause) (IO () -> IO ()) -> IO () -> IO ()
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     -> [Char] -> IO ExitCode
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> IO ExitCode) -> [Char] -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ ParseError -> [Char]
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 ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Running command '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                                            [[Char]] -> [Char]
unwords ([Char]
command[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
args) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'"
                                 [Char] -> [[Char]] -> Redirects -> IO ExitCode
exec [Char]
command [[Char]]
args (Redirect
Null,Redirect
AsIs,Redirect
AsIs)
          rr [] = ExitCode -> IO ExitCode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess

patchsetConflictResolutions :: RepoPatch p
                            => PatchSet p Origin wX
                            -> StandardResolution (PrimOf p) wX
patchsetConflictResolutions :: forall (p :: * -> * -> *) wX.
RepoPatch p =>
PatchSet p Origin wX -> StandardResolution (PrimOf p) wX
patchsetConflictResolutions (PatchSet RL (Tagged p) Origin wX
ts RL (PatchInfoAnd p) wX wX
xs) =
  -- optimization: all patches before the latest known clean tag
  -- are known to be resolved
  RL (PatchInfoAnd p) Origin wX
-> RL (PatchInfoAnd p) wX wX -> StandardResolution (PrimOf p) wX
forall (p :: * -> * -> *) wO wX wY.
RepoPatch p =>
RL (PatchInfoAnd p) wO wX
-> RL (PatchInfoAnd p) wX wY -> StandardResolution (PrimOf p) wY
standardResolution (PatchSet p Origin wX -> RL (PatchInfoAnd p) Origin wX
forall (p :: * -> * -> *) wStart wX.
PatchSet p wStart wX -> RL (PatchInfoAnd p) wStart wX
patchSet2RL (RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wX -> PatchSet p Origin wX
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
ts RL (PatchInfoAnd p) wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL)) RL (PatchInfoAnd p) wX wX
xs