--  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
    ) where

import Prelude ()
import Darcs.Prelude

import System.FilePath.Posix ( (</>) )
import System.Exit ( ExitCode( ExitSuccess ) )
import System.Directory ( setCurrentDirectory, getCurrentDirectory )
import Data.List ( zip4 )
import Control.Monad ( when )

import Darcs.Repository.Diff( treeDiff )
import Darcs.Patch ( PrimOf, PrimPatch, RepoPatch, resolveConflicts,
                     effectOnFilePaths,
                     invert, listConflictedFiles, commute, applyToTree, fromPrim )
import Darcs.Patch.Apply( ApplyState )
import Darcs.Patch.Conflict ( Conflict, CommuteNoConflicts )
import Darcs.Patch.Named.Wrapped ( activecontents )
import Darcs.Patch.Prim ( PrimPatchBase )
import Darcs.Util.Path ( toFilePath, filterFilePaths )
import Darcs.Patch.Witnesses.Ordered
    ( FL(..), RL(..), (:>)(..), (+>+),
    mapFL_FL, concatFL, reverseRL )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), unFreeLeft )

import Darcs.Util.CommandLine ( parseCmd )
import Darcs.Patch.PatchInfoAnd ( hopefully )
import Darcs.Util.Prompt ( askEnter )
import Darcs.Patch.Set ( PatchSet(..), Origin )
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 ( WantGuiPause(..), DiffAlgorithm(..) )

import qualified Darcs.Util.Tree as Tree
import Darcs.Util.Tree.Plain ( writePlainTree, readPlainTree )

--import Darcs.Util.Printer.Color ( traceDoc )
--import Darcs.Util.Printer ( greenText, ($$), Doc )
--import Darcs.Patch ( showPatch )

standardResolution :: (PrimPatchBase p, Conflict p, CommuteNoConflicts p)
                   => FL p wX wY -> Sealed (FL (PrimOf p) wY)
