-- 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 Prelude ()
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 p :: AnchoredPath
p Nothing (Just t :: TreeItem m
t) = (AnchoredPath
p, TreeItem m -> Diff m
forall (m :: * -> *). TreeItem m -> Diff m
Added TreeItem m
t)
getDiff p :: AnchoredPath
p (Just from :: TreeItem m
from) (Just to :: 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 p :: AnchoredPath
p (Just t :: TreeItem m
t) Nothing = (AnchoredPath
p, TreeItem m -> Diff m
forall (m :: * -> *). TreeItem m -> Diff m
Removed TreeItem m
t)
getDiff _ Nothing Nothing = (AnchoredPath, Diff m)
forall a. a
impossible -- 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
-> (FilePath -> FileType) -> Tree m -> Tree m -> m (w (FL prim))
treeDiff da :: DiffAlgorithm
da ft :: FilePath -> FileType
ft t1 :: Tree m
t1 t2 :: Tree m
t2 = do
    (from :: Tree m
from, to :: 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 (p1 :: AnchoredPath
p1, Changed _ _ ) (p2 :: AnchoredPath
p2, Changed _ _) = AnchoredPath -> AnchoredPath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare AnchoredPath
p1 AnchoredPath
p2
    organise (p1 :: AnchoredPath
p1, Added _)      (p2 :: AnchoredPath
p2, Added _)   = AnchoredPath -> AnchoredPath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare AnchoredPath
p1 AnchoredPath
p2
    organise (p1 :: AnchoredPath
p1, Removed _)    (p2 :: AnchoredPath
p2, Removed _) = AnchoredPath -> AnchoredPath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare AnchoredPath
p2 AnchoredPath
p1

    organise (_, Removed _) _ = Ordering
LT
    organise _ (_, Removed _) = Ordering
GT

    organise (_, Changed _ _) _ = Ordering
LT
    organise _ (_, Changed _ _) = Ordering
GT

    diff :: AnchoredPath -> Diff m -> m (w (FL prim))
    diff :: AnchoredPath -> Diff m -> m (w (FL prim))
diff _ (Changed (SubTree _) (SubTree _)) = 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 p :: AnchoredPath
p (Removed (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. FL prim wX wY) -> w (FL prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (FilePath -> prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
FilePath -> prim wX wY
rmdir (FilePath -> AnchoredPath -> FilePath
anchorPath "" 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 p :: AnchoredPath
p (Added (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. FL prim wX wY) -> w (FL prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (FilePath -> prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
FilePath -> prim wX wY
adddir (FilePath -> AnchoredPath -> FilePath
anchorPath "" 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 p :: AnchoredPath
p (Added b' :: TreeItem m
b'@(File _)) =
        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 (FilePath -> prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
FilePath -> prim wX wY
addfile (FilePath -> AnchoredPath -> FilePath
anchorPath "" AnchoredPath
p))) w (FL prim)
diff'
    diff p :: AnchoredPath
p (Removed a' :: TreeItem m
a'@(File _)) =
        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 (FilePath -> prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
FilePath -> prim wX wY
rmfile (FilePath -> AnchoredPath -> FilePath
anchorPath "" 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 p :: AnchoredPath
p (Changed (File a' :: Blob m
a') (File b' :: 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'
           let path :: FilePath
path = FilePath -> AnchoredPath -> FilePath
anchorPath "" AnchoredPath
p
           case FilePath -> FileType
ft FilePath
path of
             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
$ FilePath -> ByteString -> ByteString -> w (FL prim)
forall (w :: (* -> * -> *) -> *) (prim :: * -> * -> *).
(Gap w, Invert prim, PrimCanonize prim, PrimConstruct prim) =>
FilePath -> ByteString -> ByteString -> w (FL prim)
text_diff FilePath
path ByteString
a 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
$ 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 (FilePath -> ByteString -> ByteString -> prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
FilePath -> ByteString -> ByteString -> prim wX wY
binary FilePath
path (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 p :: AnchoredPath
p (Changed a' :: TreeItem m
a'@(File _) subtree :: TreeItem m
subtree@(SubTree _)) =
        do w (FL prim)
rmFileP <- 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)
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 p :: AnchoredPath
p (Changed subtree :: TreeItem m
subtree@(SubTree _) b' :: TreeItem m
b'@(File _)) =
        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 -> 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. 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 p :: AnchoredPath
p _ = FilePath -> m (w (FL prim))
forall a. HasCallStack => FilePath -> a
error (FilePath -> m (w (FL prim))) -> FilePath -> m (w (FL prim))
forall a b. (a -> b) -> a -> b
$ "Missing case at path " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ AnchoredPath -> FilePath
forall a. Show a => a -> FilePath
show AnchoredPath
p

    text_diff :: FilePath -> ByteString -> ByteString -> w (FL prim)
text_diff p :: FilePath
p a :: ByteString
a b :: 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 (FilePath -> ByteString -> FL prim wX wY
forall (prim :: * -> * -> *) wY wX.
(Invert prim, PrimCanonize prim, PrimConstruct prim) =>
FilePath -> ByteString -> FL prim wY wX
diff_from_empty FilePath
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 (FilePath -> ByteString -> FL prim wX wY
forall (prim :: * -> * -> *) wX wY.
(PrimCanonize prim, PrimConstruct prim) =>
FilePath -> ByteString -> FL prim wX wY
diff_to_empty FilePath
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
== '\n' Bool -> Bool -> Bool
&& ByteString -> Char
BLC.last ByteString
b Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\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 (FilePath -> [ByteString] -> [ByteString] -> FL prim wX wY
forall (prim :: * -> * -> *) wX wY.
(PrimCanonize prim, PrimConstruct prim) =>
FilePath -> [ByteString] -> [ByteString] -> FL prim wX wY
line_diff FilePath
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 (FilePath -> [ByteString] -> [ByteString] -> FL prim wX wY
forall (prim :: * -> * -> *) wX wY.
(PrimCanonize prim, PrimConstruct prim) =>
FilePath -> [ByteString] -> [ByteString] -> FL prim wX wY
line_diff FilePath
p (ByteString -> [ByteString]
linesB ByteString
a) (ByteString -> [ByteString]
linesB ByteString
b))

    line_diff :: FilePath -> [ByteString] -> [ByteString] -> FL prim wX wY
line_diff p :: FilePath
p a :: [ByteString]
a b :: [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 (FilePath -> Int -> [ByteString] -> [ByteString] -> prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
FilePath -> Int -> [ByteString] -> [ByteString] -> prim wX wY
hunk FilePath
p 1 [ByteString]
a [ByteString]
b)

    diff_to_empty :: FilePath -> ByteString -> FL prim wX wY
diff_to_empty p :: FilePath
p x :: ByteString
x | ByteString -> Char
BLC.last ByteString
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n' = FilePath -> [ByteString] -> [ByteString] -> FL prim wX wY
forall (prim :: * -> * -> *) wX wY.
(PrimCanonize prim, PrimConstruct prim) =>
FilePath -> [ByteString] -> [ByteString] -> FL prim wX wY
line_diff FilePath
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 = FilePath -> [ByteString] -> [ByteString] -> FL prim wX wY
forall (prim :: * -> * -> *) wX wY.
(PrimCanonize prim, PrimConstruct prim) =>
FilePath -> [ByteString] -> [ByteString] -> FL prim wX wY
line_diff FilePath
p (ByteString -> [ByteString]
linesB ByteString
x) [ByteString
B.empty]

    diff_from_empty :: FilePath -> ByteString -> FL prim wY wX
diff_from_empty p :: FilePath
p x :: ByteString
x = FL prim wX wY -> FL prim wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert (FilePath -> ByteString -> FL prim wX wY
forall (prim :: * -> * -> *) wX wY.
(PrimCanonize prim, PrimConstruct prim) =>
FilePath -> ByteString -> FL prim wX wY
diff_to_empty FilePath
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 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 '\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