{-# LANGUAGE ViewPatterns #-}
module Darcs.Patch.Prim.Canonize ( canonizeFL ) where

import Darcs.Prelude

import qualified Data.ByteString as B (ByteString, empty)

import Darcs.Patch.FileHunk ( FileHunk(..), IsHunk(..) )
import Darcs.Patch.Prim.Class
    ( PrimConstruct(primFromHunk)
    , PrimCoalesce(sortCoalesceFL)
    )
import Darcs.Patch.Witnesses.Ordered ( FL(..), joinGapsFL, mapFL_FL, concatFL )
import Darcs.Patch.Witnesses.Sealed ( unseal, Gap(..), unFreeLeft )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoercePEnd )
import Darcs.Util.Diff ( DiffAlgorithm, getChanges )

canonizeHunk :: Gap w => DiffAlgorithm -> FileHunk oid wX wY -> w (FL (FileHunk oid))
canonizeHunk :: forall (w :: (* -> * -> *) -> *) oid wX wY.
Gap w =>
DiffAlgorithm -> FileHunk oid wX wY -> w (FL (FileHunk oid))
canonizeHunk DiffAlgorithm
_ (FileHunk oid
f Int
line [ByteString]
old [ByteString]
new)
  | [ByteString] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
old Bool -> Bool -> Bool
|| [ByteString] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
new Bool -> Bool -> Bool
|| [ByteString]
old [ByteString] -> [ByteString] -> Bool
forall a. Eq a => a -> a -> Bool
== [ByteString
B.empty] Bool -> Bool -> Bool
|| [ByteString]
new [ByteString] -> [ByteString] -> Bool
forall a. Eq a => a -> a -> Bool
== [ByteString
B.empty] =
      (forall wX wY. FL (FileHunk oid) wX wY) -> w (FL (FileHunk oid))
forall (p :: * -> * -> *). (forall wX wY. p wX wY) -> w p
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (oid -> Int -> [ByteString] -> [ByteString] -> FileHunk oid wX wY
forall oid wX wY.
oid -> Int -> [ByteString] -> [ByteString] -> FileHunk oid wX wY
FileHunk oid
f Int
line [ByteString]
old [ByteString]
new FileHunk oid wX wY
-> FL (FileHunk oid) wY wY -> FL (FileHunk oid) wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (FileHunk oid) wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
canonizeHunk DiffAlgorithm
da (FileHunk oid
f Int
line [ByteString]
old [ByteString]
new) =
  oid
-> Int
-> [(Int, [ByteString], [ByteString])]
-> w (FL (FileHunk oid))
forall (w :: (* -> * -> *) -> *) oid.
Gap w =>
oid
-> Int
-> [(Int, [ByteString], [ByteString])]
-> w (FL (FileHunk oid))
makeHoley oid
f Int
line ([(Int, [ByteString], [ByteString])] -> w (FL (FileHunk oid)))
-> [(Int, [ByteString], [ByteString])] -> w (FL (FileHunk oid))
forall a b. (a -> b) -> a -> b
$ DiffAlgorithm
-> [ByteString]
-> [ByteString]
-> [(Int, [ByteString], [ByteString])]
getChanges DiffAlgorithm
da [ByteString]
old [ByteString]
new

makeHoley :: Gap w
          => oid
          -> Int
          -> [(Int, [B.ByteString], [B.ByteString])]
          -> w (FL (FileHunk oid))
makeHoley :: forall (w :: (* -> * -> *) -> *) oid.
Gap w =>
oid
-> Int
-> [(Int, [ByteString], [ByteString])]
-> w (FL (FileHunk oid))
makeHoley oid
f Int
line =
  [w (FileHunk oid)] -> w (FL (FileHunk oid))
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
[w p] -> w (FL p)
joinGapsFL ([w (FileHunk oid)] -> w (FL (FileHunk oid)))
-> ([(Int, [ByteString], [ByteString])] -> [w (FileHunk oid)])
-> [(Int, [ByteString], [ByteString])]
-> w (FL (FileHunk oid))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, [ByteString], [ByteString]) -> w (FileHunk oid))
-> [(Int, [ByteString], [ByteString])] -> [w (FileHunk oid)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
l, [ByteString]
o, [ByteString]
n) -> (forall wX wY. FileHunk oid wX wY) -> w (FileHunk oid)
forall (p :: * -> * -> *). (forall wX wY. p wX wY) -> w p
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (oid -> Int -> [ByteString] -> [ByteString] -> FileHunk oid wX wY
forall oid wX wY.
oid -> Int -> [ByteString] -> [ByteString] -> FileHunk oid wX wY
FileHunk oid
f (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
line) [ByteString]
o [ByteString]
n))

