%  Copyright (C) 2002-2003 David Roundy
%
%  This program is free software; you can redistribute it and/or modify
%  it under the terms of the GNU General Public License as published by
%  the Free Software Foundation; either version 2, or (at your option)
%  any later version.
%
%  This program is distributed in the hope that it will be useful,
%  but WITHOUT ANY WARRANTY; without even the implied warranty of
%  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%  GNU General Public License for more details.
%
%  You should have received a copy of the GNU General Public License
%  along with this program; if not, write to the Free Software Foundation,
%  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
\chapter{Diff}

\begin{code}
module Diff ( smart_diff, sync, cmp ) where

import System.Posix
     ( setFileTimes, epochTime )
import IO ( IOMode(ReadMode), hFileSize, hClose )
import Directory ( doesDirectoryExist, doesFileExist,
                   getDirectoryContents,
                 )
import Monad ( liftM, when )
import List ( sort )
import Maybe ( catMaybes )

import AntiMemo ( readAntiMemo )
import FastPackedString ( PackedString, hGetPS, lengthPS, is_funky, nilPS,
                          unlinesPS, nullPS, lastPS,
                        )
import SlurpDirectory ( Slurpy, FileContents, slurp_name, is_dir, is_file,
                        get_dircontents, get_filecontents,
                        get_mtime, get_length,
                        undefined_time, undefined_size,
                      )
import Patch ( Patch, hunk, canonize, join_patches, reorder_and_coalesce,
               submerge_in_dir, flatten, rmfile, rmdir,
               addfile, adddir,
               binary, invert,
             )
import System.IO ( openBinaryFile )
import RepoPrefs ( FileType(..) )
import DarcsFlags ( DarcsFlag(IgnoreTimes,LookForAdds,All) )
import DarcsUtils ( catchall )
#include "impossible.h"
\end{code}

The diff function takes a recursive diff of two slurped-up directory trees.
The code involved is actually pretty trivial.  \verb!paranoid_diff! runs a
diff in which we don't make the assumption that files with the same
modification time are identical.

\begin{code}
smart_diff :: [DarcsFlag]
           -> (FilePath -> FileType) -> Slurpy -> Slurpy -> Maybe Patch
smart_diff opts = gendiff (IgnoreTimes `elem` opts,
                           LookForAdds `elem` opts,
                           All `elem` opts)

gendiff :: (Bool,Bool,Bool)
        -> (FilePath -> FileType) -> Slurpy -> Slurpy -> Maybe Patch
gendiff opts@(isparanoid,_,nosort) wt s1 s2
    | is_file s1 && is_file s2 && maybe_differ =
          case wt n2 of
          TextFile -> diff_files n2 fc1 fc2
          BinaryFile -> if b1 /= b2 then Just $ binary n2 b1 b2
                                    else Nothing
    | is_dir s1 && is_dir s2 =
        case recur_diff opts wt (get_dircontents s1) (get_dircontents s2) of
        [] -> Nothing
        ps -> let sortf = if nosort then id else reorder_and_coalesce
                  in Just $ sortf $ join_patches $ map (submerge_in_dir n2) ps
    | otherwise = Nothing
    where n2 = slurp_name s2
          fc1 = get_filecontents s1
          fc2 = get_filecontents s2
          b1 = getbin fc1
          b2 = getbin fc2
          maybe_differ = isparanoid
                       || get_mtime s1 == undefined_time || get_mtime s1 /= get_mtime s2
                       || get_length s1 == undefined_size || get_length s1 /= get_length s2

recur_diff :: (Bool,Bool,Bool)
               -> (FilePath -> FileType) -> [Slurpy] -> [Slurpy] -> [Patch]
recur_diff _ _ [] [] = []
recur_diff opts@(_,doadd,_) wt (s:ss) (s':ss')
    | s < s' = diff_removed wt s ++ recur_diff opts wt ss (s':ss')
    | s > s' = if not doadd then recur_diff opts wt (s:ss) ss'
               else diff_added wt s' ++ recur_diff opts wt (s:ss) ss'
    | s == s' = case gendiff opts wt s s' of
                Nothing -> rest
                Just p -> flatten p ++ rest
    where rest = recur_diff opts wt ss ss'
recur_diff opts wt (s:ss) [] =
    diff_removed wt s ++ recur_diff opts wt ss []
recur_diff opts@(_,True,_) wt [] (s':ss') =
    diff_added wt s' ++ recur_diff opts wt [] ss'
recur_diff (_,False,_) _ [] _ = []
recur_diff _ _ _ _ = impossible

getbin :: FileContents -> PackedString
getbin (_,Just b) = b
getbin (c,Nothing) = unlinesPS $ readAntiMemo c

get_text :: FileContents -> [PackedString]
get_text (x,_) = readAntiMemo x

empt :: FileContents
empt = (return [nilPS],Just nilPS)

diff_files :: FilePath -> FileContents -> FileContents -> Maybe Patch
diff_files f o n | get_text o == [nilPS] && get_text n == [nilPS] = Nothing
                 | get_text o == [nilPS] = diff_from_empty f n
                 | get_text n == [nilPS] = invert `liftM` diff_from_empty f o
