%  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; if not, write to the Free Software Foundation,
%  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
\section{darcs annotate}
\label{annotate}
\begin{code}
module Annotate ( annotate ) 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,
                        fix_filepath,
                        list_registered_files,
                        match_one,
                      )
import SlurpDirectory ( slurp )
import Repository ( 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 )
import PopulationData ( Population(..), PopTree(..), DirMark(..),
                        nameI, modifiedByI, modifiedHowI,
                        createdByI, creationNameI,
                      )
import Population ( getRepoPopVersion, lookup_pop,
                    modified_to_xml,
                  )
import FileName ( fp2fn, fn2fp, norm_path )
import Match ( match_patch, have_nonrange_match, get_first_match )
import Lock ( withTempDir )
#include "impossible.h"
\end{code}

\options{annotate}

\haskell{annotate_description}
\begin{code}
annotate_description :: String
annotate_description = "Display useful information about the repository history.\n"
\end{code}
\haskell{annotate_help}

\begin{code}
annotate_help :: String
annotate_help =
 "Annotate allows you to extract all sorts of interesting information from\n"++
 "your repository.\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,
                                                 working_repo_dir]}
\end{code}

When called with just a patch name, annotate outputs the patch in darcs
format.  The \verb!--summary!, \verb!--human-readable! or \verb!--unified!
options may be used to modify the format with which it is displayed.

\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 putStrLn $ showpi $ fromJust $ patch2patchinfo p
             putStr $ 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 show
                   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 the contents of that
directory.  If a patch name is given, the contents of that directory after
that patch was applied will be output.  If a tag name is given, the
contents of that directory in the specified tagged version will be output.

\begin{code}
annotate_cmd opts [rel_file_or_directory] = do
  r <- read_repo "."
  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 repos."
                ((x,_):_) -> return x
  pop <- getRepoPopVersion "." pinfo
  if file_or_directory == ""
    then case pop of (Pop _ pt) -> annotate_pop opts pinfo pt
    else case lookup_pop 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 ->
              fail $ "The directory '" ++ rel_file_or_directory ++
                       "' was removed by\n" ++ human_friendly (modifiedByI i)
          | otherwise -> annotate_pop opts pinfo pt
      Just (Pop _ pt@(PopFile i))
          | modifiedHowI i == RemovedFile ->
              fail $ "The file '" ++ rel_file_or_directory ++
                       "' was removed by\n" ++ human_friendly (modifiedByI i)
          | otherwise -> annotate_file opts pinfo file_or_directory pt
  where file_or_directory = fn2fp $ norm_path $ fp2fn $
                            fix_filepath opts rel_file_or_directory
\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 = putStr $ p2format pinfo pt
    where p2format = if XMLOutput `elem` opts
                     then p2xml
                     else p2s
\end{code}

\begin{code}
indent :: String -> String
indent = unlines . map i . lines
    where i "" = ""
          i ('#':s) = ('#':s)
          i s = "    "++s

-- Annotate a directory listing
p2s :: PatchInfo -> PopTree -> String
p2s pinfo (PopFile info) =
    created_str ++ f ++ file_change ++ "\n"
    where f = unpackPS $ nameI info
          file_created = "Created by " ++ show (fromJust $ createdByI info) ++
                         " as " ++ unpackPS (fromJust $ creationNameI info)++"\n"
          created_str = unlines $ map ("# "++) $ lines file_created
          file_change = if modifiedByI info == pinfo
                        then " "++show (modifiedHowI info)
                        else ""
p2s pinfo (PopDir info pops) =
    created_str ++ dir ++ dir_change ++ "\n" ++
    concat (map (indent . (p2s pinfo)) $ sort pops)
    where dir = unpackPS (nameI info) ++ "/"
          dir_created =
              if createdByI info /= Nothing
              then "Created by " ++ show (fromJust $ createdByI info) ++
                   " as " ++ unpackPS (fromJust $ creationNameI info)++"/\n"
              else "Root directory"
          created_str = unlines $ map ("# "++) $ lines dir_created
          dir_change = if modifiedByI info == pinfo
                       then " "++show (modifiedHowI info)
                       else ""
