%  Copyright (C) 2002-2004 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; see the file COPYING.  If not, write to
%  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
%  Boston, MA 02110-1301, USA.


\begin{code}
module PatchViewing ( showContextPatch,
                      patch_summary, xml_summary, patch_description )
             where

import Prelude hiding ( pi )
import Control.Monad ( liftM )
import List ( sort )

import SlurpDirectory ( Slurpy, get_slurp, get_filecontents )
import FastPackedString ( nullPS )
import FileName ( FileName, fp2fn, fn2fp )
import Printer ( Doc, empty, vcat,
                 text, blueText,
                 minus, plus, ($$), (<+>), (<>),
                 prefix,
                 userchunkPS,
               )
import PatchInfo ( human_friendly )
import PatchCore ( Patch(..), DirPatchType(..), FilePatchType(..),
                   flatten_to_primitives, fn2d, is_hunk, null_patch,
                   patch2patchinfo )
import PatchShow ( showPatch, showNamedPrefix )
import PatchApply ( apply_to_slurpy )
import PatchCommute ( merger_equivalent )
#include "impossible.h"
\end{code}


\begin{code}
showContextPatch :: Slurpy -> Patch -> Doc
showContextPatch s p@(FP _ (Hunk _ _ _)) = showContextHunk s p
showContextPatch s (ComP ps) = showContextComP s ps
showContextPatch s (Split ps) = showContextSplit s ps
showContextPatch s p@(NamedP _ _ _) = showContextNamed s p
showContextPatch _ p = showPatch p
\end{code}

\begin{code}
showContextComP :: Slurpy -> [Patch] -> Doc
showContextComP slurpy patches = text "{"
                              $$ showContextSeries slurpy patches
                              $$ text "}"

showContextSeries :: Slurpy -> [Patch] -> Doc
showContextSeries slur patches = scs slur null_patch patches
    where scs s pold (p:p2:ps)
              | is_hunk p = coolContextHunk s pold p p2
                         $$ scs (fromJust $ apply_to_slurpy p s) p (p2:ps)
          scs s pold [p]
              | is_hunk p = coolContextHunk s pold p null_patch
          scs s _ (p:ps) = showContextPatch s p
                        $$ scs (fromJust $ apply_to_slurpy p s) p ps
          scs _ _ [] = empty
\end{code}

\begin{code}
showContextSplit :: Slurpy -> [Patch] -> Doc
showContextSplit slurpy patches = text "("
                                  $$ showContextSeries slurpy patches
                                  <> text ")"
\end{code}

\begin{code}
showContextHunk :: Slurpy -> Patch -> Doc
showContextHunk s p = coolContextHunk s null_patch p null_patch

