    -- 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.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( is_funky )

    #include "gadts.h"

    treeDiff :: (FilePath -> FileType) -> Tree IO -> Tree IO -> IO (FL Prim C(x y))
    #ifdef GADT_WITNESSES
    treeDiff = undefined -- Sigh.
    #else
    treeDiff ft t1 t2 = do
      (from, to) <- diffTrees t1 t2
      diffs <- sequence $ zipTrees diff from to
      return $ foldr (+>+) NilFL diffs
        where diff :: AnchoredPath -> Maybe (TreeItem IO) -> Maybe (TreeItem IO)
                   -> IO (FL Prim)
              diff _ (Just (SubTree _)) (Just (SubTree _)) = return NilFL
              diff p (Just (SubTree _)) Nothing =
                  return $ rmdir (anchorPath "" p) :>: NilFL
              diff p Nothing (Just (SubTree _)) =
                  return $ adddir (anchorPath "" p) :>: NilFL
              diff p Nothing b'@(Just (File _)) =
                  do diff' <- diff p (Just (File emptyBlob)) b'
                     return $ addfile (anchorPath "" p) :>: diff'
              diff p a'@(Just (File _)) Nothing =
                  do diff' <- diff p a' (Just (File emptyBlob))
                     return $ diff' +>+ (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 binary path (strict a) (strict b) :>: NilFL
                                        else NilFL
              diff p _ _ = fail $ "Missing case at path " ++ show p
              text_diff p a b
                  | BL.null a && BL.null b = NilFL
                  | BL.null a = diff_from_empty p b
                  | BL.null b = diff_to_empty p a
                  | otherwise = 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 . is_funky . strict . BL.take 4096
              linesB = map strict . BLC.split '\n'
              strict = BS.concat . BL.toChunks
    #endif