-- | It can sometimes be handy to have a canonical representation of a given
-- patch.  We achieve this by defining a canonical form for each patch type,
-- and a function 'canonize' which takes a patch and puts it into
-- canonical form.  This routine is used by the diff function to create an
-- optimal patch (based on an LCS algorithm) from a simple hunk describing the
-- old and new version of a file.
canonize :: (IsHunk prim, PrimConstruct prim)
         => DiffAlgorithm -> prim wX wY -> FL prim wX wY
canonize :: forall (prim :: * -> * -> *) wX wY.
(IsHunk prim, PrimConstruct prim) =>
DiffAlgorithm -> prim wX wY -> FL prim wX wY
canonize DiffAlgorithm
da prim wX wY
p | Just FileHunk (ObjectIdOfPatch prim) wX wY
fh <- prim wX wY -> Maybe (FileHunk (ObjectIdOfPatch prim) wX wY)
forall wX wY.
prim wX wY -> Maybe (FileHunk (ObjectIdOfPatch prim) wX wY)
forall (p :: * -> * -> *) wX wY.
IsHunk p =>
p wX wY -> Maybe (FileHunk (ObjectIdOfPatch p) wX wY)
isHunk prim wX wY
p =
  (forall wW wY. FileHunk (ObjectIdOfPatch prim) wW wY -> prim wW wY)
-> FL (FileHunk (ObjectIdOfPatch prim)) wX wY -> FL prim 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 FileHunk (ObjectIdOfPatch prim) wW wY -> prim wW wY
forall wW wY. FileHunk (ObjectIdOfPatch prim) wW wY -> prim wW wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
FileHunk (ObjectIdOfPatch prim) wX wY -> prim wX wY
primFromHunk (FL (FileHunk (ObjectIdOfPatch prim)) wX wY -> FL prim wX wY)
-> FL (FileHunk (ObjectIdOfPatch prim)) wX wY -> FL prim wX wY
forall a b. (a -> b) -> a -> b
$ (forall wX.
 FL (FileHunk (ObjectIdOfPatch prim)) wX wX
 -> FL (FileHunk (ObjectIdOfPatch prim)) wX wY)
-> Sealed (FL (FileHunk (ObjectIdOfPatch prim)) wX)
-> FL (FileHunk (ObjectIdOfPatch prim)) wX wY
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal FL (FileHunk (ObjectIdOfPatch prim)) wX wX
-> FL (FileHunk (ObjectIdOfPatch prim)) wX wY
forall wX.
FL (FileHunk (ObjectIdOfPatch prim)) wX wX
-> FL (FileHunk (ObjectIdOfPatch prim)) wX wY
forall (a :: * -> * -> *) wX wY1 wY2. a wX wY1 -> a wX wY2
unsafeCoercePEnd (Sealed (FL (FileHunk (ObjectIdOfPatch prim)) wX)
 -> FL (FileHunk (ObjectIdOfPatch prim)) wX wY)
