%  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}
{-# OPTIONS_GHC -cpp -fglasgow-exts #-}
-- The pragma above is only for pattern guards.
module Darcs.Commands.Changes ( changes ) where

import Data.List ( sort )
import Data.Maybe ( fromMaybe )
import Control.Monad ( when, unless )

import Darcs.Hopefully ( hopefullyM, info )
import Darcs.Patch.Depends ( slightly_optimize_patchset )
import Darcs.Commands ( DarcsCommand(..), nodefaults )
import Darcs.Arguments ( DarcsFlag(Context, MachineReadable, Interactive,
                                   OnlyChangesToFiles, Count,
                                  XMLOutput, Summary, Reverse, Verbose, Debug),
                         getRepoPaths, changes_format,
                        possibly_remote_repo_dir, get_repourl,
                        working_repo_dir, only_to_files,
                        summary, changes_reverse,
                        match_several_or_range,
                        all_interactive, showFriendly,
                        ssh_cm
                      )
import Darcs.RepoPath ( toFilePath )
import FileName ( fp2fn, fn2fp, norm_path )
import Darcs.Repository ( Repository, PatchSet, PatchInfoAnd, get_unrecorded_unsorted,
                          withRepositoryDirectory, ($-), findRepository,
                          read_repo, slurp_recorded )
import Darcs.Patch.Info ( to_xml, showPatchInfo )
import Darcs.Patch.Depends ( get_common_and_uncommon )
import Darcs.Patch.TouchesFiles ( look_touch )
import Darcs.Patch ( RepoPatch, invert, xml_summary, description, apply_to_filepaths,
                     list_touched_files, effect, identity )
import Darcs.Patch.Ordered ( (:\/:)(..), RL(..), unsafeFL, unsafeUnRL, concatRL,
                             EqCheck(..), filterFL )
import Darcs.Match ( first_match, second_match,
               match_a_patchread, have_nonrange_match,
               match_first_patchset, match_second_patchset,
             )
import Darcs.Commands.Annotate ( created_as_xml )
import FastPackedString ( linesPS )
import Printer ( Doc, putDocLnWith, simplePrinters, renderPS,
                 renderString, prefix,
                 packedString, text, vcat, vsep, ($$), empty, errorDoc )
import Darcs.ColorPrinter ( fancyPrinters )
import Darcs.Progress ( setProgressMode, debugMessage )
import Darcs.SelectChanges ( view_changes )
import Darcs.Sealed ( Sealed(..) )
#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_advanced_options = [ssh_cm],
                        command_basic_options = [match_several_or_range,
                                                 only_to_files,
                                                changes_format,
                                                summary,
                                                changes_reverse,
                                                possibly_remote_repo_dir,
                                                working_repo_dir,
                                                all_interactive]}
\end{code}


\begin{code}
changes_cmd :: [DarcsFlag] -> [String] -> IO ()
changes_cmd [Context ""] [] = do return ()
changes_cmd opts args | Context "" `elem` opts =
  let repodir = fromMaybe "." (get_repourl opts) in
  withRepositoryDirectory opts repodir $- \repository -> do
  when (args /= []) $ fail "changes --context cannot accept other arguments"
  changes_context repository opts
changes_cmd opts args =
  let repodir = fromMaybe "." (get_repourl opts) in
  withRepositoryDirectory opts repodir $- \repository -> do
  unless (Debug `elem` opts) $ setProgressMode False
  files <- sort `fmap` getRepoPaths opts args
  unrec <- get_unrecorded_unsorted repository
           `catch` \_ -> return identity -- this is triggered when repository is remote
  let filez = map (fn2fp . norm_path . fp2fn) $ apply_to_filepaths (invert unrec) $ map toFilePath files
      filtered_changes p = maybe_reverse $ get_changes_info opts filez p
  debugMessage "About to read the repository..."
  Sealed patches <- read_repo repository
  debugMessage "Done reading the repository."
  if Interactive `elem` opts
    then do let (fp,_,_) = filtered_changes patches
            s <- slurp_recorded repository
            view_changes opts s filez (unsafeFL fp)
    else do when (not (null files) && not (XMLOutput `elem` opts)) $
                 putStrLn $ "Changes to "++unwords filez++":\n"
            debugMessage "About to print the changes..."
            let printers = if XMLOutput `elem` opts then simplePrinters else fancyPrinters
            putDocLnWith printers $ changelog opts $ filtered_changes patches
  where maybe_reverse (xs,b,c) = if Reverse `elem` opts
                                 then (reverse xs, b, c)
                                 else (xs, b, c)
