-- Copyright (C) 2009 Petr Rockai
--
-- Permission is hereby granted, free of charge, to any person
-- obtaining a copy of this software and associated documentation
-- files (the "Software"), to deal in the Software without
-- restriction, including without limitation the rights to use, copy,
-- modify, merge, publish, distribute, sublicense, and/or sell copies
-- of the Software, and to permit persons to whom the Software is
-- furnished to do so, subject to the following conditions:
--
-- The above copyright notice and this permission notice shall be
-- included in all copies or substantial portions of the Software.
--
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
-- BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
-- ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
-- CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-- SOFTWARE.

-- |
-- Module      : Darcs.Repository.Diff
-- Copyright   : 2009 Petr Rockai
-- License     : MIT
-- Maintainer  : darcs-devel@darcs.net
-- Stability   : experimental
-- Portability : portable

module Darcs.Repository.Diff
    (
      treeDiff
    ) where

import Darcs.Prelude

import qualified Data.ByteString.Lazy.Char8 as BLC
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL

import Data.List ( sortBy )

import Darcs.Util.Tree      ( diffTrees
                            , zipTrees
                            , TreeItem(..)
                            , Tree
                            , readBlob
                            , emptyBlob
                            )
import Darcs.Util.Path( AnchoredPath, anchorPath )


import Darcs.Util.ByteString ( isFunky )
import Darcs.Patch  ( PrimPatch
                    , hunk
                    , canonize
                    , binary
                    , addfile
                    , rmfile
                    , adddir
                    , rmdir
                    , invert
                    )
import Darcs.Repository.Prefs ( FileType(..) )
import Darcs.Patch.Witnesses.Ordered ( FL(..), (+>+) )
import Darcs.Patch.Witnesses.Sealed ( Gap(..) )
import Darcs.Repository.Flags ( DiffAlgorithm(..) )

data Diff m = Added (TreeItem m)
            | Removed (TreeItem m)
            | Changed (TreeItem m) (TreeItem m)


getDiff :: AnchoredPath
        -> Maybe (TreeItem m)
        -> Maybe (TreeItem m)
        -> (AnchoredPath, Diff m)
getDiff :: AnchoredPath
-> Maybe (TreeItem m)
-> Maybe (TreeItem m)
-> (AnchoredPath, Diff m)
getDiff AnchoredPath
p Maybe (TreeItem m)
Nothing (Just TreeItem m
t) = (AnchoredPath
p, TreeItem m -> Diff m
forall (m :: * -> *). TreeItem m -> Diff m
Added TreeItem m
t)
getDiff AnchoredPath
p (Just TreeItem m
from) (Just TreeItem m
to) = (AnchoredPath
p, TreeItem m -> TreeItem m -> Diff m
forall (m :: * -> *). TreeItem m -> TreeItem m -> Diff m
Changed TreeItem m
from TreeItem m
to)
getDiff AnchoredPath
p (Just TreeItem m
t) Maybe (TreeItem m)
Nothing = (AnchoredPath
p, TreeItem m -> Diff m
forall (m :: * -> *). TreeItem m -> Diff m
Removed TreeItem m
t)
getDiff AnchoredPath
_ Maybe (TreeItem m)
Nothing Maybe (TreeItem m)
Nothing = [Char] -> (AnchoredPath, Diff m)
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case" -- zipTrees should never return this


treeDiff :: forall m w prim . (Monad m, Gap w, PrimPatch prim)
         => DiffAlgorithm
         -> (FilePath -> FileType)
         -> Tree m
         -> Tree m
         -> m (w (FL prim))
treeDiff :: DiffAlgorithm
-> ([Char] -> FileType) -> Tree m -> Tree m -> m (w (FL prim))
treeDiff DiffAlgorithm
da [Char] -> FileType
ft Tree m
t1 Tree m
t2 = do
    (Tree m
from, Tree m
to) <- Tree m -> Tree m -> m (Tree m, Tree m)
forall (m :: * -> *).
Monad m =>
Tree m -> Tree m -> m (Tree m, Tree m)
diffTrees Tree m
t1 Tree m
t2
    [w (FL prim)]
