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

\subsection{darcs annotate}
\label{annotate}
\begin{code}
module Annotate ( annotate, created_as_xml ) where

import Monad ( liftM, when )
import List ( sort )
import Workaround ( getCurrentDirectory )

import DarcsCommands ( DarcsCommand(..), nodefaults )
import DarcsArguments ( DarcsFlag(..), working_repo_dir,
                        verbose, summary, unified, human_readable,
                        xmloutput, creatorhash,
                        fix_filepaths_wrt,
                        list_registered_files,
                        match_one,
                      )
import SlurpDirectory ( slurp )
import Repository ( PatchSet )
import DarcsRepo ( am_in_repo, read_repo, get_markedup_file )
import Patch ( LineMark(..), patch2patchinfo,
               patch_summary, xml_summary,
             )
import FastPackedString ( PackedString, unpackPS )
import PrintPatch ( printPatch, contextualPrintPatch )
import PatchInfo ( PatchInfo, human_friendly, to_xml, make_filename,
                   showPatchInfo )
import PopulationData ( Population(..), PopTree(..), DirMark(..),
                        nameI, modifiedByI, modifiedHowI,
                        createdByI, creationNameI,
                      )
import Population ( getRepoPopVersion, lookup_pop, lookup_creation_pop,
                    modified_to_xml,
                  )
import FileName ( fp2fn, fn2fp, norm_path )
import Match ( match_patch, have_nonrange_match, get_first_match )
import Lock ( withTempDir )
import Printer ( putDocLn, text, errorDoc, ($$), prefix, (<+>),
                 Doc, empty, vcat, (<>), renderString, packedString )
#include "impossible.h"
\end{code}

\options{annotate}

\haskell{annotate_description}
\begin{code}
annotate_description :: String
annotate_description = "Display which patch last modified something."
\end{code}
\haskell{annotate_help}

\begin{code}
annotate_help :: String
annotate_help =
 "Annotate displays which patches created or last modified a directory\n"++
 "file or line. It can also display the contents of a particular patch\n"++
 "in darcs format.\n"
\end{code}

\begin{code}
annotate :: DarcsCommand
annotate = DarcsCommand {command_name = "annotate",
                         command_help = annotate_help,
                         command_description = annotate_description,
                         command_extra_args = -1,
                         command_extra_arg_help = ["[FILE or DIRECTORY]..."],
                         command_command = annotate_cmd,
                         command_prereq = am_in_repo,
                         command_get_arg_possibilities = list_registered_files,
                         command_argdefaults = nodefaults,
                         command_darcsoptions = [verbose,summary,unified,
                                                 human_readable,
                                                 xmloutput,
                                                 match_one, creatorhash,
                                                 working_repo_dir]}
\end{code}

\begin{options}
--human-readable, --summary, --unified, --xml--output
\end{options}

When called with just a patch name, annotate outputs the patch in darcs format,
which is the same as \verb!--human-readable!.

\verb!--xml-output! is the alternative to \verb!--human-readable!.