\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 :: RepoPatch p => [DarcsFlag] -> [FilePath] -> PatchSet p
                 -> ([PatchInfoAnd p], [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 $ unsafeUnRL $ concatRL us
  where fs = map (\x -> "./" ++ x) $ plain_fs
        p1s = if first_match opts then match_first_patchset opts ps
                                  else NilRL:<:NilRL
        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 :: RepoPatch p => [FilePath]
                        -> [PatchInfoAnd p]
                        -> ([PatchInfoAnd p],[FilePath], Doc)
filter_patches_by_names _ [] = ([], [], empty)
filter_patches_by_names [] pps = (pps, [], empty)
filter_patches_by_names fs (hp:ps)
    | Just p <- hopefullyM hp =
    case look_touch fs (invert p) of
    (True, []) -> ([hp], fs, empty)
    (True, fs') -> hp -:- filter_patches_by_names fs' ps
    (False, fs') -> filter_patches_by_names fs' ps
filter_patches_by_names _ (hp:_) =
    ([], [], text "Can't find changes prior to:" $$ description hp)

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

changelog :: RepoPatch p => [DarcsFlag] -> ([PatchInfoAnd p], [FilePath], Doc)
          -> Doc
changelog opts (pis, fs, errstring)
    | Count `elem` opts = text $ show $ length pis
    | MachineReadable `elem` opts =
        if renderString errstring == ""
        then vsep $ map (showPatchInfo.info) pis
        else errorDoc errstring
    | XMLOutput `elem` opts =
         text "<changelog>"
      $$ vcat xml_file_names
      $$ vcat actual_xml_changes
      $$ text "</changelog>"
    | Summary `elem` opts || Verbose `elem`  opts =
           vsep (map change_with_summary pis)
        $$ errstring
    | otherwise = vsep (map description pis)
               $$ errstring
    where change_with_summary hp
              | Just p <- hopefullyM hp = if OnlyChangesToFiles `elem` opts
                                          then description hp $$
                                               showFriendly opts (filterFL xx $ effect p)
                                          else showFriendly opts p
              | otherwise = description hp
                            $$ indent (text "[this patch is unavailable]")
              where xx x = case list_touched_files x of
                             [z] | z `elem` fs -> NotEq
                             _ -> IsEq
          xml_with_summary hp
              | Just p <- hopefullyM hp = insert_before_lastline
                                           (to_xml $ info hp) (indent $ xml_summary p)
          xml_with_summary hp = to_xml (info hp)
          indent = prefix "    "
          actual_xml_changes = if Summary `elem` opts
                               then map xml_with_summary pis
                               else map (to_xml.info) pis
          xml_file_names = map (created_as_xml first_change) fs
          first_change = if Reverse `elem` opts
                         then info $ head pis
                         else info $ 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 :: RepoPatch p => Repository p -> [DarcsFlag] -> IO ()
changes_context repository opts = do
  Sealed r <- read_repo repository
  putStrLn "\nContext:\n"
  when (not $ null (unsafeUnRL r) || null (unsafeUnRL $ head $ unsafeUnRL r)) $
    putDocLnWith simplePrinters $ changelog opts' $
                 get_changes_info opts' []
                 (headRL (slightly_optimize_patchset r) :<: NilRL)
    where opts' = MachineReadable : opts
          headRL (x:<:_) = x
          headRL NilRL = impossible
\end{code}