--  Copyright (C) 2002-2003 David Roundy, 2010 Ganesh Sittampalam
{-# LANGUAGE ViewPatterns #-}
module Darcs.Patch.Conflict
    ( Conflict(..), CommuteNoConflicts(..), listConflictedFiles
    , IsConflictedPrim(..), ConflictState(..)
    , mangleUnravelled
    ) where

import Prelude ()
import Darcs.Prelude

import qualified Data.ByteString.Char8 as BC (pack, last)
import qualified Data.ByteString       as B (null, ByteString)
import Data.Maybe ( isJust )
import Data.List ( sort, intercalate )
import Data.List.Ordered ( nubSort )

import Darcs.Patch.Effect ( Effect(..) )
import Darcs.Patch.FileHunk ( FileHunk(..), IsHunk, isHunk )
import Darcs.Patch.Inspect ( PatchInspect(..) )
import Darcs.Patch.Invert ( Invert(..) )
import Darcs.Patch.Permutations ()
import Darcs.Patch.Prim ( PrimPatch, is_filepatch, primIsHunk, primFromHunk )
import Darcs.Patch.Prim.Class ( PrimOf )
import Darcs.Patch.Witnesses.Ordered
    ( FL(..), RL(..), (:>)(..)
    , mapFL, reverseFL, mapRL, reverseRL
    )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), unseal, mapSeal )
import Darcs.Patch.Witnesses.Show ( Show2, showsPrec2 )
import Darcs.Util.Path ( FileName, fn2fp, fp2fn )
import Darcs.Util.Show ( appPrec )