-> Sealed (FL (FileHunk (ObjectIdOfPatch prim)) wX)
-> FL (FileHunk (ObjectIdOfPatch prim)) wX wY
forall a b. (a -> b) -> a -> b
$ FreeLeft (FL (FileHunk (ObjectIdOfPatch prim)))
-> Sealed (FL (FileHunk (ObjectIdOfPatch prim)) wX)
forall (p :: * -> * -> *) wX. FreeLeft p -> Sealed (p wX)
unFreeLeft (FreeLeft (FL (FileHunk (ObjectIdOfPatch prim)))
 -> Sealed (FL (FileHunk (ObjectIdOfPatch prim)) wX))
-> FreeLeft (FL (FileHunk (ObjectIdOfPatch prim)))
-> Sealed (FL (FileHunk (ObjectIdOfPatch prim)) wX)
forall a b. (a -> b) -> a -> b
$ DiffAlgorithm
-> FileHunk (ObjectIdOfPatch prim) wX wY
-> FreeLeft (FL (FileHunk (ObjectIdOfPatch prim)))
forall (w :: (* -> * -> *) -> *) oid wX wY.
Gap w =>
DiffAlgorithm -> FileHunk oid wX wY -> w (FL (FileHunk oid))
canonizeHunk DiffAlgorithm
da FileHunk (ObjectIdOfPatch prim) wX wY
fh
canonize DiffAlgorithm
_ prim wX wY
p = prim wX wY
p prim wX wY -> FL prim wY wY -> FL prim wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL prim wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL

-- | Put a sequence of primitive patches into canonical form.
--
-- Even if the patches are just hunk patches,
-- this is not necessarily the same set of results as you would get
-- if you applied the sequence to a specific tree and recalculated
-- a diff.
--
-- XXX Why not? How does it differ? The implementation for Prim.V1 does
-- sortCoalesceFL and then invokes the diff algorithm for each hunk. How can
-- that be any different to applying the sequence and then taking the diff?
-- Is this merely because diff does not sort by file path?
--
-- Besides, diff and apply /must/ be inverses in the sense that for any two
-- states {start, end}, we have
--
-- prop> diff start (apply (diff start end)) == end
canonizeFL :: (IsHunk prim, PrimCoalesce prim, PrimConstruct prim)
           => DiffAlgorithm -> FL prim wX wY -> FL prim wX wY
-- Note: it is important to first coalesce and then canonize, since
-- coalescing can produce non-canonical hunks (while hunks resulting
-- from canonizing a single hunk cannot be coalesced). See issue525,
-- in particular msg20270 for details.
canonizeFL :: forall (prim :: * -> * -> *) wX wY.
(IsHunk prim, PrimCoalesce prim, PrimConstruct prim) =>
DiffAlgorithm -> FL prim wX wY -> FL prim wX wY
canonizeFL DiffAlgorithm
da = FL (FL prim) wX wY -> FL prim wX wY
forall (a :: * -> * -> *) wX wZ. FL (FL a) wX wZ -> FL a wX wZ
concatFL (FL (FL prim) wX wY -> FL prim wX wY)
-> (FL prim wX wY -> FL (FL prim) wX wY)
-> FL prim wX wY
-> FL prim wX wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wW wY. prim wW wY -> FL prim wW wY)
-> FL prim wX wY -> FL (FL prim) 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 (DiffAlgorithm -> prim wW wY -> FL prim wW wY
forall (prim :: * -> * -> *) wX wY.
(IsHunk prim, PrimConstruct prim) =>
DiffAlgorithm -> prim wX wY -> FL prim wX wY
canonize DiffAlgorithm
da) (FL prim wX wY -> FL (FL prim) wX wY)
-> (FL prim wX wY -> FL prim wX wY)
-> FL prim wX wY
-> FL (FL prim) wX wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FL prim wX wY -> FL prim wX wY
forall wX wY. FL prim wX wY -> FL prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimCoalesce prim =>
FL prim wX wY -> FL prim wX wY
sortCoalesceFL