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

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

import Darcs.Hopefully ( Hopefully, hopefully, hopefully2either, actually )
import Darcs.Patch.Depends ( slightly_optimize_patchset )
import Darcs.Commands ( DarcsCommand(..), nodefaults )
import Darcs.Arguments ( 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 Darcs.Repository ( PatchSet, identifyRepository, findRepository, read_repo,
                    slurp_recorded )
import Darcs.Patch.Info ( PatchInfo, human_friendly, to_xml, showPatchInfo, )
import Darcs.Patch.Show ( showUnnamed )
import Darcs.Patch.Depends ( get_common_and_uncommon )
import Darcs.Patch.TouchesFiles ( look_touch )
import Darcs.Patch ( Patch, invert, patch_summary, xml_summary )
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 Darcs.URL ( is_url )
import FastPackedString ( linesPS )
import Printer ( Doc, putDocLnWith, simplePrinters, renderPS,
                 renderString, prefix,
                 packedString, text, vcat, vsep, ($$), empty, errorDoc )
import ColourPrinter ( fancyPrinters )
import Darcs.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 =
  -- There possibilities for repodir
  --  1. no flags (then the findRepository prereq has already cd'd the right place
  --  2. --repodir or --repo with a directory (see #1)
  --  3. --repo with a URL (then have to grab the url)
  let repodir = if hasRepoURL 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 opts repodir
  patches <- read_repo repository
  if Interactive `elem` opts
    then let (fp,_,_) = filtered_changes patches
             patches' = map hopefully 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)
  
hasRepoURL :: [DarcsFlag] -> Bool
hasRepoURL [] = False 
hasRepoURL (RepoDir d:_) | is_url d = True
hasRepoURL (_:fs) = hasRepoURL 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, Hopefully 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, Hopefully Patch)]
                        -> ([(PatchInfo, Hopefully Patch)],[FilePath], Doc)
filter_patches_by_names _ [] = ([], [], empty)
filter_patches_by_names [] pps = (pps, [], empty)
filter_patches_by_names fs ((pinfo, hp):ps)
    | Right p <- hopefully2either hp =
    case look_touch fs (invert p) of
    (True, []) -> ([(pinfo, actually p)], fs, empty)
    (True, fs') -> (pinfo, actually p) -:- filter_patches_by_names fs' ps
    (False, fs') -> filter_patches_by_names fs' ps
filter_patches_by_names _ ((pinf, _):_) =
    ([], [], 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, Hopefully 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, hp)
              | Right p <- hopefully2either hp = human_friendly pinfo
                                                 $$ text ""
                                                 $$ indent (show_patch p)
          change_with_summary _ (pinfo, _)   = human_friendly pinfo
                                               $$ indent (text "[this patch is unavailable]")
          xml_with_summary (pinfo, hp)
              | Right p <- hopefully2either hp = insert_before_lastline
                                                 (to_xml pinfo) (indent $ xml_summary p)
          xml_with_summary (pinfo, _) = 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 opts (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}