standardResolution :: FL p wX wY -> Sealed (FL (PrimOf p) wY)
standardResolution = [Sealed (FL (PrimOf p) wY)] -> Sealed (FL (PrimOf p) wY)
forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
[Sealed (FL prim wX)] -> Sealed (FL prim wX)
mergeList ([Sealed (FL (PrimOf p) wY)] -> Sealed (FL (PrimOf p) wY))
-> (FL p wX wY -> [Sealed (FL (PrimOf p) wY)])
-> FL p wX wY
-> Sealed (FL (PrimOf p) wY)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Sealed (FL (PrimOf p) wY)] -> Sealed (FL (PrimOf p) wY))
-> [[Sealed (FL (PrimOf p) wY)]] -> [Sealed (FL (PrimOf p) wY)]
forall a b. (a -> b) -> [a] -> [b]
map [Sealed (FL (PrimOf p) wY)] -> Sealed (FL (PrimOf p) wY)
forall a. [a] -> a
head ([[Sealed (FL (PrimOf p) wY)]] -> [Sealed (FL (PrimOf p) wY)])
-> (FL p wX wY -> [[Sealed (FL (PrimOf p) wY)]])
-> FL p wX wY
-> [Sealed (FL (PrimOf p) wY)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FL p wX wY -> [[Sealed (FL (PrimOf p) wY)]]
forall (p :: * -> * -> *) wX wY.
Conflict p =>
p wX wY -> [[Sealed (FL (PrimOf p) wY)]]
resolveConflicts

mergeList :: forall prim wX . PrimPatch prim => [Sealed (FL prim wX)] -> Sealed (FL prim wX)
mergeList :: [Sealed (FL prim wX)] -> Sealed (FL prim wX)
mergeList = FL prim wX wX -> [Sealed (FL prim wX)] -> Sealed (FL prim wX)
forall wY.
FL prim wX wY -> [Sealed (FL prim wX)] -> Sealed (FL prim wX)
doml FL prim wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
    where doml :: FL prim wX wY -> [Sealed (FL prim wX)] -> Sealed (FL prim wX)
          doml :: FL prim wX wY -> [Sealed (FL prim wX)] -> Sealed (FL prim wX)
doml mp :: FL prim wX wY
mp (Sealed p :: FL prim wX wX
p:ps :: [Sealed (FL prim wX)]
ps) =
              case (:>) (FL prim) (FL prim) wX wY
-> Maybe ((:>) (FL prim) (FL prim) wX wY)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (FL prim wX wX -> FL prim wX wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FL prim wX wX
p FL prim wX wX -> FL prim wX wY -> (:>) (FL prim) (FL prim) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL prim wX wY
mp) of
              Just (mp' :: FL prim wX wZ
mp' :> _) -> FL prim wX wZ -> [Sealed (FL prim wX)] -> Sealed (FL prim wX)
forall wY.
FL prim wX wY -> [Sealed (FL prim wX)] -> Sealed (FL prim wX)
doml (FL prim wX wX
p FL prim wX wX -> FL prim wX wZ -> FL prim wX wZ
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL prim wX wZ
mp') [Sealed (FL prim wX)]
ps
              Nothing -> FL prim wX wY -> [Sealed (FL prim wX)] -> Sealed (FL prim wX)
forall wY.
FL prim wX wY -> [Sealed (FL prim wX)] -> Sealed (FL prim wX)
doml FL prim wX wY
mp [Sealed (FL prim wX)]
ps -- This shouldn't happen for "good" resolutions.
          doml mp :: FL prim wX wY
mp [] = FL prim wX wY -> Sealed (FL prim wX)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed FL prim wX wY
mp

externalResolution :: forall p wX wY wZ wA. (RepoPatch p, ApplyState p ~ Tree.Tree)
                   => DiffAlgorithm
                   -> Tree.Tree IO
                   -> String  -- ^ external merge tool command
                   -> WantGuiPause -- ^ tell whether we want GUI pause
                   -> FL (PrimOf p) wX wY
                   -> FL (PrimOf p) wX wZ
                   -> FL p wY wA
                   -> IO (Sealed (FL (PrimOf p) wA))
externalResolution :: 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 diffa :: DiffAlgorithm
diffa s1 :: Tree IO
s1 c :: String
c wantGuiPause :: WantGuiPause
wantGuiPause p1_prim :: FL (PrimOf p) wX wY
p1_prim p2_prim :: FL (PrimOf p) wX wZ
p2_prim pmerged :: FL p wY wA
pmerged = do
 -- TODO: remove the following two once we can rely on GHC 7.2 / superclass equality
 let FL p wX wY
p1 :: FL p wX wY = (forall wW wY. PrimOf p wW wY -> p wW wY)
-> FL (PrimOf p) wX wY -> FL p wX 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. PrimOf p wW wY -> p wW wY
forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PrimOf p wX wY -> p wX wY
fromPrim FL (PrimOf p) wX wY
p1_prim
     FL p wX wZ
p2 :: FL p wX wZ = (forall wW wY. PrimOf p wW wY -> p wW wY)
-> FL (PrimOf p) wX wZ -> FL p wX 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. PrimOf p wW wY -> p wW wY
forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PrimOf p wX wY -> p wX wY
fromPrim FL (PrimOf p) wX wZ
p2_prim
 Tree IO
sa <- FL p wY wX -> Tree IO -> IO (Tree IO)
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, Monad m, ApplyState p ~ Tree) =>
p wX wY -> Tree m -> m (Tree m)
applyToTree (FL p wX wY -> FL p wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FL 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, 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 <- FL p wX wZ -> Tree IO -> IO (Tree IO)
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, Monad m, ApplyState p ~ Tree) =>
p wX wY -> Tree m -> m (Tree m)
applyToTree FL p wX wZ
p2 Tree IO
sa
 let nms :: [String]
nms = FL p wY wA -> [String]
forall (p :: * -> * -> *) wX wY. Conflict p => p wX wY -> [String]
listConflictedFiles FL p wY wA
pmerged
     nas :: [String]
nas = FL p wA wY -> [String] -> [String]
forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
p wX wY -> [String] -> [String]
effectOnFilePaths (FL p wY wA -> FL p wA wY
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FL p wY wA
pmerged) [String]
nms
     n1s :: [String]
n1s = FL p wX wY -> [String] -> [String]
forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
p wX wY -> [String] -> [String]
effectOnFilePaths FL p wX wY
p1 [String]
nas
     n2s :: [String]
n2s = FL p wX wZ -> [String] -> [String]
forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
p wX wY -> [String] -> [String]
effectOnFilePaths FL p wX wZ
p2 [String]
nas
     ns :: [(String, String, String, String)]
ns = [String]
-> [String]
-> [String]
-> [String]
-> [(String, String, String, String)]
forall a b c d. [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
zip4 [String]
nas [String]
n1s [String]
n2s [String]
nms
     write_files :: Tree IO -> [String] -> IO ()
write_files tree :: Tree IO
tree fs :: [String]
fs = Tree IO -> String -> 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 ([String] -> AnchoredPath -> TreeItem IO -> Bool
forall t. [String] -> AnchoredPath -> t -> Bool
filterFilePaths [String]
fs) Tree IO
tree) "."
  in do
   String
former_dir <- IO String
getCurrentDirectory
   String
-> (AbsolutePath -> IO (Sealed (FL (PrimOf p) wA)))
-> IO (Sealed (FL (PrimOf p) wA))
forall a. String -> (AbsolutePath -> IO a) -> IO a
withTempDir "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
$ \absd1 :: AbsolutePath
absd1 -> do
     let d1 :: String
d1 = AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath AbsolutePath
absd1
     Tree IO -> [String] -> IO ()
write_files Tree IO
s1 [String]
n1s
     String -> IO ()
setCurrentDirectory String
former_dir
     String
-> (AbsolutePath -> IO (Sealed (FL (PrimOf p) wA)))
-> IO (Sealed (FL (PrimOf p) wA))
forall a. String -> (AbsolutePath -> IO a) -> IO a
withTempDir "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
$ \absda :: AbsolutePath
absda -> do
       let da :: String
da = AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath AbsolutePath
absda
       Tree IO -> [String] -> IO ()
write_files Tree IO
sa [String]
nas
       String -> IO ()
setCurrentDirectory String
former_dir
       String
-> (AbsolutePath -> IO (Sealed (FL (PrimOf p) wA)))
-> IO (Sealed (FL (PrimOf p) wA))
forall a. String -> (AbsolutePath -> IO a) -> IO a
withTempDir "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
$ \absdm :: AbsolutePath
absdm -> do
         let dm :: String
dm = AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath AbsolutePath
absdm
         Tree IO -> [String] -> IO ()
write_files Tree IO
sm [String]
nms
         String -> IO ()
setCurrentDirectory String
former_dir
         String
-> (AbsolutePath -> IO (Sealed (FL (PrimOf p) wA)))
-> IO (Sealed (FL (PrimOf p) wA))
forall a. String -> (AbsolutePath -> IO a) -> IO a
withTempDir "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
$ \absdc :: AbsolutePath
absdc -> do
           let dc :: String
dc = AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath AbsolutePath
absdc
           String -> String -> IO ()
cloneTree String
dm "."
           String -> IO ()
setCurrentDirectory String
former_dir
           String
-> (AbsolutePath -> IO (Sealed (FL (PrimOf p) wA)))
-> IO (Sealed (FL (PrimOf p) wA))
forall a. String -> (AbsolutePath -> IO a) -> IO a
withTempDir "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
$ \absd2 :: AbsolutePath
absd2 -> do
             let d2 :: String
d2 = AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath AbsolutePath
absd2
             Tree IO -> [String] -> IO ()
write_files Tree IO
s2 [String]
n2s
             ((String, String, String, String) -> IO ())
-> [(String, String, String, String)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String
-> WantGuiPause
-> String
-> String
-> String
-> String
-> (String, String, String, String)
-> IO ()
externallyResolveFile String
c WantGuiPause
wantGuiPause String
da String
d1 String
d2 String
dm) [(String, String, String, String)]
ns
             Tree IO
sc <- String -> IO (Tree IO)
readPlainTree String
dc
             Tree IO
sfixed <- String -> IO (Tree IO)
readPlainTree String
dm
             String -> FileType
ftf <- IO (String -> 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` DiffAlgorithm
-> (String -> FileType)
-> Tree IO
-> Tree IO
-> IO (FreeLeft (FL (PrimOf p)))
forall (m :: * -> *) (w :: (* -> * -> *) -> *)
       (prim :: * -> * -> *).
(Monad m, Gap w, PrimPatch prim) =>
DiffAlgorithm
-> (String -> FileType) -> Tree m -> Tree m -> m (w (FL prim))
treeDiff DiffAlgorithm
diffa String -> 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 :: String
-> WantGuiPause
-> String
-> String
-> String
-> String
-> (String, String, String, String)
-> IO ()
externallyResolveFile c :: String
c wantGuiPause :: WantGuiPause
wantGuiPause da :: String
da d1 :: String
d1 d2 :: String
d2 dm :: String
dm (fa :: String
fa, f1 :: String
f1, f2 :: String
f2, fm :: String
fm) = do
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Merging file "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
fmString -> String -> String
forall a. [a] -> [a] -> [a]
++" by hand."
    ExitCode
ec <- String -> [(Char, String)] -> IO ExitCode
run String
c [('1', String
d1String -> String -> String
</>String
f1), ('2', String
d2String -> String -> String
</>String
f2), ('a', String
daString -> String -> String
</>String
fa), ('o', String
dmString -> String -> String
</>String
fm), ('%', "%")]
    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
$
         String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "External merge command exited with " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExitCode -> String
forall a. Show a => a -> String
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
$
        String -> IO ()
askEnter "Hit return to move on, ^C to abort the whole operation..."

run :: String -> [(Char,String)] -> IO ExitCode
run :: String -> [(Char, String)] -> IO ExitCode
run c :: String
c replacements :: [(Char, String)]
replacements =
    case [(Char, String)] -> String -> Either ParseError ([String], Bool)
parseCmd [(Char, String)]
replacements String
c of
    Left err :: ParseError
err     -> String -> IO ExitCode
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ExitCode) -> String -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
err
    Right (c2 :: [String]
c2,_) -> [String] -> IO ExitCode
rr [String]
c2
    where rr :: [String] -> IO ExitCode
rr (command :: String
command:args :: [String]
args) = do String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Running command '" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                            [String] -> String
unwords (String
commandString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
args) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "'"
                                 String -> [String] -> Redirects -> IO ExitCode
exec String
command [String]
args (Redirect
Null,Redirect
Null,Redirect
Null)
          rr [] = ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess

patchsetConflictResolutions :: RepoPatch p => PatchSet rt p Origin wX -> Sealed (FL (PrimOf p) wX)
patchsetConflictResolutions :: PatchSet rt p Origin wX -> Sealed (FL (PrimOf p) wX)
patchsetConflictResolutions (PatchSet _ NilRL) = FL (PrimOf p) wX wX -> Sealed (FL (PrimOf p) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed FL (PrimOf p) wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
patchsetConflictResolutions (PatchSet _ xs :: RL (PatchInfoAnd rt p) wX wX
xs)
    = --traceDoc (greenText "looking at resolutions" $$
      --         (sh $ resolveConflicts $ joinPatches $
      --              mapFL_FL (patchcontents . hopefully) $ reverseRL xs )) $
      FL p wX wX -> Sealed (FL (PrimOf p) wX)
forall (p :: * -> * -> *) wX wY.
(PrimPatchBase p, Conflict p, CommuteNoConflicts p) =>
FL p wX wY -> Sealed (FL (PrimOf p) wY)
standardResolution (FL p wX wX -> Sealed (FL (PrimOf p) wX))
-> FL p wX wX -> Sealed (FL (PrimOf p) wX)
forall a b. (a -> b) -> a -> b
$ FL (FL p) wX wX -> FL p wX wX
forall (a :: * -> * -> *) wX wZ. FL (FL a) wX wZ -> FL a wX wZ
concatFL (FL (FL p) wX wX -> FL p wX wX) -> FL (FL p) wX wX -> FL p wX wX
forall a b. (a -> b) -> a -> b
$
      (forall wW wY. PatchInfoAnd rt p wW wY -> FL p wW wY)
-> FL (PatchInfoAnd rt p) wX wX -> FL (FL p) wX wX
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) wX wX -> FL (FL p) wX wX)
-> FL (PatchInfoAnd rt p) wX wX -> FL (FL p) wX wX
forall a b. (a -> b) -> a -> b
$ RL (PatchInfoAnd rt p) wX wX -> FL (PatchInfoAnd rt p) wX wX
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL (PatchInfoAnd rt p) wX wX
xs
    --where sh :: [[Sealed (FL Prim)]] -> Doc
    --      sh [] = greenText "no more conflicts"
    --      sh (x:ps) = greenText "one conflict" $$ sh1 x $$ sh ps
    --      sh1 :: [Sealed (FL Prim)] -> Doc
    --      sh1 [] = greenText "end of unravellings"
    --      sh1 (Sealed x:ps) = greenText "one unravelling:" $$ showPatch x $$
    --                          sh1 ps