% Copyright (C) 20022004 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 021101301, USA.
\subsection{darcs whatsnew}
\label{whatsnew}
\begin{code}
#include "gadts.h"
module Darcs.Commands.WhatsNew ( whatsnew ) where
import System.Exit ( ExitCode(..), exitWith )
import System.Directory ( doesFileExist )
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,
areFileArgs, fixSubPaths,
list_registered_files,
)
import Darcs.Patch.FileName ( encode_white )
import Darcs.RepoPath ( SubPath, toFilePath, sp2fn )
import Darcs.Repository ( Repository, withRepository, ($-), slurp_recorded,
get_unrecorded_no_look_for_adds,
get_unrecorded_in_files, amInRepository )
import Darcs.Repository.Internal ( slurp_recorded_and_unrecorded )
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.PrintPatch ( printPatch, contextualPrintPatch )
import Darcs.Ordered ( FL(..), mapFL_FL, reverseRL, reverseFL, (:>)(..), nullFL )
import Darcs.SlurpDirectory( Slurpy, slurp_has )
import Printer ( putDocLn, renderString, vcat, text )
#include "impossible.h"
\end{code}
\options{whatsnew}
\haskell{whatsnew_description}
\begin{code}
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.\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' comand; 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],
command_basic_options = [summary, unified,
lookforadds,
working_repo_dir]}
whatsnew_cmd :: [DarcsFlag] -> [String] -> IO ()
whatsnew_cmd opts' args
| LookForAdds `elem` opts' && NoSummary `notElem` opts' =
withRepository (Summary:opts') $- \repository -> do
files <- fixSubPaths opts' args
when (areFileArgs files)
(do slurps <- slurp_recorded_and_unrecorded repository
warn_if_bogus slurps files
putStrLn $ "What's new in "++unwords (map show files)++":\n")
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
when (areFileArgs files)
(do slurps <- slurp_recorded_and_unrecorded repository
warn_if_bogus slurps files
putStrLn $ "What's new in "++unwords (map show files)++":\n")
changes <- get_unrecorded_in_files repository (map sp2fn 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 = if Summary `elem` opts
then putDocLn $ summarize ch
else if Unified `elem` opts
then do s <- slurp_recorded r
contextualPrintPatch s ch
else printPatch ch
warn_if_bogus :: (Slurpy,Slurpy) -> [SubPath] -> IO()
warn_if_bogus _ [] = return ()
warn_if_bogus (rec, pend) (f:fs) =
do exist <- doesFileExist file
if exist then when (not (slurp_has fp rec) || (slurp_has fp pend))$
putStrLn $ "WARNING: File '"
++file++"' not in repository!"
else putStrLn $ "WARNING: File '"++file++"' does not exist!"
warn_if_bogus (rec, pend) fs
where fp = toFilePath f
file = encode_white fp
\end{code}