%  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.

\darcsCommand{changes}
\begin{code}
{-# OPTIONS_GHC -cpp -fglasgow-exts #-}
{-# LANGUAGE CPP, PatternGuards #-}

module Darcs.Commands.Changes ( changes ) where

import Data.List ( intersect, 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, HumanReadable, MachineReadable,
                                   Interactive, OnlyChangesToFiles, Count,
                                   NumberPatches, XMLOutput, Summary,
                                   Reverse, Verbose, Debug),
                         fixSubPaths, changes_format,
                         possibly_remote_repo_dir, get_repourl,
                         working_repo_dir, only_to_files,
                         summary, changes_reverse,
                         match_several_or_range,
                         match_maxcount, maxCount,
                         all_interactive, showFriendly,
                         network_options
                      )
import Darcs.RepoPath ( toFilePath, rootDirectory )
import Darcs.Patch.FileName ( fp2fn, fn2fp, norm_path )
import Darcs.Repository ( Repository, PatchSet, PatchInfoAnd,
                          get_unrecorded_in_files_unsorted,
                          withRepositoryDirectory, ($-), findRepository,
                          read_repo )
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.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 Printer ( Doc, putDocLnWith, simplePrinters, (<+>),
                 renderString, prefix, text, vcat, vsep, 
                 ($$), empty, errorDoc, insert_before_lastline )
import Darcs.ColorPrinter ( fancyPrinters )
import Progress ( setProgressMode, debugMessage )
import Darcs.SelectChanges ( view_changes )
import Darcs.Sealed ( unsafeUnseal )
#include "impossible.h"

changes_description :: String
changes_description = "Gives a changelog-style summary of the repository history."

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 = network_options,
                        command_basic_options = [match_several_or_range,
                                                 match_maxcount,
                                                 only_to_files,
                                                 changes_format,
                                                 summary,
                                                 changes_reverse,
                                                 possibly_remote_repo_dir,
                                                 working_repo_dir,
                                                 all_interactive]}

changes_cmd :: [DarcsFlag] -> [String] -> IO ()
changes_cmd [Context _] [] = return ()
changes_cmd opts args | Context rootDirectory `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` fixSubPaths opts args
  unrec <- if null files then return identity
             else get_unrecorded_in_files_unsorted repository (map (fp2fn . toFilePath) files)
           `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..."
  patches <- read_repo repository
  debugMessage "Done reading the repository."
  if Interactive `elem` opts
    then do let (fp_and_fs, _, _) = filtered_changes patches
                fp = map fst fp_and_fs
            view_changes opts (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
            ps <- read_repo repository -- read repo again to prevent holding onto
                                       -- values forced by filtered_changes
            putDocLnWith printers $ changelog opts ps $ 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{options}
--max-count
\end{options}

If changes is given a \verb!--max-count! option, it only outputs up to as that
number of changes.

\begin{code}
get_changes_info :: RepoPatch p => [DarcsFlag] -> [FilePath] -> PatchSet p
                 -> ([(PatchInfoAnd p, [FilePath])], [FilePath], Doc)
get_changes_info opts plain_fs ps =
  case get_common_and_uncommon (p2s,p1s) of
  (_,us:\/:_) -> filter_patches_by_names (maxCount opts) fs $ filter pf $ unsafeUnRL $ concatRL us
  where fs = map (\x -> "./" ++ x) $ plain_fs
        p1s = if first_match opts then unsafeUnseal $ match_first_patchset opts ps
                                  else NilRL:<:NilRL
        p2s = if second_match opts then unsafeUnseal $ match_second_patchset opts ps
                                   else ps
        pf = if have_nonrange_match opts
             then match_a_patchread opts
             else \_ -> True

-- | Take a list of filenames and patches and produce a list of
-- patches that actually touch the given files with list of touched
-- file names, a new file list that represents the same set of files
-- as in input, before the returned patches would have been applied,
-- and possibly an error. Additionaly, the function takes a "depth
-- limit" -- maxcount, that could be Nothing (return everything) or
-- "Just n" -- returns at most n patches touching the file (starting
-- from the beginning of the patch list).
filter_patches_by_names :: RepoPatch p =>
                           Maybe Int -- ^ maxcount
                        -> [FilePath] -- ^ filenames
                        -> [PatchInfoAnd p] -- ^ patchlist
                        -> ([(PatchInfoAnd p,[FilePath])], [FilePath], Doc)
filter_patches_by_names (Just 0) _ _ = ([], [], empty)
filter_patches_by_names _ _ [] = ([], [], empty)
filter_patches_by_names maxcount [] (hp:ps) =
    (hp, []) -:- filter_patches_by_names (subtract 1 `fmap` maxcount) [] ps
filter_patches_by_names maxcount fs (hp:ps)
    | Just p <- hopefullyM hp =
    case look_touch fs (invert p) of
    (True, []) -> ([(hp, fs)], fs, empty)
    (True, fs') -> (hp, fs) -:- filter_patches_by_names
                                (subtract 1 `fmap` maxcount) fs' ps
    (False, fs') -> filter_patches_by_names maxcount fs' ps
filter_patches_by_names _ _ (hp:_) =
    ([], [], text "Can't find changes prior to:" $$ description hp)

-- | Note, lazy pattern matching is required to make functions like
-- filter_patches_by_names lazy in case you are only not interested in
-- the first element. E.g.:
--
--   let (fs, _, _) = filter_patches_by_names ...
(-:-) :: a -> ([a],b,c) -> ([a],b,c)
x -:- ~(xs,y,z) = (x:xs,y,z)

changelog :: RepoPatch p => [DarcsFlag] -> PatchSet p -> ([(PatchInfoAnd p, [FilePath])], [FilePath], Doc)
          -> Doc
changelog opts patchset (pis_and_fs, orig_fs, errstring)
    | Count `elem` opts = text $ show $ length pis_and_fs
    | 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 (number_patch change_with_summary) pis_and_fs)
        $$ errstring
    | otherwise = vsep (map (number_patch description') pis_and_fs)
               $$ errstring
    where change_with_summary (hp, fs)
              | Just p <- hopefullyM hp = if OnlyChangesToFiles `elem` opts
                                          then description hp $$ text "" $$
                                               indent (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
                             ys | null $ ys `intersect` fs -> IsEq
                             _ -> NotEq
          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) orig_fs
          first_change = if Reverse `elem` opts
                         then info $ head pis
                         else info $ last pis
          number_patch f x = if NumberPatches `elem` opts
                             then case get_number (fst x) of
                                  Just n -> text (show n++":") <+> f x
                                  Nothing -> f x
                             else f x
          get_number :: PatchInfoAnd p -> Maybe Int
          get_number y = gn 1 (concatRL patchset)
              where iy = info y
                    gn n (b:<:bs) | seq n (info b) == iy = Just n
                                  | otherwise = gn (n+1) bs
                    gn _ NilRL = Nothing
          pis = map fst pis_and_fs
          description' = description . fst

\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
  r <- read_repo repository
  putStrLn "\nContext:\n"
  when (not $ null (unsafeUnRL r) || null (unsafeUnRL $ head $ unsafeUnRL r)) $
    putDocLnWith simplePrinters $ changelog opts' NilRL $
                 get_changes_info opts' []
                 (headRL (slightly_optimize_patchset r) :<: NilRL)
    where opts' = if HumanReadable `elem` opts || XMLOutput `elem` opts
                  then opts
                  else MachineReadable : opts
          headRL (x:<:_) = x
          headRL NilRL = impossible
\end{code}