src/Darcs/Commands/WhatsNew.lhs

   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 \subsection{darcs whatsnew}
  19 \label{whatsnew}
  20 \begin{code}
  21 {-# OPTIONS_GHC -cpp #-}
  22 {-# LANGUAGE CPP #-}
  23
  24 #include "gadts.h"
  25
  26 module Darcs.Commands.WhatsNew ( whatsnew ) where
  27 import System.Exit ( ExitCode(..), exitWith )
  28 import Data.List ( sort )
  29 import Control.Monad ( when )
  30
  31 import Darcs.Commands ( DarcsCommand(..), nodefaults )
  32 import Darcs.Arguments ( DarcsFlag(..), working_repo_dir, lookforadds,
  33                         ignoretimes, noskip_boring,
  34                         unified,
  35                          areFileArgs, fixSubPaths,
  36                         list_registered_files,
  37                       )
  38 import Darcs.Arguments ( summary )
  39 import Darcs.Patch.TouchesFiles ( choose_touching )
  40 import Darcs.RepoPath ( toFilePath )
  41 import Darcs.Repository ( Repository, withRepository, ($-), slurp_recorded,
  42                           get_unrecorded, get_unrecorded_no_look_for_adds, amInRepository )
  43 import Darcs.Repository.Prefs ( filetype_function )
  44 import Darcs.Diff ( unsafeDiff )
  45 import Darcs.Patch ( RepoPatch, Prim, summarize, apply_to_slurpy, is_hunk,
  46                      invert, apply_to_filepaths )
  47 import Darcs.Patch.Permutations ( partitionRL )
  48 import Darcs.Patch.Real ( RealPatch, prim2real )
  49 import Darcs.PrintPatch ( printPatch, contextualPrintPatch )
  50 import Darcs.Ordered ( FL(..), mapFL_FL, reverseRL, reverseFL, (:>)(..), nullFL )
  51 import Darcs.Sealed ( Sealed(..), unseal, mapSeal )
  52 import Printer ( putDocLn, renderString, vcat, text )
  53 #include "impossible.h"
  54 \end{code}
  55
  56 \options{whatsnew}
  57
  58 \haskell{whatsnew_description}
  59 \begin{code}
  60 whatsnew_description :: String
  61 whatsnew_description = "Display unrecorded changes in the working copy."
  62 \end{code}
  63 \haskell{whatsnew_help} \verb!darcs whatsnew! will return a non-zero value if
  64 there are no changes, which can be useful if you just want to see in a
  65 script if anything has been modified.  If you want to see some context
  66 around your changes, you can use the \verb!-u! option, to get output
  67 similar to the unidiff format.
  68
  69 \begin{code}
  70 whatsnew_help :: String
  71 whatsnew_help =
  72  "whatsnew gives you a view of what changes you've made in your working\n"++
  73  "copy that haven't yet been recorded.  The changes are displayed in\n"++
  74  "darcs patch format. Note that --look-for-adds implies --summary usage.\n"
  75 \end{code}
  76
  77 \begin{code}
  78 whatsnew :: DarcsCommand
  79 whatsnew = DarcsCommand {command_name = "whatsnew",
  80                          command_help = whatsnew_help,
  81                          command_description = whatsnew_description,
  82                          command_extra_args = -1,
  83                          command_extra_arg_help = ["[FILE or DIRECTORY]..."],
  84                          command_command = whatsnew_cmd,
  85                          command_prereq = amInRepository,
  86                          command_get_arg_possibilities = list_registered_files,
  87                          command_argdefaults = nodefaults,
  88                          command_advanced_options = [ignoretimes, noskip_boring],
  89                          command_basic_options = [summary, unified,
  90                                                  lookforadds,
  91                                                  working_repo_dir]}
  92 \end{code}
  93
  94 \begin{code}
  95 whatsnew_cmd :: [DarcsFlag] -> [String] -> IO ()
  96 whatsnew_cmd opts' args
  97   | LookForAdds `elem` opts' && NoSummary `notElem` opts' =
  98     -- add Summary to the opts since 'darcs whatsnew --look-for-adds'
  99     -- implies summary
 100     withRepository (Summary:opts') $- \repository -> do
 101     files <- fixSubPaths opts' args
 102     when (areFileArgs files) $
 103          putStrLn $ "What's new in "++unwords (map show files)++":\n"
 104     all_changes <- get_unrecorded repository
 105     chold <- get_unrecorded_no_look_for_adds repository
 106     s <- slurp_recorded repository
 107     ftf <- filetype_function
 108     let pre_changed_files = apply_to_filepaths (invert chold) $ map toFilePath files
 109         select_files = choose_touching pre_changed_files
 110     Sealed cho <- return $ select_files chold
 111     cho_adds :> _ <- return $ partitionRL is_hunk $ reverseFL cho
 112     Sealed all_fs <- return $ select_files all_changes
 113     cha :> _ <- return $ partitionRL is_hunk $ reverseFL all_fs
 114     let chn    = unsafeDiff [LookForAdds,Summary] ftf
 115                             (fromJust $ apply_to_slurpy (reverseRL cho_adds) s)
 116                             (fromJust $ apply_to_slurpy (reverseRL cha) s)
 117     exitOnNoChanges (chn, cho)
 118     putDocLn $ summarize cho
 119     printSummary chn
 120     where lower_as x = vcat $ map (text . l_as) $ lines x
 121           l_as ('A':x) = 'a':x
 122           l_as x = x
 123           exitOnNoChanges :: (FL Prim C(x y), FL p C(u v)) -> IO ()
 124           exitOnNoChanges (NilFL, NilFL) = do putStrLn "No changes!"
 125                                               exitWith $ ExitFailure 1
 126           exitOnNoChanges _ = return ()
 127           printSummary :: FL Prim C(x y) -> IO ()
 128           printSummary NilFL = return ()
 129           printSummary new = putDocLn $ lower_as $ renderString $ summarize new
 130
 131 whatsnew_cmd opts args =  withRepository opts $- \repository -> do
 132     files <- sort `fmap` fixSubPaths opts args
 133     when (areFileArgs files) $
 134          putStrLn $ "What's new in "++unwords (map show files)++":\n"
 135     changes <- get_unrecorded repository
 136     when (nullFL changes) $ putStrLn "No changes!" >> (exitWith $ ExitFailure 1)
 137     let pre_changed_files = apply_to_filepaths (invert changes) $ map toFilePath files
 138     unseal (printSummary repository) $ mapSeal (mapFL_FL prim2real) $ choose_touching pre_changed_files changes
 139        where printSummary :: RepoPatch p => Repository p C(r u t) -> FL RealPatch C(r y) -> IO ()
 140              printSummary _ NilFL = do putStrLn "No changes!"
 141                                        exitWith $ ExitFailure 1
 142              printSummary r ch = if Summary `elem` opts
 143                                  then putDocLn $ summarize ch
 144                                  else if Unified `elem` opts
 145                                       then do s <- slurp_recorded r
 146                                               contextualPrintPatch s ch
 147                                       else printPatch ch
 148 \end{code}
 149
 150 If you give one or more file or directory names as an argument to
 151 \verb!whatsnew!, darcs will output only changes to those files or to files in
 152 those directories.