\end{code}

\begin{code}
escapeXML :: String -> String
escapeXML = strReplace '\'' "&apos;" . strReplace '"' "&quot;" .
  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 -> String
created_as_xml pinfo as = "<created_as original_name='" ++
                     escapeXML as ++
                     "'>\n"++ to_xml pinfo ++"</created_as>\n"
--removed_by_xml :: PatchInfo -> String
--removed_by_xml pinfo = "<removed_by>\n"++to_xml pinfo++"</removed_by>\n"

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

p2xml_close :: PatchInfo -> PopTree -> String
p2xml_close _(PopFile _) = "</file>\n"
p2xml_close _ (PopDir _ _) = "</directory>\n"

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

If a file name is given, the contents of that file will be output, along
with markup indicating 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 putStr $ p2xml_open pinfo (PopFile info)
     else if createdByI info /= Nothing
          then putAnn $ "File "++f++" created by "++
               show ci ++ " as " ++ createdname
          else putAnn $ "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) $  putStr $ 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 $ "Following line added by "++show wheni
                 putLine ' ' l
         else return ()
text_markedup pinfo old_pis (l,AddedRemovedLine whenadd whenrem)
    | whenadd == pinfo = do putAnn $ "Following line removed by "++show whenrem
                            putLine '+' l
    | whenrem == pinfo = do putAnn $ "Following line added by "++show whenadd
                            putLine '-' l
    | whenadd `elem` old_pis && not (whenrem `elem` old_pis) =
        do putAnn $ "Following line removed by "++show whenrem
           putAnn $ "Following line added by "++show whenadd
           putLine ' ' l
    | otherwise = return ()

putLine :: Char -> PackedString -> IO ()
putLine c s = putStrLn $ c : unpackPS s
putAnn :: String -> IO ()
putAnn s = putStr $ unlines $ map ("# "++) $ lines 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 putStr $  "<removed_line>" ++
         escapeXML (unpackPS l) ++ "</removed_line>\n"
    else if wheni `elem` old_pis
         then return ()
         else putStr $  "<normal_line>" ++
                  "<removed_by>" ++ to_xml wheni ++ "</removed_by>" ++
                  escapeXML (unpackPS l) ++ "</normal_line>\n"
xml_markedup pinfo old_pis (l,AddedLine wheni) =
    if wheni == pinfo
    then putStr $ "<added_line>" ++
         escapeXML (unpackPS l) ++ "</added_line>\n"
    else if wheni `elem` old_pis
         then putStr $  "<normal_line>" ++
                  "<added_by>" ++ to_xml wheni ++ "</added_by>" ++
                  escapeXML (unpackPS l) ++ "</normal_line>\n"
         else return ()
xml_markedup pinfo old_pis (l,AddedRemovedLine whenadd whenrem)
    | whenadd == pinfo =
        putStr $ "<added_line>" ++
                     "<removed_by>" ++ to_xml whenrem ++ "</removed_by>" ++
                     escapeXML (unpackPS l) ++ "</added_line>\n"
    | whenrem == pinfo =
        putStr $  "<removed_line>" ++
                     "<added_by>" ++ to_xml whenadd ++ "</added_by>" ++
                     escapeXML (unpackPS l) ++ "</removed_line>\n"
    | whenadd `elem` old_pis && not (whenrem `elem` old_pis) =
        putStr $  "<normal_line>" ++
                     "<removed_by>" ++ to_xml whenrem ++ "</removed_by>" ++
                     "<added_by>" ++ to_xml whenadd ++ "</added_by>" ++
                     escapeXML (unpackPS l) ++ "</normal_line>\n"
    | otherwise = return ()
\end{code}