diffs <- ((AnchoredPath, Diff m) -> m (w (FL prim)))
-> [(AnchoredPath, Diff m)] -> m [w (FL prim)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((AnchoredPath -> Diff m -> m (w (FL prim)))
-> (AnchoredPath, Diff m) -> m (w (FL prim))
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry AnchoredPath -> Diff m -> m (w (FL prim))
diff) ([(AnchoredPath, Diff m)] -> m [w (FL prim)])
-> [(AnchoredPath, Diff m)] -> m [w (FL prim)]
forall a b. (a -> b) -> a -> b
$ ((AnchoredPath, Diff m) -> (AnchoredPath, Diff m) -> Ordering)
-> [(AnchoredPath, Diff m)] -> [(AnchoredPath, Diff m)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (AnchoredPath, Diff m) -> (AnchoredPath, Diff m) -> Ordering
organise ([(AnchoredPath, Diff m)] -> [(AnchoredPath, Diff m)])
-> [(AnchoredPath, Diff m)] -> [(AnchoredPath, Diff m)]
forall a b. (a -> b) -> a -> b
$ (AnchoredPath
 -> Maybe (TreeItem m)
 -> Maybe (TreeItem m)
 -> (AnchoredPath, Diff m))
-> Tree m -> Tree m -> [(AnchoredPath, Diff m)]
forall (m :: * -> *) a.
(AnchoredPath -> Maybe (TreeItem m) -> Maybe (TreeItem m) -> a)
-> Tree m -> Tree m -> [a]
zipTrees AnchoredPath
-> Maybe (TreeItem m)
-> Maybe (TreeItem m)
-> (AnchoredPath, Diff m)
forall (m :: * -> *).
AnchoredPath
-> Maybe (TreeItem m)
-> Maybe (TreeItem m)
-> (AnchoredPath, Diff m)
getDiff Tree m
from Tree m
to
    w (FL prim) -> m (w (FL prim))
forall (m :: * -> *) a. Monad m => a -> m a
return (w (FL prim) -> m (w (FL prim))) -> w (FL prim) -> m (w (FL prim))
forall a b. (a -> b) -> a -> b
$ (w (FL prim) -> w (FL prim) -> w (FL prim))
-> w (FL prim) -> [w (FL prim)] -> w (FL prim)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((forall wX wY wZ. FL prim wX wY -> FL prim wY wZ -> FL prim wX wZ)
-> w (FL prim) -> w (FL prim) -> w (FL prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *)
       (q :: * -> * -> *) (r :: * -> * -> *).
Gap w =>
(forall wX wY wZ. p wX wY -> q wY wZ -> r wX wZ)
-> w p -> w q -> w r
joinGap forall wX wY wZ. FL prim wX wY -> FL prim wY wZ -> FL prim wX wZ
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
(+>+)) ((forall wX. FL prim wX wX) -> w (FL prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX. p wX wX) -> w p
emptyGap forall wX. FL prim wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL) [w (FL prim)]
diffs
  where
    -- sort into removes, changes, adds, with removes in reverse-path order
    -- and everything else in forward order
    organise :: (AnchoredPath, Diff m) -> (AnchoredPath, Diff m) -> Ordering

    organise :: (AnchoredPath, Diff m) -> (AnchoredPath, Diff m) -> Ordering
organise (AnchoredPath
p1, Changed TreeItem m
_ TreeItem m
_ ) (AnchoredPath
p2, Changed TreeItem m
_ TreeItem m
_) = AnchoredPath -> AnchoredPath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare AnchoredPath
p1 AnchoredPath
p2
    organise (AnchoredPath
p1, Added TreeItem m
_)      (AnchoredPath
p2, Added TreeItem m
_)   = AnchoredPath -> AnchoredPath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare AnchoredPath
p1 AnchoredPath
p2
    organise (AnchoredPath
p1, Removed TreeItem m
_)    (AnchoredPath
p2, Removed TreeItem m
_) = AnchoredPath -> AnchoredPath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare AnchoredPath
p2 AnchoredPath
p1

    organise (AnchoredPath
_, Removed TreeItem m
_) (AnchoredPath, Diff m)
_ = Ordering
LT
    organise (AnchoredPath, Diff m)
_ (AnchoredPath
_, Removed TreeItem m
_) = Ordering
GT

    organise (AnchoredPath
_, Changed TreeItem m
_ TreeItem m
_) (AnchoredPath, Diff m)
_ = Ordering
LT
    organise (AnchoredPath, Diff m)
_ (AnchoredPath
_, Changed TreeItem m
_ TreeItem m
_) = Ordering
GT

    diff :: AnchoredPath -> Diff m -> m (w (FL prim))
    diff :: AnchoredPath -> Diff m -> m (w (FL prim))
diff AnchoredPath
_ (Changed (SubTree Tree m
_) (SubTree Tree m
_)) = w (FL prim) -> m (w (FL prim))
forall (m :: * -> *) a. Monad m => a -> m a
return ((forall wX. FL prim wX wX) -> w (FL prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX. p wX wX) -> w p
emptyGap forall wX. FL prim wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
    diff AnchoredPath
p (Removed (SubTree Tree m
_)) =
        -- Note: With files we first make the file empty before removing it.
        -- But for subtrees this has already been done in previous recursive calls.
        w (FL prim) -> m (w (FL prim))
forall (m :: * -> *) a. Monad m => a -> m a
return (w (FL prim) -> m (w (FL prim))) -> w (FL prim) -> m (w (FL prim))
forall a b. (a -> b) -> a -> b
$ (forall wX wY. FL prim wX wY) -> w (FL prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (AnchoredPath -> prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
AnchoredPath -> prim wX wY
rmdir AnchoredPath
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)
    diff AnchoredPath
p (Added (SubTree Tree m
_)) =
        w (FL prim) -> m (w (FL prim))
forall (m :: * -> *) a. Monad m => a -> m a
return (w (FL prim) -> m (w (FL prim))) -> w (FL prim) -> m (w (FL prim))
forall a b. (a -> b) -> a -> b
$ (forall wX wY. FL prim wX wY) -> w (FL prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (AnchoredPath -> prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
AnchoredPath -> prim wX wY
adddir AnchoredPath
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)
    diff AnchoredPath
p (Added b' :: TreeItem m
b'@(File Blob m
_)) =
        do w (FL prim)
diff' <- AnchoredPath -> Diff m -> m (w (FL prim))
diff AnchoredPath
p (TreeItem m -> TreeItem m -> Diff m
forall (m :: * -> *). TreeItem m -> TreeItem m -> Diff m
Changed (Blob m -> TreeItem m
forall (m :: * -> *). Blob m -> TreeItem m
File Blob m
forall (m :: * -> *). Monad m => Blob m
emptyBlob) TreeItem m
b')
           w (FL prim) -> m (w (FL prim))
forall (m :: * -> *) a. Monad m => a -> m a
return (w (FL prim) -> m (w (FL prim))) -> w (FL prim) -> m (w (FL prim))
forall a b. (a -> b) -> a -> b
$ (forall wX wY wZ. prim wX wY -> FL prim wY wZ -> FL prim wX wZ)
-> w prim -> w (FL prim) -> w (FL prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *)
       (q :: * -> * -> *) (r :: * -> * -> *).
Gap w =>
(forall wX wY wZ. p wX wY -> q wY wZ -> r wX wZ)
-> w p -> w q -> w r
joinGap forall wX wY wZ. prim wX wY -> FL prim wY wZ -> FL prim wX wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
(:>:) ((forall wX wY. prim wX wY) -> w prim
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (AnchoredPath -> prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
AnchoredPath -> prim wX wY
addfile AnchoredPath
p)) w (FL prim)
diff'
    diff AnchoredPath
p (Removed a' :: TreeItem m
a'@(File Blob m
_)) =
        do w (FL prim)
diff' <- AnchoredPath -> Diff m -> m (w (FL prim))
diff AnchoredPath
p (TreeItem m -> TreeItem m -> Diff m
forall (m :: * -> *). TreeItem m -> TreeItem m -> Diff m
Changed TreeItem m
a' (Blob m -> TreeItem m
forall (m :: * -> *). Blob m -> TreeItem m
File Blob m
forall (m :: * -> *). Monad m => Blob m
emptyBlob))
           w (FL prim) -> m (w (FL prim))
forall (m :: * -> *) a. Monad m => a -> m a
return (w (FL prim) -> m (w (FL prim))) -> w (FL prim) -> m (w (FL prim))
forall a b. (a -> b) -> a -> b
$ (forall wX wY wZ. FL prim wX wY -> FL prim wY wZ -> FL prim wX wZ)
-> w (FL prim) -> w (FL prim) -> w (FL prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *)
       (q :: * -> * -> *) (r :: * -> * -> *).
Gap w =>
(forall wX wY wZ. p wX wY -> q wY wZ -> r wX wZ)
-> w p -> w q -> w r
joinGap forall wX wY wZ. FL prim wX wY -> FL prim wY wZ -> FL prim wX wZ
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
(+>+) w (FL prim)
diff' ((forall wX wY. FL prim wX wY) -> w (FL prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (AnchoredPath -> prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
AnchoredPath -> prim wX wY
rmfile AnchoredPath
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))
    diff AnchoredPath
p (Changed (File Blob m
a') (File Blob m
b')) =
        do ByteString
a <- Blob m -> m ByteString
forall (m :: * -> *). Blob m -> m ByteString
readBlob Blob m
a'
           ByteString
b <- Blob m -> m ByteString
forall (m :: * -> *). Blob m -> m ByteString
readBlob Blob m
b'
           case [Char] -> FileType
ft ([Char] -> AnchoredPath -> [Char]
anchorPath [Char]
"" AnchoredPath
p) of
             FileType
TextFile | ByteString -> Bool
no_bin ByteString
a Bool -> Bool -> Bool
&& ByteString -> Bool
no_bin ByteString
b ->
                          w (FL prim) -> m (w (FL prim))
forall (m :: * -> *) a. Monad m => a -> m a
return (w (FL prim) -> m (w (FL prim))) -> w (FL prim) -> m (w (FL prim))
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> ByteString -> ByteString -> w (FL prim)
forall (w :: (* -> * -> *) -> *) (prim :: * -> * -> *).
(Gap w, Invert prim, PrimCanonize prim, PrimConstruct prim) =>
AnchoredPath -> ByteString -> ByteString -> w (FL prim)
text_diff AnchoredPath
p ByteString
a ByteString
b
             FileType
_ -> w (FL prim) -> m (w (FL prim))
forall (m :: * -> *) a. Monad m => a -> m a
return (w (FL prim) -> m (w (FL prim))) -> w (FL prim) -> m (w (FL prim))
forall a b. (a -> b) -> a -> b
$ if ByteString
a ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
b
                              then (forall wX wY. FL prim wX wY) -> w (FL prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (AnchoredPath -> ByteString -> ByteString -> prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
AnchoredPath -> ByteString -> ByteString -> prim wX wY
binary AnchoredPath
p (ByteString -> ByteString
strict ByteString
a) (ByteString -> ByteString
strict ByteString
b) 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)
                              else (forall wX. FL prim wX wX) -> w (FL prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX. p wX wX) -> w p
emptyGap forall wX. FL prim wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
    diff AnchoredPath
p (Changed a' :: TreeItem m
a'@(File Blob m
_) subtree :: TreeItem m
subtree@(SubTree Tree m
_)) =
        do w (FL prim)
rmFileP <- AnchoredPath -> Diff m -> m (w (FL prim))
diff AnchoredPath
p (TreeItem m -> Diff m
forall (m :: * -> *). TreeItem m -> Diff m
Removed TreeItem m
a')
           w (FL prim)
addDirP <- AnchoredPath -> Diff m -> m (w (FL prim))
diff AnchoredPath
p (TreeItem m -> Diff m
forall (m :: * -> *). TreeItem m -> Diff m
Added TreeItem m
subtree)
           w (FL prim) -> m (w (FL prim))
forall (m :: * -> *) a. Monad m => a -> m a
return (w (FL prim) -> m (w (FL prim))) -> w (FL prim) -> m (w (FL prim))
forall a b. (a -> b) -> a -> b
$ (forall wX wY wZ. FL prim wX wY -> FL prim wY wZ -> FL prim wX wZ)
-> w (FL prim) -> w (FL prim) -> w (FL prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *)
       (q :: * -> * -> *) (r :: * -> * -> *).
Gap w =>
(forall wX wY wZ. p wX wY -> q wY wZ -> r wX wZ)
-> w p -> w q -> w r
joinGap forall wX wY wZ. FL prim wX wY -> FL prim wY wZ -> FL prim wX wZ
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
(+>+) w (FL prim)
rmFileP w (FL prim)
addDirP
    diff AnchoredPath
p (Changed subtree :: TreeItem m
subtree@(SubTree Tree m
_) b' :: TreeItem m
b'@(File Blob m
_)) =
        do w (FL prim)
rmDirP <- AnchoredPath -> Diff m -> m (w (FL prim))
diff AnchoredPath
p (TreeItem m -> Diff m
forall (m :: * -> *). TreeItem m -> Diff m
Removed TreeItem m
subtree)
           w (FL prim)
addFileP <- AnchoredPath -> Diff m -> m (w (FL prim))
diff AnchoredPath
p (TreeItem m -> Diff m
forall (m :: * -> *). TreeItem m -> Diff m
Added TreeItem m
b')
           w (FL prim) -> m (w (FL prim))
forall (m :: * -> *) a. Monad m => a -> m a
return (w (FL prim) -> m (w (FL prim))) -> w (FL prim) -> m (w (FL prim))
forall a b. (a -> b) -> a -> b
$ (forall wX wY wZ. FL prim wX wY -> FL prim wY wZ -> FL prim wX wZ)
-> w (FL prim) -> w (FL prim) -> w (FL prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *)
       (q :: * -> * -> *) (r :: * -> * -> *).
Gap w =>
(forall wX wY wZ. p wX wY -> q wY wZ -> r wX wZ)
-> w p -> w q -> w r
joinGap forall wX wY wZ. FL prim wX wY -> FL prim wY wZ -> FL prim wX wZ
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
(+>+) w (FL prim)
rmDirP w (FL prim)
addFileP
    diff AnchoredPath
p Diff m
_ = [Char] -> m (w (FL prim))
forall a. HasCallStack => [Char] -> a
error ([Char] -> m (w (FL prim))) -> [Char] -> m (w (FL prim))
forall a b. (a -> b) -> a -> b
$ [Char]
"Missing case at path " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show ([Char] -> AnchoredPath -> [Char]
anchorPath [Char]
"" AnchoredPath
p)

    text_diff :: AnchoredPath -> ByteString -> ByteString -> w (FL prim)
text_diff AnchoredPath
p ByteString
a ByteString
b
        | ByteString -> Bool
BL.null ByteString
a Bool -> Bool -> Bool
&& ByteString -> Bool
BL.null ByteString
b = (forall wX. FL prim wX wX) -> w (FL prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX. p wX wX) -> w p
emptyGap forall wX. FL prim wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
        | ByteString -> Bool
BL.null ByteString
a = (forall wX wY. FL prim wX wY) -> w (FL prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (AnchoredPath -> ByteString -> FL prim wX wY
forall (prim :: * -> * -> *) wY wX.
(Invert prim, PrimCanonize prim, PrimConstruct prim) =>
AnchoredPath -> ByteString -> FL prim wY wX
diff_from_empty AnchoredPath
p ByteString
b)
        | ByteString -> Bool
BL.null ByteString
b = (forall wX wY. FL prim wX wY) -> w (FL prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (AnchoredPath -> ByteString -> FL prim wX wY
forall (prim :: * -> * -> *) wX wY.
(PrimCanonize prim, PrimConstruct prim) =>
AnchoredPath -> ByteString -> FL prim wX wY
diff_to_empty AnchoredPath
p ByteString
a)

        -- What is 'a line'? One view is that a line is something that is
        -- /terminated/ by either a newline or end of file. Another view is
        -- that lines are /separated/ by newline symbols.
        --
        -- The first view is the more "intuitive" one. The second is more
        -- "technical", it has the simpler definition and the highly desirable
        -- property that splitting a text into lines and joining them with
        -- newline symbols are inverse operations. The last point is the reason
        -- we never use the standard versions of 'unlines' for ByteString
        -- anywhere in darcs.
        --
        -- The two views differ mostly when enumerating the lines of a file
        -- that ends with a newline symbol: here, the technical view counts one
        -- more (empty) line. This leads to un-intuitive (though technically
        -- not incorrect) results when calculating the diff for a change that
        -- appends an empty line to a file that already has a newline at the
        -- end. For instance, for a file with a single, newline-terminated line
        -- of text, the LCS algorithm would tell us that a *third* (empty) line
        -- is being added.
        --
        -- To avoid this, we add a special case here: we strip off common
        -- newline symbols at the end. When we later split the result into
        -- lines for the diff algorithm, it never gets to see the empty
        -- last lines in both files and thus gives us the more intuitive result.

        | ByteString -> Char
BLC.last ByteString
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
&& ByteString -> Char
BLC.last ByteString
b Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'
                    = (forall wX wY. FL prim wX wY) -> w (FL prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (AnchoredPath -> [ByteString] -> [ByteString] -> FL prim wX wY
forall (prim :: * -> * -> *) wX wY.
(PrimCanonize prim, PrimConstruct prim) =>
AnchoredPath -> [ByteString] -> [ByteString] -> FL prim wX wY
line_diff AnchoredPath
p (ByteString -> [ByteString]
linesB (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BLC.init ByteString
a) (ByteString -> [ByteString]
linesB (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BLC.init ByteString
b))
        | Bool
otherwise = (forall wX wY. FL prim wX wY) -> w (FL prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (AnchoredPath -> [ByteString] -> [ByteString] -> FL prim wX wY
forall (prim :: * -> * -> *) wX wY.
(PrimCanonize prim, PrimConstruct prim) =>
AnchoredPath -> [ByteString] -> [ByteString] -> FL prim wX wY
line_diff AnchoredPath
p (ByteString -> [ByteString]
linesB ByteString
a) (ByteString -> [ByteString]
linesB ByteString
b))

    line_diff :: AnchoredPath -> [ByteString] -> [ByteString] -> FL prim wX wY
line_diff AnchoredPath
p [ByteString]
a [ByteString]
b = DiffAlgorithm -> prim wX wY -> FL prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimCanonize prim =>
DiffAlgorithm -> prim wX wY -> FL prim wX wY
canonize DiffAlgorithm
da (AnchoredPath -> Int -> [ByteString] -> [ByteString] -> prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
AnchoredPath -> Int -> [ByteString] -> [ByteString] -> prim wX wY
hunk AnchoredPath
p Int
1 [ByteString]
a [ByteString]
b)

    diff_to_empty :: AnchoredPath -> ByteString -> FL prim wX wY
diff_to_empty AnchoredPath
p ByteString
x | ByteString -> Char
BLC.last ByteString
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' = AnchoredPath -> [ByteString] -> [ByteString] -> FL prim wX wY
forall (prim :: * -> * -> *) wX wY.
(PrimCanonize prim, PrimConstruct prim) =>
AnchoredPath -> [ByteString] -> [ByteString] -> FL prim wX wY
line_diff AnchoredPath
p ([ByteString] -> [ByteString]
forall a. [a] -> [a]
init ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
linesB ByteString
x) []
                      | Bool
otherwise = AnchoredPath -> [ByteString] -> [ByteString] -> FL prim wX wY
forall (prim :: * -> * -> *) wX wY.
(PrimCanonize prim, PrimConstruct prim) =>
AnchoredPath -> [ByteString] -> [ByteString] -> FL prim wX wY
line_diff AnchoredPath
p (ByteString -> [ByteString]
linesB ByteString
x) [ByteString
B.empty]

    diff_from_empty :: AnchoredPath -> ByteString -> FL prim wY wX
diff_from_empty AnchoredPath
p ByteString
x = FL prim wX wY -> FL prim wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert (AnchoredPath -> ByteString -> FL prim wX wY
forall (prim :: * -> * -> *) wX wY.
(PrimCanonize prim, PrimConstruct prim) =>
AnchoredPath -> ByteString -> FL prim wX wY
diff_to_empty AnchoredPath
p ByteString
x)

    no_bin :: ByteString -> Bool
no_bin = Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
isFunky (ByteString -> Bool)
-> (ByteString -> ByteString) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
strict (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ByteString -> ByteString
BL.take Int64
4096

    linesB :: ByteString -> [ByteString]
linesB = (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
strict ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> [ByteString]
BLC.split Char
'\n'

    strict :: ByteString -> ByteString
strict = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks