%  Copyright (C) 2003-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.

\subsection{darcs changes}
\begin{code}
module Changes ( changes ) where

import List ( sort )
import Control.Monad ( liftM, when )

import Depends ( slightly_optimize_patchset )
import DarcsCommands ( DarcsCommand(..), nodefaults )
import DarcsArguments ( DarcsFlag(Context, MachineReadable, Interactive,
                                  RepoDir,
                                  XMLOutput, Summary, Reverse, Verbose),
                        fix_filepaths_wrt, changes_format,
                        possibly_remote_repo_dir, get_repodir,
                        working_repo_dir,
                        summary, changes_reverse,
                        match_several_or_range, any_verbosity,
                        all_gui_interactive,
                        ssh_cm
                      )
import Repository ( PatchSet, identifyRepository, findRepository, read_repo,
                    slurp_recorded )
import PatchInfo ( PatchInfo, human_friendly, to_xml, showPatchInfo, )
import PatchShow ( showUnnamed )
import Depends ( get_common_and_uncommon )
import TouchesFiles ( look_touch )
import Patch ( Patch, invert, patch_summary, xml_summary )
import Match ( first_match, second_match,
               match_a_patchread, have_nonrange_match,
               match_first_patchset, match_second_patchset,
             )
import Annotate ( created_as_xml )
import DarcsUtils ( catchall, formatPath )
import FastPackedString ( linesPS )
import Printer ( Doc, putDocLnWith, simplePrinters, renderPS,
                 renderString, prefix,
                 packedString, text, vcat, vsep, ($$), empty, errorDoc )
import ColourPrinter ( fancyPrinters )
import SelectChanges ( view_changes )
#include "impossible.h"
\end{code}

\options{changes}
\begin{code}
changes_description :: String
changes_description = "Gives a changelog-style summary of the repository history."
\end{code}
\haskell{changes_help}
\begin{code}
changes_help :: String
changes_help =
 "Changes gives a changelog-style summary of the repository history,\n"++
 "including options for altering how the patches are selected and displayed.\n"

changes :: DarcsCommand
changes = DarcsCommand {command_name = "changes",
                        command_help = changes_help,
                        command_description = changes_description,
                        command_extra_args = -1,
                        command_extra_arg_help = ["[FILE or DIRECTORY]..."],
                        command_get_arg_possibilities = return [],
                        command_command = changes_cmd,
                        command_prereq = findRepository,
                        command_argdefaults = nodefaults,
                        command_darcsoptions = [match_several_or_range,
                                                changes_format,
                                                summary, any_verbosity,
                                                changes_reverse,
                                                possibly_remote_repo_dir,
                                                working_repo_dir,
                                                all_gui_interactive,
                                                ssh_cm]}
\end{code}


\begin{code}
changes_cmd :: [DarcsFlag] -> [String] -> IO ()
changes_cmd [Context ""] [] = do return ()
changes_cmd opts args | Context "" `elem` opts = do
  when (args /= []) $ fail "changes --context cannot accept other arguments"
  changes_context opts
changes_cmd opts args =
  -- Why '.'? Because if it was WorkDir (--repodir); then the
  -- findRepository prereq would already have cd'd its way up
  let repodir = if hasRepoDir opts then get_repodir opts else "." in do
  files <- sort `liftM` fix_filepaths_wrt repodir opts args
  let filtered_changes p = maybe_reverse $ get_changes_info opts files p
  repository <- identifyRepository repodir
  patches <- read_repo repository
             `catchall` (fail $ formatPath repodir ++
                         " is not a valid repository.")
  if Interactive `elem` opts
    then let (fp,_,_) = filtered_changes patches
             patches' = map (\ (_, Just p) -> p) fp
         in do s <- slurp_recorded repository
               view_changes opts s files patches' Nothing
    else do when (not (null files) && not (XMLOutput `elem` opts)) $
                 putStrLn $ "Changes to "++unwords files++":\n"
            putDocLnWith fancyPrinters $ changelog opts $
                         filtered_changes patches
  where maybe_reverse (xs,b,c) = if Reverse `elem` opts
                                 then (reverse xs, b, c)
                                 else (xs, b, c)
  
hasRepoDir :: [DarcsFlag] -> Bool
hasRepoDir [] = False 
hasRepoDir (RepoDir _:_) = True
hasRepoDir (_:fs) = hasRepoDir fs 
\end{code}

When given one or more files or directories as an argument, changes lists only
those patches which affect those files or the contents of those directories or,
of course, the directories themselves. This includes changes that happened to
files before they were moved or renamed.

\begin{options}
--from-match, --from-patch, --from-tag
\end{options}

If changes is given a \verb!--from-patch!, \verb!--from-match!, or
\verb!--from-tag! option, it outputs only those changes since that tag or
patch.

Without any options to limit the scope of the changes, history will be displayed
going back as far as possible.


\begin{code}
get_changes_info :: [DarcsFlag] -> [FilePath] -> PatchSet
                 -> ([(PatchInfo, Maybe Patch)], [FilePath], Doc)
get_changes_info opts plain_fs ps =
  case get_common_and_uncommon (p2s,p1s) of
  (_,us,_) -> filter_patches_by_names fs $ filter pf $ concat us
  where fs = map ("./"++) plain_fs
        p1s = if first_match opts then match_first_patchset opts ps
                                  else [[]]
        p2s = if second_match opts then match_second_patchset opts ps
                                   else ps
        pf = if have_nonrange_match opts
             then match_a_patchread opts
             else \_ -> True

filter_patches_by_names :: [FilePath]
                        -> [(PatchInfo, Maybe Patch)]
                        -> ([(PatchInfo, Maybe Patch)],[FilePath], Doc)
filter_patches_by_names _ [] = ([], [], empty)
filter_patches_by_names [] pps = (pps, [], empty)
filter_patches_by_names fs ((pinfo, Just p):ps) =
    case look_touch fs (invert p) of
    (True, []) -> ([(pinfo, Just p)], fs, empty)
    (True, fs') -> (pinfo, Just p) -:- filter_patches_by_names fs' ps
    (False, fs') -> filter_patches_by_names fs' ps
filter_patches_by_names _ ((pinf, Nothing):_) =
    ([], [], text "Can't find changes prior to:"
          $$ human_friendly pinf)

(-:-) :: a -> ([a],b,c) -> ([a],b,c)
x -:- (xs,y,z) = (x:xs,y,z)

changelog :: [DarcsFlag] -> ([(PatchInfo, Maybe Patch)], [FilePath], Doc)
          -> Doc
changelog opts (pis, fs, errstring)
    | MachineReadable `elem` opts =
        if renderString errstring == ""
        then vsep $ map (showPatchInfo.fst) pis
        else errorDoc errstring
    | XMLOutput `elem` opts =
         text "<changelog>"
      $$ vcat xml_file_names
      $$ vcat actual_xml_changes
      $$ text "</changelog>"
    | Summary `elem` opts =
           vsep (map (change_with_summary patch_summary) pis)
        $$ errstring
    | Verbose `elem` opts =
           vsep (map (change_with_summary showUnnamed) pis)
        $$ errstring
    | otherwise = vsep (map (human_friendly.fst) pis)
               $$ errstring
    where change_with_summary show_patch (pinfo, Just p)
              = human_friendly pinfo
             $$ text ""
             $$ indent (show_patch p)
          change_with_summary _ (pinfo, Nothing)
              = human_friendly pinfo
             $$ indent (text "[this patch is unavailable]")
          xml_with_summary (pinfo, Just p)
              = insert_before_lastline
                (to_xml pinfo) (indent $ xml_summary p)
          xml_with_summary (pinfo, Nothing) = to_xml pinfo
          indent = prefix "    "
          actual_xml_changes = if Summary `elem` opts
                               then map xml_with_summary pis
                               else map (to_xml.fst) pis
          xml_file_names = map (created_as_xml first_change) fs
          first_change = if Reverse `elem` opts
                         then fst $ head pis
                         else fst $ last pis


insert_before_lastline :: Doc -> Doc -> Doc
insert_before_lastline a b =
    case reverse $ map packedString $ linesPS $ renderPS a of
    (ll:ls) -> vcat (reverse ls) $$ b $$ ll
    [] -> impossible
\end{code}

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

When given the \verb!--context! flag, darcs changes outputs sufficient
information to allow the current state of the repository to be
recreated at a later date.  This information should generally be piped to a
file, and then can be used later in conjunction with
\verb!darcs get --context! to recreate the current version.  Note that
while the \verb!--context! flag may be used in conjunction with
\verb!--xml-output! or \verb!--human-readable!, in neither case will darcs
get be able to read the output.  On the other hand, sufficient information
\emph{will} be output for a knowledgeable human to recreate the current
state of the repository.
\begin{code}
changes_context :: [DarcsFlag] -> IO ()
changes_context opts = do
  r <- identifyRepository (get_repodir opts) >>= read_repo
  putStrLn "\nContext:\n"
  when (not $ null r || null (head r)) $
    putDocLnWith simplePrinters $ changelog opts' $
                 get_changes_info opts' []
                 [head $ slightly_optimize_patchset r]
    where opts' = MachineReadable : opts
\end{code}