-- 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.Diff( treeDiff ) where
import Darcs.Witnesses.Ordered ( FL(..), (+>+) )
import Darcs.Witnesses.Sealed ( Gap(..) )
import Darcs.Repository.Prefs ( FileType(..) )
import Darcs.Patch ( Prim, hunk, canonize, binary
                   , addfile, rmfile, adddir, rmdir, invert)

import Storage.Hashed.Tree( diffTrees, zipTrees, TreeItem(..), Tree
                          , readBlob, emptyBlob )
import Storage.Hashed.AnchoredPath( AnchoredPath, anchorPath )

import qualified Data.ByteString.Lazy.Char8 as BLC
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import ByteStringUtils( isFunky )

#include "gadts.h"

treeDiff :: Gap w => (FilePath -> FileType) -> Tree IO -> Tree IO -> IO (w (FL Prim))
treeDiff ft t1 t2 = do
  (from, to) <- diffTrees t1 t2
  diffs <- sequence $ zipTrees diff from to
  return $ foldr (joinGap (+>+)) (emptyGap NilFL) diffs
    where diff :: Gap w
               => AnchoredPath -> Maybe (TreeItem IO) -> Maybe (TreeItem IO)
               -> IO (w (FL Prim))
          diff _ (Just (SubTree _)) (Just (SubTree _)) = return (emptyGap NilFL)
          diff p (Just (SubTree _)) Nothing =
              return $ freeGap (rmdir (anchorPath "" p) :>: NilFL)
          diff p Nothing (Just (SubTree _)) =
              return $ freeGap (adddir (anchorPath "" p) :>: NilFL)
          diff p Nothing b'@(Just (File _)) =
              do diff' <- diff p (Just (File emptyBlob)) b'
                 return $ joinGap (:>:) (freeGap (addfile (anchorPath "" p))) diff'
          diff p a'@(Just (File _)) Nothing =
              do diff' <- diff p a' (Just (File emptyBlob))
                 return $ joinGap (+>+) diff' (freeGap (rmfile (anchorPath "" p) :>: NilFL))
          diff p (Just (File a')) (Just (File b')) =
              do a <- readBlob a'
                 b <- readBlob b'
                 let path = anchorPath "" p
                 case ft path of
                   TextFile | no_bin a && no_bin b ->
                                return $ text_diff path a b
                   _ -> return $ if a /= b
                                    then freeGap (binary path (strict a) (strict b) :>: NilFL)
                                    else emptyGap NilFL
          diff p _ _ = fail $ "Missing case at path " ++ show p
          text_diff p a b
              | BL.null a && BL.null b = emptyGap NilFL
              | BL.null a = freeGap (diff_from_empty p b)
              | BL.null b = freeGap (diff_to_empty p a)
              | otherwise = freeGap (line_diff p (linesB a) (linesB b))
          line_diff p a b = canonize (hunk p 1 a b)
          diff_to_empty p x | BLC.last x == '\n' = line_diff p (init $ linesB x) []
                            | otherwise = line_diff p (linesB x) [BS.empty]
          diff_from_empty p x = invert (diff_to_empty p x)
          no_bin = not . isFunky . strict . BL.take 4096
          linesB = map strict . BLC.split '\n'
          strict = BS.concat . BL.toChunks