WhatsNew.lhs

%  Copyright (C) 2002-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{whatsnew}
\begin{code}
{-# OPTIONS_GHC -cpp #-}
{-# LANGUAGE CPP #-}

#include "gadts.h"

module Darcs.Commands.WhatsNew ( whatsnew ) where
import System.Exit ( ExitCode(..), exitWith )
import Data.List ( sort )
import Control.Monad ( when )

import Darcs.Commands ( DarcsCommand(..), nodefaults )
import Darcs.Arguments ( DarcsFlag(..), working_repo_dir, lookforadds,
                        ignoretimes, noskip_boring,
                        unified, summary, no_cache,
                         areFileArgs, fixSubPaths,
                        list_registered_files,
                      )
import Darcs.RepoPath ( SubPath, sp2fn )

import Darcs.Repository ( Repository, withRepository, ($-), slurp_recorded,
                          get_unrecorded_no_look_for_adds,
                          get_unrecorded_in_files, amInRepository )
import Darcs.Repository.Prefs ( filetype_function )
import Darcs.Diff ( unsafeDiff )
import Darcs.Patch ( RepoPatch, Prim, summarize, apply_to_slurpy, is_hunk )
import Darcs.Patch.Permutations ( partitionRL )
import Darcs.Patch.Real ( RealPatch, prim2real )
import Darcs.Patch.FileName ( fn2fp )
import Darcs.PrintPatch ( printPatch, contextualPrintPatch )
import Darcs.Ordered ( FL(..), mapFL_FL, reverseRL, reverseFL, (:>)(..), nullFL )

import Darcs.Gorsvet( unrecordedChanges, restrictBoring, readRecordedAndPending )
import Storage.Hashed.Monad( virtualTreeIO, exists )
import Storage.Hashed( readPlainTree )
import Storage.Hashed( floatPath )

import Printer ( putDocLn, renderString, vcat, text )
#include "impossible.h"

whatsnew_description :: String
whatsnew_description = "List unrecorded changes in the working tree."

whatsnew_help :: String
whatsnew_help =
 "The `darcs whatsnew' command lists unrecorded changes to the working\n" ++
 "tree.  If you specify a set of files and directories, only unrecorded\n" ++
 "changes to those files and directories are listed.\n" ++
 "\n" ++
 "With the --summary option, the changes are condensed to one line per\n" ++
 "file, with mnemonics to indicate the nature and extent of the change.\n" ++
 "The --look-for-adds option causes candidates for `darcs add' to be\n" ++
 "included in the summary output.  Summary mnemonics are as follows:\n" ++
 "\n" ++
 "  `A f' and `A d/' respectively mean an added file or directory.\n" ++
 "  `R f' and `R d/' respectively mean a removed file or directory.\n" ++
 "  `M f -N +M rP' means a modified file, with N lines deleted, M\n" ++
 "  lines added, and P lexical replacements.\n" ++
 "  `f -> g' means a moved file or directory.\n" ++
 "\n" ++
 "  An exclamation mark (!) as in `R! foo.c', means the hunk is known to\n" ++
 "  conflict with a hunk in another patch.  The phrase `duplicated'\n" ++
 "  means the hunk is known to be identical to a hunk in another patch.\n" ++
 "\n" ++
 "By default, `darcs whatsnew' uses Darcs' internal format for changes.\n" ++
 "To see some context (unchanged lines) around each change, use the\n" ++
 "--unified option.  To view changes in conventional `diff' format, use\n" ++
 "the `darcs diff' command; but note that `darcs whatsnew' is faster.\n" ++
 "\n" ++
 "This command exits unsuccessfully (returns a non-zero exit status) if\n" ++
 "there are no unrecorded changes.\n"

whatsnew :: DarcsCommand
whatsnew = DarcsCommand {command_name = "whatsnew",
                         command_help = whatsnew_help,
                         command_description = whatsnew_description,
                         command_extra_args = -1,
                         command_extra_arg_help = ["[FILE or DIRECTORY]..."],
                         command_command = whatsnew_cmd,
                         command_prereq = amInRepository,
                         command_get_arg_possibilities = list_registered_files,
                         command_argdefaults = nodefaults,
                         command_advanced_options = [ignoretimes, noskip_boring, no_cache],
                         command_basic_options = [summary, unified,
                                                 lookforadds,
                                                 working_repo_dir]}

announce_files :: (RepoPatch p) => Repository p C(r u t) -> [SubPath] -> IO ()
announce_files repo files =
    when (areFileArgs files) $ do
      nonboring <- restrictBoring
      working <- nonboring `fmap` readPlainTree "."
      pristine <- readRecordedAndPending repo
      let paths = map (fn2fp . sp2fn) files
          check = virtualTreeIO (mapM exists $ map floatPath paths)
      (in_working, _) <- check working
      (in_pending, _) <- check pristine
      mapM_ maybe_warn $ zip3 paths in_working in_pending
      putStrLn $ "What's new in "++unwords (map show files)++":\n"
    where maybe_warn (file, False, False) =
              putStrLn $ "WARNING: File '"++file++"' does not exist!"
          maybe_warn (file, True, False) =
              putStrLn $ "WARNING: File '" ++ file ++ "' not in repository!"
          maybe_warn _ = return ()

whatsnew_cmd :: [DarcsFlag] -> [String] -> IO ()
whatsnew_cmd opts' args 
  | LookForAdds `elem` opts' && NoSummary `notElem` opts' =
    -- add Summary to the opts since 'darcs whatsnew --look-for-adds'
    -- implies summary
    withRepository (Summary:opts') $- \repository -> do
    files <- fixSubPaths opts' args
    announce_files repository files
    all_changes <- get_unrecorded_in_files repository (map sp2fn files)
    chold <- get_unrecorded_no_look_for_adds repository (map sp2fn files)
    s <- slurp_recorded repository
    ftf <- filetype_function
    cho_adds :> _ <- return $ partitionRL is_hunk $ reverseFL chold
    cha :> _ <- return $ partitionRL is_hunk $ reverseFL all_changes
    let chn    = unsafeDiff [LookForAdds,Summary] ftf
                            (fromJust $ apply_to_slurpy (reverseRL cho_adds) s)
                            (fromJust $ apply_to_slurpy (reverseRL cha) s)
    exitOnNoChanges (chn, chold)
    putDocLn $ summarize chold
    printSummary chn
    where lower_as x = vcat $ map (text . l_as) $ lines x
          l_as ('A':x) = 'a':x
          l_as x = x
          exitOnNoChanges :: (FL Prim C(x y), FL p C(u v)) -> IO ()
          exitOnNoChanges (NilFL, NilFL) = do putStrLn "No changes!"
                                              exitWith $ ExitFailure 1
          exitOnNoChanges _ = return ()
          printSummary :: FL Prim C(x y) -> IO ()
          printSummary NilFL = return ()
          printSummary new = putDocLn $ lower_as $ renderString $ summarize new

whatsnew_cmd opts args
  | otherwise =
    withRepository opts $- \repository -> do
    files <- sort `fmap` fixSubPaths opts args
    announce_files repository files
    changes <- unrecordedChanges opts repository files
    when (nullFL changes) $ putStrLn "No changes!" >> (exitWith $ ExitFailure 1)
    printSummary repository $ mapFL_FL prim2real changes
       where printSummary :: RepoPatch p => Repository p C(r u t) -> FL RealPatch C(r y) -> IO ()
             printSummary _ NilFL = do putStrLn "No changes!"
                                       exitWith $ ExitFailure 1
             printSummary r ch | Summary `elem` opts = putDocLn $ summarize ch
                               | Unified `elem` opts = do s <- slurp_recorded r
                                                          contextualPrintPatch s ch
                               | otherwise           = printPatch ch
\end{code}