\verb!--summary! can be used with either the \verb!--xml-output! or the  
\verb!--human-readable! options to alter the results. It is documented
fully in the `common options' portion of the manual. 

Giving the \verb!--unified! flag implies \verb!--human-readable!, and causes
the output to remain in a darcs-specific format that is similar to that produced
by \verb!diff --unified!.
\begin{code}
annotate_cmd :: [DarcsFlag] -> [String] -> IO ()
annotate_cmd opts [] = do
  when (not $ have_nonrange_match opts) $
      fail $ "Annotate requires either a patch pattern or a " ++
               "file or directory argument."
  p <- match_patch opts `liftM` read_repo "."
  repodir <- getCurrentDirectory
  if Summary `elem` opts
     then do putDocLn $ showpi $ fromJust $ patch2patchinfo p
             putDocLn $ show_summary p
     else if Unified `elem` opts
          then withTempDir "context" $ \_ ->
               do get_first_match repodir opts
                  c <- slurp "."
                  contextualPrintPatch c p
          else printPatch p
    where showpi = if MachineReadable `elem` opts
                   then showPatchInfo
                   else if XMLOutput `elem` opts
                        then to_xml
                        else human_friendly
          show_summary = if XMLOutput `elem` opts
                         then xml_summary
                         else patch_summary
\end{code}

If a directory name is given, annotate will output details of the last
modifying patch for each file in the directory and the directory itself. The
details look like this:

\begin{verbatim}
 # Created by [bounce handling patch
 # mark**20040526202216]  as ./test/m7/bounce_handling.pl
    bounce_handling.pl
\end{verbatim}

If a patch name and a directory are given, these details are output for the time after
that patch was applied.  If a directory and a tag name are given, the
details of the patches involved in the specified tagged version will be output.
\begin{code}
annotate_cmd opts args@[_] = do
  r <- read_repo "."
  (rel_file_or_directory:_) <- fix_filepaths_wrt "." opts args
  let file_or_directory = fn2fp $ norm_path $ fp2fn rel_file_or_directory
  pinfo <- if have_nonrange_match opts
           then return $ fromJust $ patch2patchinfo $ match_patch opts r
           else case concat r of
                [] -> fail "Annotate doesn't yet work right on empty repositories."
                ((x,_):_) -> return x
  pop <- getRepoPopVersion "." pinfo
  let maybe_creation_pi = find_creation_patchinfo opts r
      lookup_thing = case maybe_creation_pi of
                     Nothing -> lookup_pop
                     Just cp -> lookup_creation_pop cp
  if file_or_directory == ""
    then case pop of (Pop _ pt) -> annotate_pop opts pinfo pt
    else case lookup_thing file_or_directory pop of
      Nothing -> fail $ "There is no file or directory named '"++
                 file_or_directory++"'"
      Just (Pop _ pt@(PopDir i _))
          | modifiedHowI i == RemovedDir && modifiedByI i /= pinfo ->
              errorDoc $ text ("The directory '" ++ rel_file_or_directory ++
                               "' was removed by")
                      $$ human_friendly (modifiedByI i)
          | otherwise -> annotate_pop opts pinfo pt
      Just (Pop _ pt@(PopFile i))
          | modifiedHowI i == RemovedFile && modifiedByI i /= pinfo ->
              errorDoc $ text ("The file '" ++ rel_file_or_directory ++
                               "' was removed by")
                      $$ human_friendly (modifiedByI i)
          | otherwise -> annotate_file opts pinfo file_or_directory pt
\end{code}

\begin{code}
annotate_cmd _ _ = fail "annotate accepts at most one argument"
\end{code}

\begin{code}
annotate_pop :: [DarcsFlag] -> PatchInfo -> PopTree -> IO ()
annotate_pop opts pinfo pt = putDocLn $ p2format pinfo pt
    where p2format = if XMLOutput `elem` opts
                     then p2xml
                     else p2s
\end{code}

\begin{code}
indent :: Doc -> [Doc]
-- This is a bit nasty:
indent = map (text . i) . lines . renderString
    where i "" = ""
          i ('#':s) = ('#':s)
          i s = "    "++s

-- Annotate a directory listing
p2s :: PatchInfo -> PopTree -> Doc
p2s pinfo (PopFile info) =
    created_str
 $$ f <+> file_change
    where f = packedString $ nameI info
          file_created = text "Created by"
                     <+> showPatchInfo (fromJust $ createdByI info)
                     <+> text "as"
                     <+> packedString (fromJust $ creationNameI info)
          created_str = prefix "# " file_created
          file_change = if modifiedByI info == pinfo
                        then text $ show (modifiedHowI info)
                        else empty
p2s pinfo (PopDir info pops) =
    created_str
 $$ dir <+> dir_change
 $$ vcat (map (vcat . indent . p2s pinfo) $ sort pops)
    where dir = packedString (nameI info) <> text "/"
          dir_created =
              if createdByI info /= Nothing
              then text "Created by "
               <+> showPatchInfo (fromJust $ createdByI info)
               <+> text "as"
               <+> packedString (fromJust $ creationNameI info) <> text "/"
              else text "Root directory"
          created_str = prefix "# " dir_created
          dir_change = if modifiedByI info == pinfo
                       then text $ show (modifiedHowI info)
                       else empty
\end{code}

\begin{code}
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)

created_as_xml :: PatchInfo -> String -> Doc
created_as_xml pinfo as = text "<created_as original_name='"
                       <> escapeXML as
                       <> text "'>"
                    $$    to_xml pinfo
                    $$    text "</created_as>"
--removed_by_xml :: PatchInfo -> String
--removed_by_xml pinfo = "<removed_by>\n"++to_xml pinfo++"</removed_by>\n"

p2xml_open :: PatchInfo -> PopTree -> Doc
p2xml_open _ (PopFile info) =
    text "<file name='" <> escapeXML f <> text "'>"
 $$ created
 $$ modified
    where f = unpackPS $ nameI info
          created = case createdByI info of
                    Nothing -> empty
                    Just ci -> created_as_xml ci
                               (unpackPS $ fromJust $ creationNameI info)
          modified = modified_to_xml info
p2xml_open _ (PopDir info _) =
    text "<directory name='" <> escapeXML f <> text "'>"
 $$ created
 $$ modified
    where f = unpackPS $ nameI info
          created = case createdByI info of
                    Nothing -> empty
                    Just ci -> created_as_xml ci
                               (unpackPS $ fromJust $ creationNameI info)
          modified = modified_to_xml info

p2xml_close :: PatchInfo -> PopTree -> Doc
p2xml_close _(PopFile _) = text "</file>"
p2xml_close _ (PopDir _ _) = text "</directory>"

p2xml :: PatchInfo -> PopTree -> Doc
p2xml pinf p@(PopFile _) = p2xml_open pinf p $$ p2xml_close pinf p
p2xml pinf p@(PopDir _ pops) = p2xml_open pinf p
                            $$ vcat (map (p2xml pinf) $ sort pops)
                            $$ p2xml_close pinf p
\end{code}

If a file name is given, the last modifying patch details of that file will be output, along
with markup indicating patch details when each line was last (and perhaps next) modified.

\begin{code}
annotate_file :: [DarcsFlag] -> PatchInfo -> FilePath -> PopTree -> IO ()
annotate_file opts pinfo f (PopFile info) = do
  if XMLOutput `elem` opts
     then putDocLn $ p2xml_open pinfo (PopFile info)
     else if createdByI info /= Nothing
          then putAnn $ text ("File "++f++" created by ")
                     <> showPatchInfo ci <> text (" as " ++ createdname)
          else putAnn $ text $ "File "++f
  mk <- get_markedup_file ci createdname
  old_pis <- (dropWhile (/= pinfo).map fst.concat) `liftM` read_repo "."
  sequence_ $ map (annotate_markedup opts pinfo old_pis) mk
  when (XMLOutput `elem` opts) $  putDocLn $ p2xml_close pinfo (PopFile info)
  where ci = fromJust $ createdByI info
        createdname = unpackPS $ fromJust $ creationNameI info
annotate_file _ _ _ _ = impossible

annotate_markedup :: [DarcsFlag] -> PatchInfo -> [PatchInfo]
                  -> (PackedString, LineMark) -> IO ()
annotate_markedup opts | XMLOutput `elem` opts = xml_markedup
                       | otherwise = text_markedup

text_markedup :: PatchInfo -> [PatchInfo] -> (PackedString, LineMark) -> IO ()
text_markedup _ _ (l,None) = putLine ' ' l
text_markedup pinfo old_pis (l,RemovedLine wheni) =
    if wheni == pinfo
    then putLine '-' l
    else if wheni `elem` old_pis
         then return ()
         else putLine ' ' l
text_markedup pinfo old_pis (l,AddedLine wheni) =
    if wheni == pinfo
    then putLine '+' l
    else if wheni `elem` old_pis
         then do putAnn $ text "Following line added by "
                       <> showPatchInfo wheni
                 putLine ' ' l
         else return ()
text_markedup pinfo old_pis (l,AddedRemovedLine whenadd whenrem)
    | whenadd == pinfo = do putAnn $ text "Following line removed by "
                                  <> showPatchInfo whenrem
                            putLine '+' l
    | whenrem == pinfo = do putAnn $ text "Following line added by "
                                  <> showPatchInfo whenadd
                            putLine '-' l
    | whenadd `elem` old_pis && not (whenrem `elem` old_pis) =
        do putAnn $ text "Following line removed by " <> showPatchInfo whenrem
           putAnn $ text "Following line added by " <> showPatchInfo whenadd
           putLine ' ' l
    | otherwise = return ()

putLine :: Char -> PackedString -> IO ()
putLine c s = putStrLn $ c : unpackPS s
putAnn :: Doc -> IO ()
putAnn s = putDocLn $ prefix "# " s

xml_markedup :: PatchInfo -> [PatchInfo] -> (PackedString, LineMark) -> IO ()
xml_markedup _ _ (l,None) = putLine ' ' l
xml_markedup pinfo old_pis (l,RemovedLine wheni) =
    if wheni == pinfo
    then putDocLn $ text "<removed_line>"
                 $$ escapeXML (unpackPS l)
                 $$ text "</removed_line>"
    else if wheni `elem` old_pis
         then return ()
         else putDocLn $ text "<normal_line>"
                      $$ text "<removed_by>"
                      $$ to_xml wheni
                      $$ text "</removed_by>"
                      $$ escapeXML (unpackPS l)
                      $$ text "</normal_line>"
xml_markedup pinfo old_pis (l,AddedLine wheni) =
    if wheni == pinfo
    then putDocLn $ text "<added_line>"
                 $$ escapeXML (unpackPS l)
                 $$ text "</added_line>"
    else if wheni `elem` old_pis
         then putDocLn $ text "<normal_line>"
                      $$ text "<added_by>"
                      $$ to_xml wheni
                      $$ text "</added_by>"
                      $$ escapeXML (unpackPS l)
                      $$ text "</normal_line>"
         else return ()
xml_markedup pinfo old_pis (l,AddedRemovedLine whenadd whenrem)
    | whenadd == pinfo =
        putDocLn $ text "<added_line>"
                $$ text "<removed_by>"
                $$ to_xml whenrem
                $$ text "</removed_by>"
                $$ escapeXML (unpackPS l)
                $$ text "</added_line>"
    | whenrem == pinfo =
        putDocLn $ text "<removed_line>"
                $$ text "<added_by>"
                $$ to_xml whenadd
                $$ text "</added_by>"
                $$ escapeXML (unpackPS l)
                $$ text "</removed_line>"
    | whenadd `elem` old_pis && not (whenrem `elem` old_pis) =
        putDocLn $ text "<normal_line>"
                $$ text "<removed_by>"
                $$ to_xml whenrem
                $$ text "</removed_by>"
                $$ text "<added_by>"
                $$ to_xml whenadd
                $$ text "</added_by>"
                $$ escapeXML (unpackPS l)
                $$ text "</normal_line>"
    | otherwise = return ()
\end{code}

\begin{options}
--creator-hash HASH
\end{options}

The \verb!--creator-hash! option should only be used in combination with a
file or directory to be annotated.  In this case, the name of that file or
directory is interpreted to be its name \emph{at the time it was created},
and the hash given along with \verb!--creator-hash! indicates the patch
that created the file or directory.  This allows you to (relatively) easily
examine a file even if it has been renamed multiple times.

\begin{code}
find_creation_patchinfo :: [DarcsFlag] -> PatchSet -> Maybe PatchInfo
find_creation_patchinfo [] _ = Nothing
find_creation_patchinfo (CreatorHash h:_) r = find_hash h $ map fst $ concat r
find_creation_patchinfo (_:fs) r = find_creation_patchinfo fs r

find_hash :: String -> [PatchInfo] -> Maybe PatchInfo
find_hash _ [] = Nothing
find_hash h (pinf:pinfs)
    | take (length h) (make_filename pinf) == h = Just pinf
    | otherwise = find_hash h pinfs
\end{code}