1 %  Copyright (C) 2002-2004 David Roundy
    2 %
    3 %  This program is free software; you can redistribute it and/or modify
    4 %  it under the terms of the GNU General Public License as published by
    5 %  the Free Software Foundation; either version 2, or (at your option)
    6 %  any later version.
    7 %
    8 %  This program is distributed in the hope that it will be useful,
    9 %  but WITHOUT ANY WARRANTY; without even the implied warranty of
   10 %  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   11 %  GNU General Public License for more details.
   12 %
   13 %  You should have received a copy of the GNU General Public License
   14 %  along with this program; see the file COPYING.  If not, write to
   15 %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
   16 %  Boston, MA 02110-1301, USA.
   17 
   18 \darcsCommand{whatsnew}
   19 \begin{code}
   20 {-# OPTIONS_GHC -cpp #-}
   21 {-# LANGUAGE CPP #-}
   22 
   23 #include "gadts.h"
   24 
   25 module Darcs.Commands.WhatsNew ( whatsnew ) where
   26 import System.Exit ( ExitCode(..), exitWith )
   27 import Data.List ( sort )
   28 import Control.Monad ( when )
   29 
   30 import Darcs.Commands ( DarcsCommand(..), nodefaults )
   31 import Darcs.Arguments ( DarcsFlag(..), working_repo_dir, lookforadds,
   32                         ignoretimes, noskip_boring,
   33                         unified, summary, no_cache,
   34                          areFileArgs, fixSubPaths,
   35                         list_registered_files,
   36                       )
   37 import Darcs.RepoPath ( SubPath, sp2fn )
   38 
   39 import Darcs.Repository ( Repository, withRepository, ($-), slurp_recorded,
   40                           get_unrecorded_no_look_for_adds,
   41                           get_unrecorded_in_files, amInRepository )
   42 import Darcs.Repository.Prefs ( filetype_function )
   43 import Darcs.Diff ( unsafeDiff )
   44 import Darcs.Patch ( RepoPatch, Prim, summarize, apply_to_slurpy, is_hunk )
   45 import Darcs.Patch.Permutations ( partitionRL )
   46 import Darcs.Patch.Real ( RealPatch, prim2real )
   47 import Darcs.Patch.FileName ( fn2fp )
   48 import Darcs.PrintPatch ( printPatch, contextualPrintPatch )
   49 import Darcs.Ordered ( FL(..), mapFL_FL, reverseRL, reverseFL, (:>)(..), nullFL )
   50 
   51 import Darcs.Gorsvet( unrecordedChanges, restrictBoring, readRecordedAndPending )
   52 import Storage.Hashed.Monad( virtualTreeIO, exists )
   53 import Storage.Hashed( readPlainTree )
   54 import Storage.Hashed( floatPath )
   55 
   56 import Printer ( putDocLn, renderString, vcat, text )
   57 #include "impossible.h"
   58 
   59 whatsnew_description :: String
   60 whatsnew_description = "List unrecorded changes in the working tree."
   61 
   62 whatsnew_help :: String
   63 whatsnew_help =
   64  "The `darcs whatsnew' command lists unrecorded changes to the working\n" ++
   65  "tree.  If you specify a set of files and directories, only unrecorded\n" ++
   66  "changes to those files and directories are listed.\n" ++
   67  "\n" ++
   68  "With the --summary option, the changes are condensed to one line per\n" ++
   69  "file, with mnemonics to indicate the nature and extent of the change.\n" ++
   70  "The --look-for-adds option causes candidates for `darcs add' to be\n" ++
   71  "included in the summary output.\n" ++
   72  "\n" ++
   73  "By default, `darcs whatsnew' uses Darcs' internal format for changes.\n" ++
   74  "To see some context (unchanged lines) around each change, use the\n" ++
   75  "--unified option.  To view changes in conventional `diff' format, use\n" ++
   76  "the `darcs diff' comand; but note that `darcs whatsnew' is faster.\n" ++
   77  "\n" ++
   78  "This command exits unsuccessfully (returns a non-zero exit status) if\n" ++
   79  "there are no unrecorded changes.\n"
   80 
   81 whatsnew :: DarcsCommand
   82 whatsnew = DarcsCommand {command_name = "whatsnew",
   83                          command_help = whatsnew_help,
   84                          command_description = whatsnew_description,
   85                          command_extra_args = -1,
   86                          command_extra_arg_help = ["[FILE or DIRECTORY]..."],
   87                          command_command = whatsnew_cmd,
   88                          command_prereq = amInRepository,
   89                          command_get_arg_possibilities = list_registered_files,
   90                          command_argdefaults = nodefaults,
   91                          command_advanced_options = [ignoretimes, noskip_boring, no_cache],
   92                          command_basic_options = [summary, unified,
   93                                                  lookforadds,
   94                                                  working_repo_dir]}
   95 
   96 announce_files :: (RepoPatch p) => Repository p C(r u t) -> [SubPath] -> IO ()
   97 announce_files repo files =
   98     when (areFileArgs files) $ do
   99       nonboring <- restrictBoring
  100       working <- nonboring `fmap` readPlainTree "."
  101       pristine <- readRecordedAndPending repo
  102       let paths = map (fn2fp . sp2fn) files
  103           check = virtualTreeIO (mapM exists $ map floatPath paths)
  104       (in_working, _) <- check working
  105       (in_pending, _) <- check pristine
  106       mapM_ maybe_warn $ zip3 paths in_working in_pending
  107       putStrLn $ "What's new in "++unwords (map show files)++":\n"
  108     where maybe_warn (file, False, False) =
  109               putStrLn $ "WARNING: File '"++file++"' does not exist!"
  110           maybe_warn (file, True, False) =
  111               putStrLn $ "WARNING: File '" ++ file ++ "' not in repository!"
  112           maybe_warn _ = return ()
  113 
  114 whatsnew_cmd :: [DarcsFlag] -> [String] -> IO ()
  115 whatsnew_cmd opts' args 
  116   | LookForAdds `elem` opts' && NoSummary `notElem` opts' =
  117     -- add Summary to the opts since 'darcs whatsnew --look-for-adds'
  118     -- implies summary
  119     withRepository (Summary:opts') $- \repository -> do
  120     files <- fixSubPaths opts' args
  121     announce_files repository files
  122     all_changes <- get_unrecorded_in_files repository (map sp2fn files)
  123     chold <- get_unrecorded_no_look_for_adds repository (map sp2fn files)
  124     s <- slurp_recorded repository
  125     ftf <- filetype_function
  126     cho_adds :> _ <- return $ partitionRL is_hunk $ reverseFL chold
  127     cha :> _ <- return $ partitionRL is_hunk $ reverseFL all_changes
  128     let chn    = unsafeDiff [LookForAdds,Summary] ftf
  129                             (fromJust $ apply_to_slurpy (reverseRL cho_adds) s)                                                 
  130                             (fromJust $ apply_to_slurpy (reverseRL cha) s)                                                      
  131     exitOnNoChanges (chn, chold)
  132     putDocLn $ summarize chold
  133     printSummary chn
  134     where lower_as x = vcat $ map (text . l_as) $ lines x
  135           l_as ('A':x) = 'a':x
  136           l_as x = x
  137           exitOnNoChanges :: (FL Prim C(x y), FL p C(u v)) -> IO ()
  138           exitOnNoChanges (NilFL, NilFL) = do putStrLn "No changes!"
  139                                               exitWith $ ExitFailure 1
  140           exitOnNoChanges _ = return ()
  141           printSummary :: FL Prim C(x y) -> IO ()
  142           printSummary NilFL = return ()
  143           printSummary new = putDocLn $ lower_as $ renderString $ summarize new
  144 
  145 whatsnew_cmd opts args
  146   | otherwise =
  147     withRepository opts $- \repository -> do
  148     files <- sort `fmap` fixSubPaths opts args
  149     announce_files repository files
  150     changes <- unrecordedChanges opts repository files
  151     when (nullFL changes) $ putStrLn "No changes!" >> (exitWith $ ExitFailure 1)
  152     printSummary repository $ mapFL_FL prim2real changes
  153        where printSummary :: RepoPatch p => Repository p C(r u t) -> FL RealPatch C(r y) -> IO ()
  154              printSummary _ NilFL = do putStrLn "No changes!"
  155                                        exitWith $ ExitFailure 1
  156              printSummary r ch | Summary `elem` opts = putDocLn $ summarize ch
  157                                | Unified `elem` opts = do s <- slurp_recorded r
  158                                                           contextualPrintPatch s ch
  159                                | otherwise           = printPatch ch
  160 \end{code}