listConflictedFiles :: Conflict p => p wX wY -> [FilePath]
listConflictedFiles :: p wX wY -> [FilePath]
listConflictedFiles p :: p wX wY
p =
    [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
nubSort ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Sealed (FL (PrimOf p) wY) -> [FilePath])
-> [Sealed (FL (PrimOf p) wY)] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((forall wX. FL (PrimOf p) wY wX -> [FilePath])
-> Sealed (FL (PrimOf p) wY) -> [FilePath]
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall wX. FL (PrimOf p) wY wX -> [FilePath]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [FilePath]
listTouchedFiles) ([Sealed (FL (PrimOf p) wY)] -> [FilePath])
-> [Sealed (FL (PrimOf p) wY)] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [[Sealed (FL (PrimOf p) wY)]] -> [Sealed (FL (PrimOf p) wY)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[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
$ p wX wY -> [[Sealed (FL (PrimOf p) wY)]]
forall (p :: * -> * -> *) wX wY.
Conflict p =>
p wX wY -> [[Sealed (FL (PrimOf p) wY)]]
resolveConflicts p wX wY
p

class (Effect p, PatchInspect (PrimOf p)) => Conflict p where
    resolveConflicts :: p wX wY -> [[Sealed (FL (PrimOf p) wY)]]

    conflictedEffect :: p wX wY -> [IsConflictedPrim (PrimOf p)]

class CommuteNoConflicts p where
    -- | If 'commuteNoConflicts' @x :> y@ succeeds, we know that that @x@ commutes
    --   past @y@ without any conflicts.   This function is useful for patch types
    --   for which 'commute' is defined to always succeed; so we need some way to
    --   pick out the specific cases where commutation succeeds without any conflicts.
    commuteNoConflicts :: (p :> p) wX wY -> Maybe ((p :> p) wX wY)

instance (CommuteNoConflicts p, Conflict p) => Conflict (FL p) where
    resolveConflicts :: FL p wX wY -> [[Sealed (FL (PrimOf (FL p)) wY)]]
resolveConflicts NilFL = []
    resolveConflicts x :: FL p wX wY
x = RL p wX wY -> [[Sealed (FL (PrimOf (FL p)) wY)]]
forall (p :: * -> * -> *) wX wY.
Conflict p =>
p wX wY -> [[Sealed (FL (PrimOf p) wY)]]
resolveConflicts (RL p wX wY -> [[Sealed (FL (PrimOf (FL p)) wY)]])
-> RL p wX wY -> [[Sealed (FL (PrimOf (FL p)) wY)]]
forall a b. (a -> b) -> a -> b
$ FL p wX wY -> RL p wX wY
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL p wX wY
x
    conflictedEffect :: FL p wX wY -> [IsConflictedPrim (PrimOf (FL p))]
conflictedEffect = [[IsConflictedPrim (PrimOf p)]] -> [IsConflictedPrim (PrimOf p)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[IsConflictedPrim (PrimOf p)]] -> [IsConflictedPrim (PrimOf p)])
-> (FL p wX wY -> [[IsConflictedPrim (PrimOf p)]])
-> FL p wX wY
-> [IsConflictedPrim (PrimOf p)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wW wZ. p wW wZ -> [IsConflictedPrim (PrimOf p)])
-> FL p wX wY -> [[IsConflictedPrim (PrimOf p)]]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall wW wZ. p wW wZ -> [IsConflictedPrim (PrimOf p)]
forall (p :: * -> * -> *) wX wY.
Conflict p =>
p wX wY -> [IsConflictedPrim (PrimOf p)]
conflictedEffect

instance CommuteNoConflicts p => CommuteNoConflicts (FL p) where
    commuteNoConflicts :: (:>) (FL p) (FL p) wX wY -> Maybe ((:>) (FL p) (FL p) wX wY)
commuteNoConflicts (NilFL :> x :: FL p wZ wY
x) = (:>) (FL p) (FL p) wZ wY -> Maybe ((:>) (FL p) (FL p) wZ wY)
forall a. a -> Maybe a
Just (FL p wZ wY
x FL p wZ wY -> FL p wY wY -> (:>) (FL p) (FL p) wZ wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL p wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
    commuteNoConflicts (x :: FL p wX wZ
x :> NilFL) = (:>) (FL p) (FL p) wX wZ -> Maybe ((:>) (FL p) (FL p) wX wZ)
forall a. a -> Maybe a
Just (FL p wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL FL p wX wX -> FL p wX wZ -> (:>) (FL p) (FL p) wX wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL p wX wZ
x)
    commuteNoConflicts (xs :: FL p wX wZ
xs :> ys :: FL p wZ wY
ys) =   do ys' :: FL p wX wZ
ys' :> rxs' :: RL p wZ wY
rxs' <- (:>) (RL p) (FL p) wX wY -> Maybe ((:>) (FL p) (RL p) wX wY)
forall (p :: * -> * -> *) wX wY.
CommuteNoConflicts p =>
(:>) (RL p) (FL p) wX wY -> Maybe ((:>) (FL p) (RL p) wX wY)
commuteNoConflictsRLFL (FL p wX wZ -> RL p wX wZ
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL p wX wZ
xs RL p wX wZ -> FL p wZ wY -> (:>) (RL p) (FL p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL p wZ wY
ys)
                                         (:>) (FL p) (FL p) wX wY -> Maybe ((:>) (FL p) (FL p) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return ((:>) (FL p) (FL p) wX wY -> Maybe ((:>) (FL p) (FL p) wX wY))
-> (:>) (FL p) (FL p) wX wY -> Maybe ((:>) (FL p) (FL p) wX wY)
forall a b. (a -> b) -> a -> b
$ FL p wX wZ
ys' FL p wX wZ -> FL p wZ wY -> (:>) (FL p) (FL p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL p wZ wY -> FL p wZ wY
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL p wZ wY
rxs'

instance (CommuteNoConflicts p, Conflict p) => Conflict (RL p) where
    -- By definition, a conflicting (primitive) patch is resolved if
    -- another (primitive) patch depends on the conflict.
    -- 
    -- So, when looking for conflicts in a list of patches, we go
    -- through the whole list looking for individual patches that are
    -- in conflict. But then we try to commute them past all the
    -- patches we've already seen. If we fail, i.e. there's something
    -- that depends on the conflict, then we forget about the conflict;
    -- this is the Nothing case of the 'commuteNoConflictsFL' call.
    --
    -- Note that 'primitive' does not mean Prim (this is a case of bad
    -- naming) but rather a RepoPatchV1 or RepoPatchV2. Prim patches
    -- are merely a 'base class' containing everything common to V1 and
    -- V2 primitive patches.
    resolveConflicts :: RL p wX wY -> [[Sealed (FL (PrimOf (RL p)) wY)]]
resolveConflicts x :: RL p wX wY
x = RL p wX wY -> FL p wY wY -> [[Sealed (FL (PrimOf p) wY)]]
forall wX wY wW.
RL p wX wY -> FL p wY wW -> [[Sealed (FL (PrimOf p) wW)]]
rcs RL p wX wY
x FL p wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
      where
        rcs :: RL p wX wY -> FL p wY wW -> [[Sealed (FL (PrimOf p) wW)]]
        rcs :: RL p wX wY -> FL p wY wW -> [[Sealed (FL (PrimOf p) wW)]]
rcs NilRL _ = []
        rcs (ps :: RL p wX wY
ps :<: p :: p wY wY
p) passedby :: FL p wY wW
passedby
          | [[Sealed (FL (PrimOf p) wY)]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (p wY wY -> [[Sealed (FL (PrimOf p) wY)]]
forall (p :: * -> * -> *) wX wY.
Conflict p =>
p wX wY -> [[Sealed (FL (PrimOf p) wY)]]
resolveConflicts p wY wY
p) = FL p wY wW
-> [[Sealed (FL (PrimOf p) wW)]] -> [[Sealed (FL (PrimOf p) wW)]]
forall a b. a -> b -> b
seq FL p wY wW
passedby [[Sealed (FL (PrimOf p) wW)]]
rest -- TODO why seq here?
          | Bool
otherwise =
            case (:>) p (FL p) wY wW -> Maybe ((:>) (FL p) p wY wW)
forall (p :: * -> * -> *) wX wY.
CommuteNoConflicts p =>
(:>) p (FL p) wX wY -> Maybe ((:>) (FL p) p wX wY)
commuteNoConflictsFL (p wY wY
p p wY wY -> FL p wY wW -> (:>) p (FL p) wY wW
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL p wY wW
passedby) of
              Just (_ :> p' :: p wZ wW
p') -> p wZ wW -> [[Sealed (FL (PrimOf p) wW)]]
forall (p :: * -> * -> *) wX wY.
Conflict p =>
p wX wY -> [[Sealed (FL (PrimOf p) wY)]]
resolveConflicts p wZ wW
p' [[Sealed (FL (PrimOf p) wW)]]
-> [[Sealed (FL (PrimOf p) wW)]] -> [[Sealed (FL (PrimOf p) wW)]]
forall a. [a] -> [a] -> [a]
++ [[Sealed (FL (PrimOf p) wW)]]
rest
              Nothing -> [[Sealed (FL (PrimOf p) wW)]]
rest
          where
            rest :: [[Sealed (FL (PrimOf p) wW)]]
rest = RL p wX wY -> FL p wY wW -> [[Sealed (FL (PrimOf p) wW)]]
forall wX wY wW.
RL p wX wY -> FL p wY wW -> [[Sealed (FL (PrimOf p) wW)]]
rcs RL p wX wY
ps (p wY wY
p p wY wY -> FL p wY wW -> FL p wY wW
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL p wY wW
passedby)
    conflictedEffect :: RL p wX wY -> [IsConflictedPrim (PrimOf (RL p))]
conflictedEffect = [[IsConflictedPrim (PrimOf p)]] -> [IsConflictedPrim (PrimOf p)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[IsConflictedPrim (PrimOf p)]] -> [IsConflictedPrim (PrimOf p)])
-> (RL p wX wY -> [[IsConflictedPrim (PrimOf p)]])
-> RL p wX wY
-> [IsConflictedPrim (PrimOf p)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[IsConflictedPrim (PrimOf p)]] -> [[IsConflictedPrim (PrimOf p)]]
forall a. [a] -> [a]
reverse ([[IsConflictedPrim (PrimOf p)]]
 -> [[IsConflictedPrim (PrimOf p)]])
-> (RL p wX wY -> [[IsConflictedPrim (PrimOf p)]])
-> RL p wX wY
-> [[IsConflictedPrim (PrimOf p)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wW wZ. p wW wZ -> [IsConflictedPrim (PrimOf p)])
-> RL p wX wY -> [[IsConflictedPrim (PrimOf p)]]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL forall wW wZ. p wW wZ -> [IsConflictedPrim (PrimOf p)]
forall (p :: * -> * -> *) wX wY.
Conflict p =>
p wX wY -> [IsConflictedPrim (PrimOf p)]
conflictedEffect

instance CommuteNoConflicts p => CommuteNoConflicts (RL p) where
    commuteNoConflicts :: (:>) (RL p) (RL p) wX wY -> Maybe ((:>) (RL p) (RL p) wX wY)
commuteNoConflicts (NilRL :> x :: RL p wZ wY
x) = (:>) (RL p) (RL p) wZ wY -> Maybe ((:>) (RL p) (RL p) wZ wY)
forall a. a -> Maybe a
Just (RL p wZ wY
x RL p wZ wY -> RL p wY wY -> (:>) (RL p) (RL p) wZ wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL p wY wY
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL)
    commuteNoConflicts (x :: RL p wX wZ
x :> NilRL) = (:>) (RL p) (RL p) wX wZ -> Maybe ((:>) (RL p) (RL p) wX wZ)
forall a. a -> Maybe a
Just (RL p wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL RL p wX wX -> RL p wX wZ -> (:>) (RL p) (RL p) wX wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL p wX wZ
x)
    commuteNoConflicts (xs :: RL p wX wZ
xs :> ys :: RL p wZ wY
ys) =   do ys' :: FL p wX wZ
ys' :> rxs' :: RL p wZ wY
rxs' <- (:>) (RL p) (FL p) wX wY -> Maybe ((:>) (FL p) (RL p) wX wY)
forall (p :: * -> * -> *) wX wY.
CommuteNoConflicts p =>
(:>) (RL p) (FL p) wX wY -> Maybe ((:>) (FL p) (RL p) wX wY)
commuteNoConflictsRLFL (RL p wX wZ
xs RL p wX wZ -> FL p wZ wY -> (:>) (RL p) (FL p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL p wZ wY -> FL p wZ wY
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL p wZ wY
ys)
                                         (:>) (RL p) (RL p) wX wY -> Maybe ((:>) (RL p) (RL p) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return ((:>) (RL p) (RL p) wX wY -> Maybe ((:>) (RL p) (RL p) wX wY))
-> (:>) (RL p) (RL p) wX wY -> Maybe ((:>) (RL p) (RL p) wX wY)
forall a b. (a -> b) -> a -> b
$ FL p wX wZ -> RL p wX wZ
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL p wX wZ
ys' RL p wX wZ -> RL p wZ wY -> (:>) (RL p) (RL p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL p wZ wY
rxs'

data IsConflictedPrim prim where
    IsC :: !ConflictState -> !(prim wX wY) -> IsConflictedPrim prim
data ConflictState = Okay | Conflicted | Duplicated deriving ( ConflictState -> ConflictState -> Bool
(ConflictState -> ConflictState -> Bool)
-> (ConflictState -> ConflictState -> Bool) -> Eq ConflictState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConflictState -> ConflictState -> Bool
$c/= :: ConflictState -> ConflictState -> Bool
== :: ConflictState -> ConflictState -> Bool
$c== :: ConflictState -> ConflictState -> Bool
Eq, Eq ConflictState
Eq ConflictState =>
(ConflictState -> ConflictState -> Ordering)
-> (ConflictState -> ConflictState -> Bool)
-> (ConflictState -> ConflictState -> Bool)
-> (ConflictState -> ConflictState -> Bool)
-> (ConflictState -> ConflictState -> Bool)
-> (ConflictState -> ConflictState -> ConflictState)
-> (ConflictState -> ConflictState -> ConflictState)
-> Ord ConflictState
ConflictState -> ConflictState -> Bool
ConflictState -> ConflictState -> Ordering
ConflictState -> ConflictState -> ConflictState
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ConflictState -> ConflictState -> ConflictState
$cmin :: ConflictState -> ConflictState -> ConflictState
max :: ConflictState -> ConflictState -> ConflictState
$cmax :: ConflictState -> ConflictState -> ConflictState
>= :: ConflictState -> ConflictState -> Bool
$c>= :: ConflictState -> ConflictState -> Bool
> :: ConflictState -> ConflictState -> Bool
$c> :: ConflictState -> ConflictState -> Bool
<= :: ConflictState -> ConflictState -> Bool
$c<= :: ConflictState -> ConflictState -> Bool
< :: ConflictState -> ConflictState -> Bool
$c< :: ConflictState -> ConflictState -> Bool
compare :: ConflictState -> ConflictState -> Ordering
$ccompare :: ConflictState -> ConflictState -> Ordering
$cp1Ord :: Eq ConflictState
Ord, Int -> ConflictState -> ShowS
[ConflictState] -> ShowS
ConflictState -> FilePath
(Int -> ConflictState -> ShowS)
-> (ConflictState -> FilePath)
-> ([ConflictState] -> ShowS)
-> Show ConflictState
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ConflictState] -> ShowS
$cshowList :: [ConflictState] -> ShowS
show :: ConflictState -> FilePath
$cshow :: ConflictState -> FilePath
showsPrec :: Int -> ConflictState -> ShowS
$cshowsPrec :: Int -> ConflictState -> ShowS
Show, ReadPrec [ConflictState]
ReadPrec ConflictState
Int -> ReadS ConflictState
ReadS [ConflictState]
(Int -> ReadS ConflictState)
-> ReadS [ConflictState]
-> ReadPrec ConflictState
-> ReadPrec [ConflictState]
-> Read ConflictState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConflictState]
$creadListPrec :: ReadPrec [ConflictState]
readPrec :: ReadPrec ConflictState
$creadPrec :: ReadPrec ConflictState
readList :: ReadS [ConflictState]
$creadList :: ReadS [ConflictState]
readsPrec :: Int -> ReadS ConflictState
$creadsPrec :: Int -> ReadS ConflictState
Read)

instance Show2 prim => Show (IsConflictedPrim prim) where
    showsPrec :: Int -> IsConflictedPrim prim -> ShowS
showsPrec d :: Int
d (IsC cs :: ConflictState
cs prim :: prim wX wY
prim) =
        Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
            FilePath -> ShowS
showString "IsC " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ConflictState -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) ConflictState
cs ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            FilePath -> ShowS
showString " " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> prim wX wY -> ShowS
forall (a :: * -> * -> *) wX wY. Show2 a => Int -> a wX wY -> ShowS
showsPrec2 (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) prim wX wY
prim

commuteNoConflictsFL :: CommuteNoConflicts p => (p :> FL p) wX wY -> Maybe ((FL p :> p) wX wY)
commuteNoConflictsFL :: (:>) p (FL p) wX wY -> Maybe ((:>) (FL p) p wX wY)
commuteNoConflictsFL (p :: p wX wZ
p :> NilFL) = (:>) (FL p) p wX wZ -> Maybe ((:>) (FL p) p wX wZ)
forall a. a -> Maybe a
Just (FL p wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL FL p wX wX -> p wX wZ -> (:>) (FL p) p wX wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> p wX wZ
p)
commuteNoConflictsFL (q :: p wX wZ
q :> p :: p wZ wY
p :>: ps :: FL p wY wY
ps) =   do p' :: p wX wZ
p' :> q' :: p wZ wY
q' <- (:>) p p wX wY -> Maybe ((:>) p p wX wY)
forall (p :: * -> * -> *) wX wY.
CommuteNoConflicts p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commuteNoConflicts (p wX wZ
q p wX wZ -> p wZ wY -> (:>) p p wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> p wZ wY
p)
                                            ps' :: FL p wZ wZ
ps' :> q'' :: p wZ wY
q'' <- (:>) p (FL p) wZ wY -> Maybe ((:>) (FL p) p wZ wY)
forall (p :: * -> * -> *) wX wY.
CommuteNoConflicts p =>
(:>) p (FL p) wX wY -> Maybe ((:>) (FL p) p wX wY)
commuteNoConflictsFL (p wZ wY
q' p wZ wY -> FL p wY wY -> (:>) p (FL p) wZ wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL p wY wY
ps)
                                            (:>) (FL p) p wX wY -> Maybe ((:>) (FL p) p wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (p wX wZ
p' p wX wZ -> FL p wZ wZ -> FL p wX wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL p wZ wZ
ps' FL p wX wZ -> p wZ wY -> (:>) (FL p) p wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> p wZ wY
q'')

commuteNoConflictsRL :: CommuteNoConflicts p => (RL p :> p) wX wY -> Maybe ((p :> RL p) wX wY)
commuteNoConflictsRL :: (:>) (RL p) p wX wY -> Maybe ((:>) p (RL p) wX wY)
commuteNoConflictsRL (NilRL :> p :: p wZ wY
p) = (:>) p (RL p) wZ wY -> Maybe ((:>) p (RL p) wZ wY)
forall a. a -> Maybe a
Just (p wZ wY
p p wZ wY -> RL p wY wY -> (:>) p (RL p) wZ wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL p wY wY
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL)
commuteNoConflictsRL (ps :: RL p wX wY
ps :<: p :: p wY wZ
p :> q :: p wZ wY
q) =   do q' :: p wY wZ
q' :> p' :: p wZ wY
p' <- (:>) p p wY wY -> Maybe ((:>) p p wY wY)
forall (p :: * -> * -> *) wX wY.
CommuteNoConflicts p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commuteNoConflicts (p wY wZ
p p wY wZ -> p wZ wY -> (:>) p p wY wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> p wZ wY
q)
                                            q'' :: p wX wZ
q'' :> ps' :: RL p wZ wZ
ps' <- (:>) (RL p) p wX wZ -> Maybe ((:>) p (RL p) wX wZ)
forall (p :: * -> * -> *) wX wY.
CommuteNoConflicts p =>
(:>) (RL p) p wX wY -> Maybe ((:>) p (RL p) wX wY)
commuteNoConflictsRL (RL p wX wY
ps RL p wX wY -> p wY wZ -> (:>) (RL p) p wX wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> p wY wZ
q')
                                            (:>) p (RL p) wX wY -> Maybe ((:>) p (RL p) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (p wX wZ
q'' p wX wZ -> RL p wZ wY -> (:>) p (RL p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL p wZ wZ
ps' RL p wZ wZ -> p wZ wY -> RL p wZ wY
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: p wZ wY
p')

commuteNoConflictsRLFL :: CommuteNoConflicts p => (RL p :> FL p) wX wY -> Maybe ((FL p :> RL p) wX wY)
commuteNoConflictsRLFL :: (:>) (RL p) (FL p) wX wY -> Maybe ((:>) (FL p) (RL p) wX wY)
commuteNoConflictsRLFL (NilRL :> ys :: FL p wZ wY
ys) = (:>) (FL p) (RL p) wZ wY -> Maybe ((:>) (FL p) (RL p) wZ wY)
forall a. a -> Maybe a
Just (FL p wZ wY
ys FL p wZ wY -> RL p wY wY -> (:>) (FL p) (RL p) wZ wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL p wY wY
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL)
commuteNoConflictsRLFL (xs :: RL p wX wZ
xs :> NilFL) = (:>) (FL p) (RL p) wX wZ -> Maybe ((:>) (FL p) (RL p) wX wZ)
forall a. a -> Maybe a
Just (FL p wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL FL p wX wX -> RL p wX wZ -> (:>) (FL p) (RL p) wX wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL p wX wZ
xs)
commuteNoConflictsRLFL (xs :: RL p wX wZ
xs :> y :: p wZ wY
y :>: ys :: FL p wY wY
ys) =   do y' :: p wX wZ
y' :> xs' :: RL p wZ wY
xs' <- (:>) (RL p) p wX wY -> Maybe ((:>) p (RL p) wX wY)
forall (p :: * -> * -> *) wX wY.
CommuteNoConflicts p =>
(:>) (RL p) p wX wY -> Maybe ((:>) p (RL p) wX wY)
commuteNoConflictsRL (RL p wX wZ
xs RL p wX wZ -> p wZ wY -> (:>) (RL p) p wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> p wZ wY
y)
                                               ys' :: FL p wZ wZ
ys' :> xs'' :: RL p wZ wY
xs'' <- (:>) (RL p) (FL p) wZ wY -> Maybe ((:>) (FL p) (RL p) wZ wY)
forall (p :: * -> * -> *) wX wY.
CommuteNoConflicts p =>
(:>) (RL p) (FL p) wX wY -> Maybe ((:>) (FL p) (RL p) wX wY)
commuteNoConflictsRLFL (RL p wZ wY
xs' RL p wZ wY -> FL p wY wY -> (:>) (RL p) (FL p) wZ wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL p wY wY
ys)
                                               (:>) (FL p) (RL p) wX wY -> Maybe ((:>) (FL p) (RL p) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (p wX wZ
y' p wX wZ -> FL p wZ wZ -> FL p wX wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL p wZ wZ
ys' FL p wX wZ -> RL p wZ wY -> (:>) (FL p) (RL p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL p wZ wY
xs'')


applyHunks :: IsHunk prim => [Maybe B.ByteString] -> FL prim wX wY -> [Maybe B.ByteString]
applyHunks :: [Maybe ByteString] -> FL prim wX wY -> [Maybe ByteString]
applyHunks ms :: [Maybe ByteString]
ms ((prim wX wY -> Maybe (FileHunk wX wY)
forall (p :: * -> * -> *) wX wY.
IsHunk p =>
p wX wY -> Maybe (FileHunk wX wY)
isHunk -> Just (FileHunk _ l :: Int
l o :: [ByteString]
o n :: [ByteString]
n)):>:ps :: FL prim wY wY
ps) = [Maybe ByteString] -> FL prim wY wY -> [Maybe ByteString]
forall (prim :: * -> * -> *) wX wY.
IsHunk prim =>
[Maybe ByteString] -> FL prim wX wY -> [Maybe ByteString]
applyHunks (Int -> [Maybe ByteString] -> [Maybe ByteString]
forall t.
(Ord t, Num t, Show t) =>
t -> [Maybe ByteString] -> [Maybe ByteString]
rls Int
l [Maybe ByteString]
ms) FL prim wY wY
ps
    where rls :: t -> [Maybe ByteString] -> [Maybe ByteString]
rls k :: t
k _ | t
k t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<=0 = FilePath -> [Maybe ByteString]
forall a. FilePath -> a
bug (FilePath -> [Maybe ByteString]) -> FilePath -> [Maybe ByteString]
forall a b. (a -> b) -> a -> b
$ "bad hunk: start position <=0 (" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ t -> FilePath
forall a. Show a => a -> FilePath
show t
k FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
          rls 1 mls :: [Maybe ByteString]
mls = (ByteString -> Maybe ByteString)
-> [ByteString] -> [Maybe ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just [ByteString]
n [Maybe ByteString] -> [Maybe ByteString] -> [Maybe ByteString]
forall a. [a] -> [a] -> [a]
++ Int -> [Maybe ByteString] -> [Maybe ByteString]
forall a. Int -> [a] -> [a]
drop ([ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
o) [Maybe ByteString]
mls
          rls i :: t
i (ml :: Maybe ByteString
ml:mls :: [Maybe ByteString]
mls) = Maybe ByteString
ml Maybe ByteString -> [Maybe ByteString] -> [Maybe ByteString]
forall a. a -> [a] -> [a]
: t -> [Maybe ByteString] -> [Maybe ByteString]
rls (t
it -> t -> t
forall a. Num a => a -> a -> a
-1) [Maybe ByteString]
mls
          rls _ [] = FilePath -> [Maybe ByteString]
forall a. FilePath -> a
bug "rls in applyHunks"
applyHunks ms :: [Maybe ByteString]
ms NilFL = [Maybe ByteString]
ms
applyHunks _ (_:>:_) = [Maybe ByteString]
forall a. a
impossible

getAFilename :: PrimPatch prim => [Sealed (FL prim wX)] -> FileName
getAFilename :: [Sealed (FL prim wX)] -> FileName
getAFilename (Sealed ((prim wX wY -> Maybe FileName
forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Maybe FileName
is_filepatch -> Just f :: FileName
f):>:_):_) = FileName
f
getAFilename _ = FilePath -> FileName
fp2fn ""

getOld :: PrimPatch prim => [Maybe B.ByteString] -> [Sealed (FL prim wX)] -> [Maybe B.ByteString]
getOld :: [Maybe ByteString] -> [Sealed (FL prim wX)] -> [Maybe ByteString]
getOld = ([Maybe ByteString] -> Sealed (FL prim wX) -> [Maybe ByteString])
-> [Maybe ByteString]
-> [Sealed (FL prim wX)]
-> [Maybe ByteString]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [Maybe ByteString] -> Sealed (FL prim wX) -> [Maybe ByteString]
forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
[Maybe ByteString] -> Sealed (FL prim wX) -> [Maybe ByteString]
getHunksOld

getHunksOld :: PrimPatch prim => [Maybe B.ByteString] -> Sealed (FL prim wX)
              -> [Maybe B.ByteString]
getHunksOld :: [Maybe ByteString] -> Sealed (FL prim wX) -> [Maybe ByteString]
getHunksOld mls :: [Maybe ByteString]
mls (Sealed ps :: FL prim wX wX
ps) =
    [Maybe ByteString] -> FL prim wX wX -> [Maybe ByteString]
forall (prim :: * -> * -> *) wX wY.
IsHunk prim =>
[Maybe ByteString] -> FL prim wX wY -> [Maybe ByteString]
applyHunks ([Maybe ByteString] -> FL prim wX wX -> [Maybe ByteString]
forall (prim :: * -> * -> *) wX wY.
IsHunk prim =>
[Maybe ByteString] -> FL prim wX wY -> [Maybe ByteString]
applyHunks [Maybe ByteString]
mls FL prim wX wX
ps) (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
ps)

getHunksNew :: IsHunk prim => [Maybe B.ByteString] -> Sealed (FL prim wX)
              -> [Maybe B.ByteString]
getHunksNew :: [Maybe ByteString] -> Sealed (FL prim wX) -> [Maybe ByteString]
getHunksNew mls :: [Maybe ByteString]
mls (Sealed ps :: FL prim wX wX
ps) = [Maybe ByteString] -> FL prim wX wX -> [Maybe ByteString]
forall (prim :: * -> * -> *) wX wY.
IsHunk prim =>
[Maybe ByteString] -> FL prim wX wY -> [Maybe ByteString]
applyHunks [Maybe ByteString]
mls FL prim wX wX
ps

getHunkline :: [[Maybe B.ByteString]] -> Int
getHunkline :: [[Maybe ByteString]] -> Int
getHunkline = Int -> [[Maybe ByteString]] -> Int
ghl 1
    where ghl :: Int -> [[Maybe B.ByteString]] -> Int
          ghl :: Int -> [[Maybe ByteString]] -> Int
ghl n :: Int
n pps :: [[Maybe ByteString]]
pps =
            if ([Maybe ByteString] -> Bool) -> [[Maybe ByteString]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe ByteString -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ByteString -> Bool)
-> ([Maybe ByteString] -> Maybe ByteString)
-> [Maybe ByteString]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe ByteString] -> Maybe ByteString
forall a. [a] -> a
head) [[Maybe ByteString]]
pps
            then Int
n
            else Int -> [[Maybe ByteString]] -> Int
ghl (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) ([[Maybe ByteString]] -> Int) -> [[Maybe ByteString]] -> Int
forall a b. (a -> b) -> a -> b
$ ([Maybe ByteString] -> [Maybe ByteString])
-> [[Maybe ByteString]] -> [[Maybe ByteString]]
forall a b. (a -> b) -> [a] -> [b]
map [Maybe ByteString] -> [Maybe ByteString]
forall a. [a] -> [a]
tail [[Maybe ByteString]]
pps

makeChunk :: Int -> [Maybe B.ByteString] -> [B.ByteString]
makeChunk :: Int -> [Maybe ByteString] -> [ByteString]
makeChunk n :: Int
n mls :: [Maybe ByteString]
mls = [Maybe ByteString] -> [ByteString]
forall a. [Maybe a] -> [a]
pull_chunk ([Maybe ByteString] -> [ByteString])
-> [Maybe ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Int -> [Maybe ByteString] -> [Maybe ByteString]
forall a. Int -> [a] -> [a]
drop (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) [Maybe ByteString]
mls
    where pull_chunk :: [Maybe a] -> [a]
pull_chunk (Just l :: a
l:mls' :: [Maybe a]
mls') = a
l a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [Maybe a] -> [a]
pull_chunk [Maybe a]
mls'
          pull_chunk (Nothing:_) = []
          pull_chunk [] = FilePath -> [a]
forall a. FilePath -> a
bug "should this be [] in pull_chunk?"


mangleUnravelled :: PrimPatch prim => [Sealed (FL prim wX)] -> Sealed (FL prim wX)
mangleUnravelled :: [Sealed (FL prim wX)] -> Sealed (FL prim wX)
mangleUnravelled pss :: [Sealed (FL prim wX)]
pss = if [Sealed (FL prim wX)] -> Bool
forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
[Sealed (FL prim wX)] -> Bool
onlyHunks [Sealed (FL prim wX)]
pss
                        then (prim wX wX -> FL prim wX wX -> FL prim wX wX
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL prim wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL) (forall wX. prim wX wX -> FL prim wX wX)
-> Sealed (prim wX) -> Sealed (FL prim wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
`mapSeal` [Sealed (FL prim wX)] -> Sealed (prim wX)
forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
[Sealed (FL prim wX)] -> Sealed (prim wX)
mangleUnravelledHunks [Sealed (FL prim wX)]
pss
                        else [Sealed (FL prim wX)] -> Sealed (FL prim wX)
forall a. [a] -> a
head [Sealed (FL prim wX)]
pss

onlyHunks :: forall prim wX . PrimPatch prim => [Sealed (FL prim wX)] -> Bool
onlyHunks :: [Sealed (FL prim wX)] -> Bool
onlyHunks [] = Bool
False
onlyHunks pss :: [Sealed (FL prim wX)]
pss = FileName -> FilePath
fn2fp FileName
f FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= "" Bool -> Bool -> Bool
&& (Sealed (FL prim wX) -> Bool) -> [Sealed (FL prim wX)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Sealed (FL prim wX) -> Bool
forall wY. Sealed (FL prim wY) -> Bool
oh [Sealed (FL prim wX)]
pss
    where f :: FileName
f = [Sealed (FL prim wX)] -> FileName
forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
[Sealed (FL prim wX)] -> FileName
getAFilename [Sealed (FL prim wX)]
pss
          oh :: Sealed (FL prim wY) -> Bool
          oh :: Sealed (FL prim wY) -> Bool
oh (Sealed (p :: prim wY wY
p:>:ps :: FL prim wY wX
ps)) = prim wY wY -> Bool
forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsHunk prim wY wY
p Bool -> Bool -> Bool
&&
                                 [FileName -> FilePath
fn2fp FileName
f] [FilePath] -> [FilePath] -> Bool
forall a. Eq a => a -> a -> Bool
== prim wY wY -> [FilePath]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [FilePath]
listTouchedFiles prim wY wY
p Bool -> Bool -> Bool
&&
                                 Sealed (FL prim wY) -> Bool
forall wY. Sealed (FL prim wY) -> Bool
oh (FL prim wY wX -> Sealed (FL prim wY)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed FL prim wY wX
ps)
          oh (Sealed NilFL) = Bool
True

mangleUnravelledHunks :: PrimPatch prim => [Sealed (FL prim wX)] -> Sealed (prim wX)
--mangleUnravelledHunks [[h1],[h2]] = Deal with simple cases handily?
mangleUnravelledHunks :: [Sealed (FL prim wX)] -> Sealed (prim wX)
mangleUnravelledHunks pss :: [Sealed (FL prim wX)]
pss =
        if [[ByteString]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[ByteString]]
nchs then FilePath -> Sealed (prim wX)
forall a. FilePath -> a
bug "mangleUnravelledHunks"
                     else prim wX Any -> Sealed (prim wX)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (FileHunk wX Any -> prim wX Any
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
FileHunk wX wY -> prim wX wY
primFromHunk (FileName -> Int -> [ByteString] -> [ByteString] -> FileHunk wX Any
forall wX wY.
FileName -> Int -> [ByteString] -> [ByteString] -> FileHunk wX wY
FileHunk FileName
filename Int
l [ByteString]
old [ByteString]
new))
    where oldf :: [Maybe ByteString]
oldf = [Maybe ByteString] -> [Sealed (FL prim wX)] -> [Maybe ByteString]
forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
[Maybe ByteString] -> [Sealed (FL prim wX)] -> [Maybe ByteString]
getOld (Maybe ByteString -> [Maybe ByteString]
forall a. a -> [a]
repeat Maybe ByteString
forall a. Maybe a
Nothing) [Sealed (FL prim wX)]
pss
          newfs :: [[Maybe ByteString]]
newfs = (Sealed (FL prim wX) -> [Maybe ByteString])
-> [Sealed (FL prim wX)] -> [[Maybe ByteString]]
forall a b. (a -> b) -> [a] -> [b]
map ([Maybe ByteString] -> Sealed (FL prim wX) -> [Maybe ByteString]
forall (prim :: * -> * -> *) wX.
IsHunk prim =>
[Maybe ByteString] -> Sealed (FL prim wX) -> [Maybe ByteString]
getHunksNew [Maybe ByteString]
oldf) [Sealed (FL prim wX)]
pss
          l :: Int
l = [[Maybe ByteString]] -> Int
getHunkline ([[Maybe ByteString]] -> Int) -> [[Maybe ByteString]] -> Int
forall a b. (a -> b) -> a -> b
$ [Maybe ByteString]
oldf [Maybe ByteString] -> [[Maybe ByteString]] -> [[Maybe ByteString]]
forall a. a -> [a] -> [a]
: [[Maybe ByteString]]
newfs
          nchs :: [[ByteString]]
nchs = [[ByteString]] -> [[ByteString]]
forall a. Ord a => [a] -> [a]
sort ([[ByteString]] -> [[ByteString]])
-> [[ByteString]] -> [[ByteString]]
forall a b. (a -> b) -> a -> b
$ ([Maybe ByteString] -> [ByteString])
-> [[Maybe ByteString]] -> [[ByteString]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [Maybe ByteString] -> [ByteString]
makeChunk Int
l) [[Maybe ByteString]]
newfs
          filename :: FileName
filename = [Sealed (FL prim wX)] -> FileName
forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
[Sealed (FL prim wX)] -> FileName
getAFilename [Sealed (FL prim wX)]
pss
          old :: [ByteString]
old = Int -> [Maybe ByteString] -> [ByteString]
makeChunk Int
l [Maybe ByteString]
oldf
          new :: [ByteString]
new = [ByteString
top] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
old [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString
initial] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString] -> [[ByteString]] -> [ByteString]
forall a. [a] -> [[a]] -> [a]
intercalate [ByteString
middle] [[ByteString]]
nchs [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString
bottom]
          top :: ByteString
top    = FilePath -> ByteString
BC.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ "v v v v v v v" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
eol_c
          initial :: ByteString
initial= FilePath -> ByteString
BC.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ "=============" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
eol_c
          middle :: ByteString
middle = FilePath -> ByteString
BC.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ "*************" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
eol_c
          bottom :: ByteString
bottom = FilePath -> ByteString
BC.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ "^ ^ ^ ^ ^ ^ ^" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
eol_c
          eol_c :: FilePath
eol_c  = if (ByteString -> Bool) -> [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ps :: ByteString
ps -> Bool -> Bool
not (ByteString -> Bool
B.null ByteString
ps) Bool -> Bool -> Bool
&& ByteString -> Char
BC.last ByteString
ps Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\r') [ByteString]
old
                   then "\r"
                   else ""