#include "gadts.h"
module Darcs.Commands.WhatsNew
(
whatsnew
, status
) where
import Control.Applicative ( (<$>) )
import Data.List ( delete )
import System.Exit ( ExitCode(..), exitWith )
import Storage.Hashed.Tree( Tree )
import Darcs.Arguments ( DarcsFlag(..), workingRepoDir, lookforadds,
ignoretimes, noskipBoring, unified, summary,
fixSubPaths, listRegisteredFiles )
import Darcs.Commands ( DarcsCommand(..), nodefaults, commandAlias )
import Darcs.Commands.Util ( announceFiles )
import Darcs.Diff( treeDiff )
import Darcs.Flags( isUnified, diffingOpts )
import Darcs.Patch ( RepoPatch, PrimPatch, PrimOf, plainSummaryPrims,
primIsHunk, applyToTree )
import Darcs.Patch.Apply( ApplyState )
import Darcs.Patch.Format ( PatchListFormat(..) )
import Darcs.Patch.FileHunk ( IsHunk(..) )
import Darcs.Patch.Patchy ( Patchy )
import Darcs.Patch.Permutations ( partitionRL )
import Darcs.Patch.Prim.Class ( PrimDetails(..) )
import Darcs.Patch.TouchesFiles( choosePreTouching )
import Darcs.RepoPath( SubPath, toFilePath )
import Darcs.Repository ( Repository, withRepository, RepoJob(..)
, amInRepository
, unrecordedChanges, readRecorded )
import Darcs.Repository.Prefs ( filetypeFunction )
import Darcs.PrintPatch ( printPatch, contextualPrintPatch )
import Darcs.Witnesses.Ordered ( FL(..), reverseRL, reverseFL, (:>)(..) )
import Darcs.Witnesses.Sealed ( Sealed(..), unFreeLeft )
import Printer ( putDocLn, renderString, vcat, text )
whatsnew :: DarcsCommand
whatsnew = DarcsCommand { commandProgramName = "darcs"
, commandName = "whatsnew"
, commandHelp = whatsnewHelp
, commandDescription = whatsnewDescription
, commandExtraArgs = 1
, commandExtraArgHelp = ["[FILE or DIRECTORY]..."]
, commandCommand = whatsnewCmd
, commandPrereq = amInRepository
, commandGetArgPossibilities = listRegisteredFiles
, commandArgdefaults = nodefaults
, commandAdvancedOptions = [ignoretimes, noskipBoring]
, commandBasicOptions = [ summary
, unified
, lookforadds
, workingRepoDir
]
}
whatsnewDescription :: String
whatsnewDescription = "List unrecorded changes in the working tree."
whatsnewHelp :: String
whatsnewHelp =
"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" ++
" `a f' and `a d/' respectively mean a new, but unadded, file or\n" ++
" directory, when using --look-for-adds.\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"
whatsnewCmd :: [DarcsFlag] -> [String] -> IO ()
whatsnewCmd opts args =
withRepository opts $ RepoJob $ \(repo :: Repository p C(r u r)) -> do
files <- if null args
then return Nothing
else Just <$> fixSubPaths opts args
let isLookForAdds = LookForAdds `elem` opts && NoSummary `notElem` opts
optsModifier = if isLookForAdds
then (Summary :) . (LookForAdds `delete`)
else id
opts' = optsModifier opts
Sealed noLookChanges <- filteredUnrecordedChanges opts' repo files
pristine <- readRecorded repo
Sealed unaddedNewPathsPs <- if isLookForAdds
then do
Sealed lookChanges <- filteredUnrecordedChanges opts repo files
noLookAddsTree <- applyAddPatchesToPristine noLookChanges pristine
lookAddsTree <- applyAddPatchesToPristine lookChanges pristine
ftf <- filetypeFunction
unFreeLeft <$> treeDiff ftf noLookAddsTree lookAddsTree
else return (Sealed NilFL)
announceFiles files "What's new in"
exitOnNoChanges (unaddedNewPathsPs, noLookChanges)
printChanges opts' pristine noLookChanges
printUnaddedPaths unaddedNewPathsPs
where
applyAddPatchesToPristine ps pristine = do
adds :> _ <- return $ partitionRL primIsHunk $ reverseFL ps
applyToTree (reverseRL adds) pristine
exitOnNoChanges :: (FL p C(x y), FL p C(u v)) -> IO ()
exitOnNoChanges (NilFL, NilFL) = do putStrLn "No changes!"
exitWith $ ExitFailure 1
exitOnNoChanges _ = return ()
printUnaddedPaths :: PrimPatch p => FL p C(x y) -> IO ()
printUnaddedPaths NilFL = return ()
printUnaddedPaths ps =
putDocLn . lowercaseAs . renderString . plainSummaryPrims $ ps
lowercaseAs x = vcat $ map (text . lowercaseA) $ lines x
lowercaseA ('A' : x) = 'a' : x
lowercaseA x = x
printChanges :: (PatchListFormat p, IsHunk p, Patchy p, PrimDetails p,
ApplyState p ~ Tree) => [DarcsFlag] -> Tree IO -> FL p C(x y)
-> IO ()
printChanges opts' pristine changes
| Summary `elem` opts' = putDocLn $ plainSummaryPrims changes
| isUnified opts' = contextualPrintPatch pristine changes
| otherwise = printPatch changes
filteredUnrecordedChanges :: (RepoPatch p, ApplyState p ~ Tree,
ApplyState (PrimOf p) ~ Tree) => [DarcsFlag]
-> Repository p C(r u t) -> Maybe [SubPath]
-> IO (Sealed (FL (PrimOf p) C(t)))
filteredUnrecordedChanges opts' repo files =
let filePaths = map toFilePath <$> files in
let diffOpts = diffingOpts opts' in
choosePreTouching filePaths <$> unrecordedChanges diffOpts repo files
status :: DarcsCommand
status = statusAlias { commandCommand = statusCmd
, commandDescription = statusDesc
}
where
statusAlias = commandAlias "status" Nothing whatsnew
statusCmd fs = commandCommand whatsnew (Summary : LookForAdds : fs)
statusDesc = "Alias for `darcs " ++ commandName whatsnew ++ " -ls '."