coolContextHunk :: Slurpy -> Patch -> Patch -> Patch -> Doc
coolContextHunk s prev p@(FP f (Hunk l o n)) next =
    case (fst . get_filecontents) `liftM` get_slurp f s of
    Nothing -> showPatch p -- This is a weird error...
    Just ls ->
        let numpre = case prev of
                     (FP f' (Hunk lprev _ nprev))
                         | f' == f &&
                           l - (lprev + length nprev + 3) < 3 &&
                           lprev < l ->
                             max 0 $ l - (lprev + length nprev + 3)
                     _ -> if l >= 4 then 3 else l - 1
            pre = take numpre $ drop (l - numpre - 1) ls
            numpost = case next of
                      (FP f' (Hunk lnext _ _))
                          | f' == f && lnext < l+length n+4 &&
                            lnext > l ->
                              lnext - (l+length n)
                      _ -> 3
            cleanedls = case reverse ls of
                        (x:xs) | nullPS x -> reverse xs
                        _ -> ls
            post = take numpost $ drop (max 0 $ l+length o-1) cleanedls
            in blueText "hunk" <+> fn2d f <+> text (show l)
            $$ prefix " " (vcat $ map userchunkPS pre)
            $$ prefix "-" (vcat $ map userchunkPS o)
            $$ prefix "+" (vcat $ map userchunkPS n)
            $$ prefix " " (vcat $ map userchunkPS post)
coolContextHunk _ _ _ _ = impossible
\end{code}

\begin{code}
showContextNamed :: Slurpy -> Patch -> Doc
showContextNamed s (NamedP n d p) =
    showNamedPrefix n d <+> showContextPatch s p
showContextNamed _ _ = impossible
\end{code}

\begin{code}
patch_description :: Patch -> Doc
patch_description p = case patch2patchinfo p of
                      Nothing -> showPatch p
                      Just pi -> human_friendly pi
\end{code}

\begin{code}
-- FIXME: The following code is terribly crude (especially in the presense of mv's).
patch_summary :: Patch -> Doc
patch_summary = gen_summary False

xml_summary :: Patch -> Doc
xml_summary p = text "<summary>"
             $$ gen_summary True p
             $$ text "</summary>"

-- Yuck duplicated code below...
escapeXML :: String -> Doc
escapeXML = text . strReplace '\'' "&apos;" . strReplace '"' "&quot;" .
  strReplace '>' "&gt;" . strReplace '<' "&lt;" . strReplace '&' "&amp;"

strReplace :: Char -> String -> String -> String
strReplace _ _ [] = []
strReplace x y (z:zs)
  | x == z    = y ++ (strReplace x y zs)
  | otherwise = z : (strReplace x y zs)
-- end yuck duplicated code.

gen_summary :: Bool -> Patch -> Doc
gen_summary use_xml p
    = vcat themoves
   $$ vcat themods
    where themods = map summ $ combine $ sort $
                    concatMap s $ flatten_to_primitives p
          s :: Patch -> [(FileName, Int, Int, Int, Bool, Bool)]
          s (FP f (Hunk _ o n)) = [(f, length o, length n, 0, False, False)]
          s (FP f (Binary _ _)) = [(f, 0, 0, 0, False, False)]
          s (FP f AddFile) = [(f, -1, 0, 0, False, False)]
          s (FP f RmFile) = [(f, 0, -1, 0, False, False)]
          s (FP f (TokReplace _ _ _)) = [(f, 0, 0, 1, False, False)]
          s (DP d AddDir) = [(d, -1, 0, 0, True, False)]
          s (DP d RmDir) = [(d, 0, -1, 0, True, False)]
          s m@(Merger _ _ _ _ _ _) =
              map (\ (a,b,c,d,e,_) -> (a,b,c,d,e,True)) $
              concatMap s $ flatten_to_primitives $ merger_equivalent m
          s _ = [(fp2fn "", 0, 0, 0, False, False)]
          (-1) .+ _ = -1
          _ .+ (-1) = -1
          a .+ b = a + b
          combine ((f,a,b,r,isd,c):(f',a',b',r',_,c'):ss)
              -- Don't combine AddFile and RmFile: (maybe an old revision of) darcs
              -- allows a single patch to add and remove the same file, see issue 185
              | f == f' && (a /= -1 || b' /= -1) && (a' /= -1 || b /= -1) = combine ((f,a.+a',b.+b',r+r',isd,c||c'):ss)
          combine ((f,a,b,r,isd,c):ss) = (f,a,b,r,isd,c) : combine ss
          combine [] = []

          summ (f,_,-1,_,False,False)
              = if use_xml then text "<remove_file>"
                             $$ escapeXML (drop_dotslash $ fn2fp f)
                             $$ text "</remove_file>"
                           else text "R" <+> text (fn2fp f)
          summ (f,_,-1,_,False,True)
              = if use_xml then text "<remove_file conflict='true'>"
                             $$ escapeXML (drop_dotslash $ fn2fp f)
                             $$ text "</remove_file>"
                           else text "R!" <+> text (fn2fp f)
          summ (f,-1,_,_,False,False)
              = if use_xml then text "<add_file>"
                             $$ escapeXML (drop_dotslash $ fn2fp f)
                             $$ text "</add_file>"
                           else text "A" <+> text (fn2fp f)
          summ (f,-1,_,_,False,True)
              = if use_xml then text "<add_file conflict='true'>"
                             $$ escapeXML (drop_dotslash $ fn2fp f)
                             $$ text "</add_file>"
                           else text "A!" <+> text (fn2fp f)
          summ (f,0,0,0,False,False) | f == fp2fn "" = empty
          summ (f,0,0,0,False,True) | f == fp2fn ""
              = if use_xml then empty -- don't know what to do here...
                           else text "!" <+> text (fn2fp f)
          summ (f,a,b,r,False,False)
              = if use_xml then text "<modify_file>"
                             $$ escapeXML (drop_dotslash $ fn2fp f)
                                    <> xrm a <> xad b <> xrp r
                             $$ text "</modify_file>"
                           else text "M" <+> text (fn2fp f)
                                         <+> rm a <+> ad b <+> rp r
          summ (f,a,b,r,False,True)
              = if use_xml then text "<modify_file conflict='true'>"
                             $$ escapeXML (drop_dotslash $ fn2fp f)
                                    <> xrm a <> xad b <> xrp r
                             $$ text "</modify_file>"
                           else text "M!" <+> text (fn2fp f)
                                    <+> rm a <+> ad b <+> rp r
          summ (f,_,-1,_,True,False)
              = if use_xml then text "<remove_directory>"
                             $$ escapeXML (drop_dotslash $ fn2fp f)
                             $$ text "</remove_directory>"
                           else text "R" <+> text (fn2fp f) <> text "/"
          summ (f,_,-1,_,True,True)
              = if use_xml then text "<remove_directory conflict='true'>"
                             $$ escapeXML (drop_dotslash $ fn2fp f)
                             $$ text "</remove_directory>"
                           else text "R!" <+> text (fn2fp f) <> text "/"
          summ (f,-1,_,_,True,False)
              = if use_xml then text "<add_directory>"
                             $$ escapeXML (drop_dotslash $ fn2fp f)
                             $$ text "</add_directory>"
                           else text "A" <+> text (fn2fp f) <> text "/"
          summ (f,-1,_,_,True,True)
              = if use_xml then text "<add_directory conflict='true'>"
                             $$ escapeXML (drop_dotslash $ fn2fp f)
                             $$ text "</add_directory>"
                           else text "A!" <+> text (fn2fp f) <> text "/"
          summ _ = empty
          ad 0 = empty
          ad a = plus <> text (show a)
          xad 0 = empty
          xad a = text "<added_lines num='" <> text (show a) <> text "'/>"
          rm 0 = empty
          rm a = minus <> text (show a)
          xrm 0 = empty
          xrm a = text "<removed_lines num='" <> text (show a) <> text "'/>"
          rp 0 = empty
          rp a = text "r" <> text (show a)
          xrp 0 = empty
          xrp a = text "<replaced_tokens num='" <> text (show a) <> text "'/>"
          drop_dotslash ('.':'/':str) = drop_dotslash str
          drop_dotslash str = str
          themoves :: [Doc]
          themoves = map showmoves $ flatten_to_primitives p
          showmoves :: Patch -> Doc
          showmoves (Move a b)
              = if use_xml
                then text "<move from=\""
                  <> escapeXML (drop_dotslash $ fn2fp a) <> text "\" to=\""
                  <> escapeXML (drop_dotslash $ fn2fp b) <> text"\"/>"
                else text " "    <> text (fn2fp a)
                  <> text " -> " <> text (fn2fp b)
          showmoves _ = empty
\end{code}