diff_files f o n = if getbin o == getbin n
                   then Nothing
                   else if has_bin o || has_bin n
                        then Just $ binary f (getbin o) (getbin n)
                        else canonize $ hunk f 1 (fst o) (fst n)

diff_from_empty :: FilePath -> FileContents -> Maybe Patch
diff_from_empty f (pls, Nothing) =
    let ls = readAntiMemo pls in
    if null ls then Nothing
               else if nullPS $ last ls
                    then Just $ hunk f 1 (return []) $ init `fmap` pls
                    else Just $ hunk f 1 (return [nilPS]) pls
diff_from_empty f (pls, Just b) =
    if b == nilPS then Nothing
                  else if has_bin (pls, Just b)
                       then Just $ binary f nilPS b
                       else if lastPS b == '\n'
                            then Just $ hunk f 1 (return []) $ init `fmap` pls
                            else Just $ hunk f 1 (return [nilPS]) pls

has_bin :: FileContents -> Bool
has_bin (_,Nothing) = False
has_bin (_,Just b) = is_funky b
\end{code}

\begin{code}
diff_added :: (FilePath -> FileType) -> Slurpy -> [Patch]
diff_added wt s
    | is_file s = case wt n of
                  TextFile -> catMaybes
                              [Just $ addfile n,
                               diff_from_empty n $ get_filecontents s]
                  BinaryFile -> [addfile n,
                                 binary n nilPS (getbin $ get_filecontents s)]
    | otherwise {- is_dir s -} =
        adddir n :(map (submerge_in_dir n) $
                   concatMap (diff_added wt) $ get_dircontents s)
    where n = slurp_name s
\end{code}

\begin{code}
diff_removed :: (FilePath -> FileType) -> Slurpy -> [Patch]
diff_removed wt s
    | is_file s = case wt n of
                  TextFile -> catMaybes
                              [diff_files n (get_filecontents s) empt,
                               Just $ rmfile n]
                  BinaryFile -> [binary n (getbin $ get_filecontents s) nilPS,
                                 rmfile n]
    | otherwise {- is_dir s -}
        = (map (submerge_in_dir n) $
           concatMap (diff_removed wt) $ get_dircontents s) ++ [rmdir n]
    where n = slurp_name s
\end{code}

\begin{code}
sync :: String -> Slurpy -> Slurpy -> IO ()
sync path s1 s2
    | is_file s1 && is_file s2 &&
      (get_mtime s1 == undefined_time || get_mtime s1 /= get_mtime s2) &&
      get_length s1 == get_length s2 &&
      getbin (get_filecontents s1) == getbin (get_filecontents s2) =
        set_mtime n (get_mtime s2)
    | is_dir s1 && is_dir s2 = recur_sync n (get_dircontents s1) (get_dircontents s2)
    | otherwise = return ()
    where n = path++"/"++slurp_name s2
          set_mtime fname ctime = do now <- epochTime
                                     setFileTimes fname now ctime
                                                      `catchall` return ()
          recur_sync _ [] _ = return ()
          recur_sync _ _ [] = return ()
          recur_sync p (s:ss) (s':ss')
              | s < s' = recur_sync p ss (s':ss')
              | s > s' = recur_sync p (s:ss) ss'
              | otherwise = do sync p s s'
                               recur_sync p ss ss'
\end{code}


\begin{code}
cmp :: FilePath -> FilePath -> IO Bool
cmp p1 p2 = do
  dir1 <- doesDirectoryExist p1
  dir2 <- doesDirectoryExist p2
  file1 <- doesFileExist p1
  file2 <- doesFileExist p2
  if dir1 && dir2
     then cmpdir p1 p2
     else if file1 && file2
          then cmpfile p1 p2
          else return False
cmpdir :: FilePath -> FilePath -> IO Bool
cmpdir d1 d2 = do
  fn1 <- liftM (filter (\f->f/="." && f /="..")) $ getDirectoryContents d1
  fn2 <- liftM (filter (\f->f/="." && f /="..")) $ getDirectoryContents d2
  if sort fn1 /= sort fn2
     then return False
     else andIO $ map (\fn-> cmp (d1++"/"++fn) (d2++"/"++fn)) fn1
andIO :: [IO Bool] -> IO Bool
andIO (iob:iobs) = do b <- iob
                      if b then andIO iobs else return False
andIO [] = return True
cmpfile :: FilePath -> FilePath -> IO Bool
cmpfile f1 f2 = do
  h1 <- openBinaryFile f1 ReadMode
  h2 <- openBinaryFile f2 ReadMode
  l1 <- hFileSize h1
  l2 <- hFileSize h2
  if l1 /= l2
     then do hClose h1
             hClose h2
             putStrLn $ "different file lengths for "++f1++" and "++f2
             return False
     else do b <- hcmp h1 h2
             when (not b) $ putStrLn $ "files "++f1++" and "++f2++" differ"
             hClose h1
             hClose h2
             return b
    where hcmp h1 h2 = do c1 <- hGetPS h1 1024
                          c2 <- hGetPS h2 1024
                          if c1 /= c2
                             then return False
                             else if lengthPS c1 == 1024
                                  then hcmp h1 h2
                                  else return True
\end{code}