packages feed

darcs 2.10.0 → 2.10.1

raw patch · 23 files changed

+420/−204 lines, 23 filesdep +network-uridep ~QuickCheckdep ~attoparsecdep ~networkPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: network-uri

Dependency ranges changed: QuickCheck, attoparsec, network, shelly, terminfo, zlib

API changes (from Hackage documentation)

+ Darcs.UI.Commands.Dist: doFastZip' :: [DarcsFlag] -> FilePath -> (ByteString -> IO a) -> IO a
+ Darcs.Util.Printer: debugDocLn :: Doc -> IO ()
- Darcs.UI.Defaults: applyDefaults :: Maybe String -> DarcsCommand pf -> [DarcsFlag] -> IO [DarcsFlag]
+ Darcs.UI.Defaults: applyDefaults :: Maybe String -> DarcsCommand pf -> AbsolutePath -> [String] -> [String] -> [DarcsFlag] -> ([DarcsFlag], [String])

Files

darcs.cabal view
@@ -1,5 +1,5 @@ Name:           darcs-version:        2.10.0+version:        2.10.1 License:        GPL License-file:   COPYING Author:         David Roundy <droundy@darcs.net>, <darcs-devel@darcs.net>@@ -112,6 +112,7 @@  flag warn-as-error   default:     False+  manual:      True   description: Build with warnings-as-errors  -- To allow building with containers < 0.5, we keep a local copy of this@@ -136,6 +137,10 @@ flag use-time-1point5     default: False +flag network-uri+  description: Get Network.URI from the network-uri package+  default: True+ -- ---------------------------------------------------------------------- -- darcs library -- ----------------------------------------------------------------------@@ -435,7 +440,7 @@                      vector       >= 0.7 && < 0.11,                      tar          == 0.4.*,                      data-ordlist == 0.4.*,-                     attoparsec   >= 0.11 && < 0.13,+                     attoparsec   >= 0.11 && < 0.14,                      zip-archive  >= 0.2.3 && < 0.3      if !os(windows)@@ -487,8 +492,11 @@         includes:          curl/curl.h      if flag(http)-        build-depends:    network >= 2.3 && < 2.5,-                          HTTP    >= 4000.2.3 && < 4000.3+        if flag(network-uri)+          build-depends:    network-uri == 2.6.*, network == 2.6.*+        else+          build-depends:    network >= 2.3 && < 2.6+        build-depends:    HTTP    >= 4000.2.3 && < 4000.3         cpp-options:      -DHAVE_HTTP         x-have-http: @@ -497,11 +505,11 @@      build-depends:    mmap >= 0.5 && < 0.6 -    build-depends:    zlib >= 0.5.3.0 && < 0.6.0.0+    build-depends:    zlib >= 0.5.3.0 && < 0.7.0.0      -- The terminfo package cannot be built on Windows.     if flag(terminfo) && !os(windows)-      build-depends:    terminfo == 0.3.*+      build-depends:    terminfo >= 0.3 && < 0.5       cpp-options:      -DHAVE_TERMINFO      -- if true to work around cabal bug with flag ordering@@ -652,12 +660,12 @@                    mtl          >= 2.1 && < 2.3,                    parsec       >= 3.1 && < 3.2,                    regex-compat-tdfa >= 0.95.1 && < 0.96,-                   shelly       >= 1.6 && < 1.7,+                   shelly       >= 1.6.2 && < 1.7,                    split        >= 0.1.4.1 && < 0.3,                    text         >= 0.11.0.6 && < 1.3,                    directory    >= 1.1.0.2 && < 1.3.0.0,                    FindBin      >= 0.0 && < 0.1,-                   QuickCheck   >= 2.3 && < 2.8,+                   QuickCheck   >= 2.3 && < 2.9,                    HUnit        >= 1.0 && < 1.3,                    test-framework             >= 0.4.0 && < 0.9,                    test-framework-hunit       >= 0.2.2 && < 0.4,
harness/Darcs/Test/Patch.hs view
@@ -366,7 +366,7 @@             , testGroup "Darcs.Patch.V2 (using Prim.V1)" $                 unit_V2P1 ++ qc_V2 (undefined :: V1.Prim wX wY) ++ qc_V2P1 ++                 general_patchTests (PatchType :: PatchType (RealPatch V1.Prim))-            , testGroup "Darcs.Patch.Prim.V3" $ qc_prim (undefined :: V3.Prim wX wY)+            -- , testGroup "Darcs.Patch.Prim.V3" $ qc_prim (undefined :: V3.Prim wX wY)             , testGroup "Darcs.Patch.V2 (using Prim.V3)" $                 qc_V2 (undefined :: V3.Prim wX wY) ++                 general_patchTests (PatchType :: PatchType (RealPatch V3.Prim))
harness/test.hs view
@@ -86,7 +86,8 @@      setenv "GHC_VERSION" $ pack $ show (__GLASGOW_HASKELL__ :: Int)      mkdir ".darcs"      writefile ".darcs/defaults" defaults-     _ <- Shelly.run "bash" [ "test" ]+     _ <- onCommandHandles (initOutputHandles (\h -> hSetBinaryMode h True)) $+          Shelly.run "bash" [ "test" ]      return Success    `catch_sh` \(_::SomeException)                  -> do code <- lastExitCode
hashed-storage/Storage/Hashed/Monad.hs view
@@ -192,12 +192,8 @@     expandTo p =         do t <- gets tree            p' <- (`catPaths` p) `fmap` ask-           let amend = do t' <- lift $ expandPath t p'-                          modify $ \st -> st { tree = t' }-           case find t p' of-             Nothing -> amend-             Just (Stub _ _) -> amend-             _ -> return ()+           t' <- lift $ expandPath t p'+           modify $ \st -> st { tree = t' }            return p'      fileExists p =
hashed-storage/Storage/Hashed/Test.hs view
@@ -324,7 +324,7 @@               (Just LT == runIdentity (t2 `cmpExpandedShape` t1)) ==>               runIdentity $ (t1 `overlay` t2) `expandedShapeEq` t1           prop_overlay_super (t1 :: Tree Identity, t2) =-              (Just LT == runIdentity (t2 `cmpExpandedShape` t1)) ==>+              (Just LT == runIdentity (t2 `cmpExpandedShape` t1)) && no_stubs t2 ==>               Just EQ == (runIdentity $ restrict t2 (t1 `overlay` t2) `cmpTree` t2)           prop_expandPath (TreeWithPath t p) =               notStub $ find (runIdentity $ expandPath t p) p
release/distributed-context view
@@ -1,1 +1,1 @@-Just "\nContext:\n\n[TAG 2.10.0\nGuillaume Hoffmann <guillaumh@gmail.com>**20150419200705\n Ignore-this: 6d154c9aa51c8328c777ca9a2c223125\n] \n"+Just "\nContext:\n\n[TAG 2.10.1\nGuillaume Hoffmann <guillaumh@gmail.com>**20150709164849\n Ignore-this: 91f5dd97c5899801364cdfc0a8266faa\n] \n"
src/Darcs/Patch/Match.hs view
@@ -379,7 +379,7 @@ -- true, but not @--from-patch@ or @--to-patch@. haveNonrangeMatch :: forall p . Matchable p => PatchType p -> [MatchFlag] -> Bool haveNonrangeMatch _ fs =-     isJust (hasIndexRange fs)+     case hasIndexRange fs of Just (m,n) | m == n -> True; _ -> False   || isJust (nonrangeMatcher fs::Maybe (Matcher p))  -- | @havePatchsetMatch flags@ tells whether there is a "patchset
src/Darcs/Repository.hs view
@@ -667,23 +667,20 @@             unpackTar c mh xs   _ -> fail "Unexpected non-file tar entry"  where-  writeFile' Nothing z y = withTemp $ \x' -> do-    BL.writeFile x' y-    renameFile x' z-  writeFile' (Just ca) z y = do-    let fileFullPath = case splitPath z of+  writeFile' Nothing path content = withTemp $ \tmp -> do+    BL.writeFile tmp content+    renameFile tmp path+  writeFile' (Just ca) path content = do+    let fileFullPath = case splitPath path of           _:hDir:hFile:_  -> joinPath [ca, hDir, bucketFolder hFile, hFile]           _               -> fail "Unexpected file path"-    ex <- doesFileExist fileFullPath-    if ex-    then createLink' fileFullPath z-    else withTemp $ \x'' -> do-      BL.writeFile x'' y-      createLink' x'' fileFullPath-      renameFile x'' z-  createLink' z y = do-    createDirectoryIfMissing True $ takeDirectory y-    createLink z y `catchall` return ()+    createDirectoryIfMissing True $ takeDirectory path+    createLink fileFullPath path `catch` (\(ex :: IOException) -> do+      if isAlreadyExistsError ex then+        return () -- so much the better+      else+        -- ignore cache if we cannot link+        writeFile' Nothing path content)  basicMetaHandler :: Cache -> MVar () -> IO () basicMetaHandler ca mv = do
src/Darcs/Repository/Match.hs view
@@ -32,6 +32,8 @@     , getMatchingTag     , matchAPatchset     , nonrangeMatcher+    , applyNInv+    , hasIndexRange     , MatchFlag(..)     ) @@ -58,7 +60,11 @@                  => Repository p wR wU wT                  -> [MatchFlag]                  -> IO ()-getNonrangeMatch r fs = withRecordedMatch r (getNonrangeMatchS fs)+getNonrangeMatch r = withRecordedMatch r . getMatch where+  getMatch fs = case hasIndexRange fs of+    Just (n, m) | n == m -> applyNInv (n-1)+                | otherwise -> fail "Index range is not allowed for this command."+    _ -> getNonrangeMatchS fs  getPartialNonrangeMatch :: (RepoPatch p, ApplyMonad DefaultIO (ApplyState p), ApplyState p ~ Tree)                         => Repository p wR wU wT
src/Darcs/UI/Commands.hs view
@@ -231,6 +231,8 @@     , "Use 'darcs --exact-version' to see a detailed darcs version."     , "Use 'darcs help patterns' for help on patch matching."     , "Use 'darcs help environment' for help on environment variables."+    , "Use 'darcs help manpage' to display help in the manpage format."+    , "Use 'darcs help markdown' to display help in the markdown format."     , ""     , "Check bug reports at http://bugs.darcs.net/"     ]
src/Darcs/UI/Commands/Diff.hs view
@@ -28,7 +28,9 @@ import Data.List ( (\\) ) import Storage.Hashed.Plain( writePlainTree ) import Storage.Hashed.Darcs( hashedTreeIO )-+import Data.Maybe ( isJust )+import System.Directory ( findExecutable )+                           import Darcs.Util.CommandLine ( parseCmd ) import Darcs.UI.External     ( diffProgram@@ -248,15 +250,22 @@           rundiff f1 f2 = do             cmd <- diffProgram             case getDiffCmdAndArgs cmd opts f1 f2 of-             Left err -> fail err-             Right (d_cmd, d_args) ->-              let pausingForGui = (wantGuiPause opts == YesWantGuiPause) in-              do when pausingForGui $ putStrLn $-                   "Running command '" ++ unwords (d_cmd:d_args) ++ "'"-                 output <- execPipeIgnoreError Encode d_cmd d_args empty-                 when pausingForGui $-                    askEnter "Hit return to move on..."-                 return output+              Left err -> fail err+              Right (d_cmd, d_args) -> do+                if length (filter (==f1) d_args) /= 1 || length (filter (==f2) d_args) /= 1+                    then fail $ "Invalid argument (%1 or %2) in --diff-command"+                    else return ()+                cmdExists <- findExecutable d_cmd+                if isJust cmdExists+                    then return ()+                    else fail $ d_cmd ++ " is not an executable in --diff-command"+                let pausingForGui = (wantGuiPause opts == YesWantGuiPause) in+                  do when pausingForGui $ putStrLn $+                       "Running command '" ++ unwords (d_cmd:d_args) ++ "'"+                     output <- execPipeIgnoreError Encode d_cmd d_args empty+                     when pausingForGui $+                        askEnter "Hit return to move on..."+                     return output  getDiffInfo :: RepoPatch p => [DarcsFlag] -> PatchSet p wStart wX -> [PatchInfo] getDiffInfo opts ps =
src/Darcs/UI/Commands/Dist.hs view
@@ -27,6 +27,7 @@     (       dist     , doFastZip -- libdarcs export+    , doFastZip'     ) where  import Prelude hiding ( (^), writeFile )@@ -70,7 +71,7 @@     ( getFirstMatch     , getNonrangeMatch     )-import Darcs.Repository ( withRepository, RepoJob(..),+import Darcs.Repository ( withRepository, withRepositoryDirectory, RepoJob(..),                           setScriptsExecutable, repoPatchType,                           createPartialsPristineDirectoryTree ) import Darcs.Repository.Prefs ( getPrefval )@@ -214,19 +215,28 @@  doFastZip :: [DarcsFlag]           -> IO ()-doFastZip opts =  withRepository (useCache opts) $ RepoJob $ \(Repo _ _ _ c) -> do-  when (SetScriptsExecutable `elem` opts) $-    putStrLn "WARNING: Zip archives cannot store executable flag."+doFastZip opts = do   currentdir <- getCurrentDirectory-  let distname = getDistName currentdir [x | DistName x <- opts]-  i <- fetchFilePS (darcsdir </> "hashed_inventory") Uncachable+  let distname = getDistName currentdir [x | DistName x <- opts]  +  let resultfile = currentdir </> distname ++ ".zip"+  doFastZip' opts currentdir (writeFile resultfile)+  when (Quiet `notElem` opts) $ putStrLn $ "Created " ++ resultfile++doFastZip' :: [DarcsFlag]              -- ^ Flags/options+           -> FilePath                 -- ^ The path to the repository+           -> (BL.ByteString -> IO a)  -- ^ An action to perform on the archive contents+           -> IO a+doFastZip' opts path act = withRepositoryDirectory (useCache opts) path $ RepoJob $ \(Repo _ _ _ c) -> do+  when (SetScriptsExecutable `elem` opts) $+    putStrLn "WARNING: Zip archives cannot store executable flag."  +  let distname = getDistName path [x | DistName x <- opts]+  i <- fetchFilePS (path </> darcsdir </> "hashed_inventory") Uncachable   pristine <- pathsAndContents (distname ++ "/") c (inv2pris i)   epochtime <- toSeconds `fmap` getCurrentTime-  let entries = [ toEntry path epochtime (toLazy contents) | (path,contents) <- pristine ]+  let entries = [ toEntry filepath epochtime (toLazy contents) | (filepath,contents) <- pristine ]   let archive = foldr addEntryToArchive emptyArchive entries-  let resultfile = currentdir </> distname ++ ".zip"-  writeFile resultfile $ fromArchive archive-  when (Quiet `notElem` opts) $ putStrLn $ "Created " ++ resultfile+  act (fromArchive archive)+  toLazy :: B.ByteString -> BL.ByteString toLazy bs = BL.fromChunks [bs]
src/Darcs/UI/Commands/Log.hs view
@@ -49,12 +49,13 @@ import Darcs.UI.Options ( DarcsOption, (^), odesc, ocheck, onormalise, defaultFlags, parseFlags ) import qualified Darcs.UI.Options.All as O import Darcs.Util.Path ( SubPath(), toFilePath,-                    fp2fn, fn2fp, normPath, AbsolutePath )+                    fp2fn, fn2fp, normPath, AbsolutePath, simpleSubPath ) import Darcs.Repository ( PatchSet, PatchInfoAnd,                           withRepositoryDirectory, RepoJob(..),                           readRepo, unrecordedChanges,                           withRepoLockCanFail ) import Darcs.Repository.Flags ( UseIndex(..), ScanKnown(..), DiffAlgorithm(MyersDiff), UpdateWorking(..) )+import Darcs.Repository.Lock ( withTempDir ) import Darcs.Patch.Set ( PatchSet(..), newset2RL ) import Darcs.Patch.Conflict ( Conflict, CommuteNoConflicts ) import Darcs.Patch.Format ( PatchListFormat )@@ -88,6 +89,7 @@                  vsep, (<>), ($$), errorDoc, insertBeforeLastline, empty, RenderMode(..) ) import Darcs.Util.Printer.Color ( fancyPrinters ) import Darcs.Util.Progress ( setProgressMode, debugMessage )+import Darcs.Util.URL ( isValidLocalPath ) import Darcs.UI.SelectChanges ( viewChanges ) import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions (..) ) import Darcs.Repository.PatchIndex ( PatchFilter, maybeFilterPatches, attemptCreatePatchIndex )@@ -175,6 +177,13 @@   | GenContext `elem` opts = if not . null $ args       then fail "log --context cannot accept other arguments"       else logContext opts+  | hasRemoteRepo opts = do+      (fs, es) <- remoteSubPaths args []+      if null es then+        withTempDir "darcs.log" (\_ -> showLog opts $ maybeNotNull $ nub $ sort fs)+      else+        fail $ "For a remote repo I can only handle relative paths.\n"+            ++ "Invalid arguments: "++unwords es   | null args = showLog opts Nothing   | otherwise = do       fs <- fixSubPaths fps args@@ -184,7 +193,22 @@                  $ unless (NoPatchIndexFlag `elem` opts)                   $ withRepoLockCanFail (useCache opts) YesUpdateWorking (umask opts)                     $ RepoJob attemptCreatePatchIndex-                showLog opts . Just . nub $ sort fs+                showLog opts $ Just $ nub $ sort fs++maybeNotNull :: [a] -> Maybe [a]+maybeNotNull [] = Nothing+maybeNotNull xs = Just xs++hasRemoteRepo :: [DarcsFlag] -> Bool+hasRemoteRepo = maybe False (not . isValidLocalPath) . parseFlags O.possiblyRemoteRepo++remoteSubPaths :: [String] -> [String] -> IO ([SubPath],[String])+remoteSubPaths [] es = return ([], es)+remoteSubPaths (arg:args) es = case simpleSubPath arg of+  Nothing -> remoteSubPaths args (arg:es)+  Just sp -> do+    (sps, es') <- remoteSubPaths args es+    return (sp:sps, es')  showLog :: [DarcsFlag] -> Maybe [SubPath] -> IO () showLog opts files =
src/Darcs/UI/Commands/ShowContents.hs view
@@ -19,7 +19,7 @@  import Prelude hiding ( (^) ) -import Control.Monad ( filterM, forM_, forM, unless )+import Control.Monad ( filterM, forM_, forM ) import System.IO ( stdout )  import qualified Data.ByteString as B@@ -28,20 +28,20 @@ import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts, nodefaults, findRepository ) import Darcs.UI.Flags ( DarcsFlag, useCache, fixSubPaths ) import Darcs.UI.Options ( DarcsOption, (^), oid, odesc, ocheck, onormalise, defaultFlags, parseFlags )-import qualified Darcs.UI.Options.All as O ( MatchFlag, matchOne, workingRepoDir, StdCmdAction, Verbosity, UseCache )-import Darcs.Patch.ApplyMonad ( withFiles )-import Darcs.Patch.Match-    ( haveNonrangeMatch-    , applyInvToMatcher-    , nonrangeMatcher-    , InclusiveOrExclusive(..)-    , matchExists-    , applyNInv-    , hasIndexRange )-import Darcs.Repository ( withRepository, RepoJob(..), readRepo, readRecorded, repoPatchType )+import qualified Darcs.UI.Options.All as O+    ( MatchFlag+    , matchOne+    , workingRepoDir+    , StdCmdAction+    , Verbosity+    , UseCache )+import Darcs.Patch.Match ( haveNonrangeMatch )+import Darcs.Repository ( withRepository, RepoJob(..), readRecorded, repoPatchType )+import Darcs.Repository.Lock ( withDelayedDir )+import Darcs.Repository.Match ( getNonrangeMatch )+import Storage.Hashed.Plain( readPlainTree ) import qualified Storage.Hashed.Monad as HSM-import Darcs.Util.Path( floatPath, anchorPath, FileName, fp2fn,-                   sp2fn, toFilePath, AbsolutePath )+import Darcs.Util.Path( floatPath, sp2fn, toFilePath, AbsolutePath )  showContentsDescription :: String showContentsDescription = "Outputs a specific version of a file."@@ -92,31 +92,27 @@  showContentsCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO () showContentsCmd _ _ [] = fail "show contents needs at least one argument."-showContentsCmd fps opts args = withRepository (useCache opts) $ RepoJob $ \repository -> do-  path_list <- map sp2fn `fmap` fixSubPaths fps args-  pristine <- readRecorded repository-  unapply <- let matchFlags = parseFlags O.matchOne opts-             in-             if haveNonrangeMatch (repoPatchType repository) matchFlags-               then do-                  patchset <- readRepo repository-                  case nonrangeMatcher matchFlags of-                    -- Index cannot be a Matcher, so handle it manually.-                    Nothing -> case hasIndexRange matchFlags of-                      Just (n, m) | n == m -> return $ applyNInv (n-1) patchset-                      _ -> fail "Couldn't obtain a valid matcher."-                    Just m -> do-                      unless (matchExists m patchset) $-                        fail $ "Couldn't match pattern " ++ show m-                      return $ applyInvToMatcher Exclusive m patchset-                else return (return ())-  let dump :: HSM.TreeIO [(FileName, B.ByteString)]-      dump = do-        let floatedPaths = map (floatPath . toFilePath) path_list-        okpaths <- filterM HSM.fileExists floatedPaths-        forM okpaths $ \f -> do-          content <- (B.concat . BL.toChunks) `fmap` HSM.readFile f-          return (fp2fn $ ("./" ++) $ anchorPath "" f, content)-  files <- flip withFiles unapply `fmap` fst-    `fmap` HSM.virtualTreeIO dump pristine-  forM_ files $ \(_, f) -> B.hPut stdout f+showContentsCmd fps opts args = do+  floatedPaths <- map (floatPath . toFilePath . sp2fn) `fmap` fixSubPaths fps args+  let matchFlags = parseFlags O.matchOne opts+  withRepository (useCache opts) $ RepoJob $ \repository -> do+    let readContents = do+          okpaths <- filterM HSM.fileExists floatedPaths+          forM okpaths $ \f -> (B.concat . BL.toChunks) `fmap` HSM.readFile f+        -- Note: The two calls to execReadContents below are from+        -- different working directories. This matters despite our+        -- use of virtualTreeIO.+        execReadContents tree = fst `fmap` HSM.virtualTreeIO readContents tree+    files <- if haveNonrangeMatch (repoPatchType repository) matchFlags then+               withDelayedDir "show.contents" $ \_ -> do+                 -- this call populates our temporary directory, but note that+                 -- it does so lazily: the tree gets (partly) expanded inside+                 -- execReadContents, so it is important that we execute the+                 -- latter from the same working directory.+                 getNonrangeMatch repository matchFlags+                 readPlainTree "." >>= execReadContents+             else do+               -- we can use the existing pristine tree because we don't modify+               -- anything in this case+               readRecorded repository >>= execReadContents+    forM_ files $ B.hPut stdout
src/Darcs/UI/Defaults.hs view
@@ -1,13 +1,12 @@ module Darcs.UI.Defaults ( applyDefaults ) where +import Control.Monad.Writer import Data.Char ( isSpace ) import Data.Functor.Compose ( Compose(..) )-import Data.List ( nub )+import Data.List ( nub, intercalate ) import Data.Maybe ( catMaybes ) import qualified Data.Map as M import System.Console.GetOpt-import System.IO ( stderr, hPutStrLn )-import System.Exit ( exitFailure ) import Text.Regex.Applicative     ( (<$>), (<*>), (*>), (<|>)     , match, pure, many, some@@ -21,10 +20,7 @@     , WrappedCommand(..)     ) import Darcs.UI.TheCommands ( commandControlList )-import Darcs.Repository.Prefs ( getGlobal, getPreflist )-import Darcs.Util.Path-    ( AbsolutePath-    , getCurrentDirectory )+import Darcs.Util.Path ( AbsolutePath )  -- | Apply defaults from all sources to a list of 'DarcsFlag's (e.g. from the -- command line), given the command (and possibly super command) name, and a@@ -48,25 +44,29 @@ -- override the built-in defaults. Inside the options from a defaults file, -- options for the given command override options for the @ALL@ pseudo command. -- --- Conflicting options at the same level of precedence are not allowed. If--- encountered, the program halts with an appropriate error message.+-- Conflicting options at the same level of precedence are not allowed.+--+-- Errors encountered during processing of command line or defaults flags+-- are formatted and added as (separate) strings to the list of error messages+-- that are returned together with the resulting flag list. applyDefaults :: Maybe String               -> DarcsCommand pf+              -> AbsolutePath+              -> [String]+              -> [String]               -> [DarcsFlag]-              -> IO [DarcsFlag]-applyDefaults msuper cmd flags = do-  cwd <- getCurrentDirectory -- so we can build default flags with path arguments-  let cmd_name = mkCmdName msuper (commandName cmd)-      builtin_defs = commandDefaults cmd-      check_opts = commandCheckOptions cmd-      opts = uncurry (++) $ commandAlloptions cmd-      get_flags source = handleEither . parseDefaults source cwd cmd_name opts check_opts-      handleEither (Left err) = hPutStrLn stderr err >> exitFailure-      handleEither (Right x) = return x-  cl_flags  <- handleEither $ checkConflictingOptions "command line" check_opts flags-  user_defs <- getGlobal   "defaults" >>= get_flags "user defaults"-  repo_defs <- getPreflist "defaults" >>= get_flags "repo defaults"-  return $ cl_flags ++ repo_defs ++ user_defs ++ builtin_defs+              -> ([DarcsFlag], [String])+applyDefaults msuper cmd cwd user repo flags = runWriter $ do+    cl_flags  <- runChecks "Command line" check_opts flags+    user_defs <- get_flags "User defaults" user+    repo_defs <- get_flags "Repo defaults" repo+    return $ cl_flags ++ repo_defs ++ user_defs ++ builtin_defs+  where+    cmd_name = mkCmdName msuper (commandName cmd)+    builtin_defs = commandDefaults cmd+    check_opts = commandCheckOptions cmd+    opts = uncurry (++) $ commandAlloptions cmd+    get_flags source = parseDefaults source cwd cmd_name opts check_opts  -- | Name of a normal command, or name of super and sub command. data CmdName = NormalCmd String | SuperCmd String String@@ -81,10 +81,12 @@ showCmdName (SuperCmd super sub) = unwords [super,sub] showCmdName (NormalCmd name) = name -checkConflictingOptions :: String -> ([DarcsFlag] -> [String]) -> [DarcsFlag] -> Either String [DarcsFlag]-checkConflictingOptions source check fs = case check fs of-  [] -> Right fs-  es -> Left $ unlines (source:es)+runChecks :: String -> ([DarcsFlag] -> [String]) -> [DarcsFlag] -> Writer [String] [DarcsFlag]+runChecks source check fs = case check fs of+  [] -> return fs+  es -> do+    tell [intercalate "\n" $ map ((source++": ")++) es]+    return fs  -- | Parse a list of lines from a defaults file, returning a list of 'DarcsFlag', -- given the current working directory, the command name, and a list of 'DarcsOption'@@ -112,26 +114,29 @@               -> [DarcsOptDescr DarcsFlag]               -> ([DarcsFlag] -> [String])               -> [String]-              -> Either String [DarcsFlag]-parseDefaults source cwd cmd opts check_opts def_lines = do -- Monad (Either String)+              -> Writer [String] [DarcsFlag]+parseDefaults source cwd cmd opts check_opts def_lines = do     cmd_flags <- flags_for (M.keys opt_map) cmd_defs >>=-      checkConflictingOptions (source++" for command '"++showCmdName cmd++"'") check_opts+      runChecks (source++" for command '"++showCmdName cmd++"'") check_opts     all_flags <- flags_for allOptionSwitches all_defs >>=-      checkConflictingOptions (source++" for ALL commands") check_opts+      runChecks (source++" for ALL commands") check_opts     return $ cmd_flags ++ all_flags   where     opt_map = optionMap opts     cmd_defs = parseDefaultsLines cmd def_lines     all_defs = parseDefaultsLines (NormalCmd "ALL") def_lines     to_flag all_switches (switch,arg) =-      if switch `notElem` all_switches then-        Left $ "Bad default option in "++source++": command '"++showCmdName cmd-             ++"' has no option '"++switch++"'."+      if switch `notElem` all_switches then do+        tell [source++": command '"++showCmdName cmd+             ++"' has no option '"++switch++"'."]+        return Nothing       else-        defaultToFlag cwd opt_map (switch,arg)+        mapErrors ((source++" for command '"++showCmdName cmd++"':"):)+          $ defaultToFlag cwd opt_map (switch,arg)     -- the catMaybes filters out options that are not defined     -- for this command     flags_for all_switches = fmap catMaybes . mapM (to_flag all_switches)+    mapErrors f = mapWriter (\(r, es) -> (r, if null es then [] else f es))  -- | Result of parsing a defaults line: switch and argument(s). type Default = (String, String)@@ -190,33 +195,35 @@ defaultToFlag :: AbsolutePath               -> OptionMap               -> Default-              -> Either String (Maybe DarcsFlag)+              -> Writer [String] (Maybe DarcsFlag) defaultToFlag cwd opts (switch, arg) = case M.lookup switch opts of     -- This case is not impossible! A default flag defined for ALL commands     -- is not necessarily defined for the concrete command in question.-    Nothing -> Right Nothing-    Just opt -> fmap Just $ flag_from $ getArgDescr $ getCompose opt+    Nothing -> return Nothing+    Just opt -> flag_from $ getArgDescr $ getCompose opt   where     getArgDescr (Option _ _ a _) = a-    flag_from (NoArg mkFlag) =-      if null arg then-        Right $ mkFlag cwd+    flag_from (NoArg mkFlag) = do+      if not (null arg) then do+        tell ["'"++switch++"' takes no argument, but '"++arg++"' argument given."]+        return Nothing       else-        Left $ "Bad default option: '"++switch++"' takes no argument, but '"++arg++"' argument given."+        return $ Just $ mkFlag cwd     flag_from (OptArg mkFlag _) =-      Right $ mkFlag (if null arg then Nothing else Just arg) cwd-    flag_from (ReqArg mkFlag _) =-      if null arg then-        Left $ "Bad default option: '"++switch++"' requires an argument, but no "++"argument given."+      return $ Just $ mkFlag (if null arg then Nothing else Just arg) cwd+    flag_from (ReqArg mkFlag _) = do+      if null arg then do+        tell ["'"++switch++"' requires an argument, but no "++"argument given."]+        return Nothing       else-        Right $ mkFlag arg cwd+        return $ Just $ mkFlag arg cwd  -- | Get all the longSwitches from a list of options. optionSwitches :: [DarcsOptDescr DarcsFlag] -> [String] optionSwitches = concatMap sel where   sel (Compose (Option _ switches _ _)) = switches --- | A finite map from long switches to 'DarcsAtomicOption's.+-- | A finite map from long switches to 'DarcsOptDescr's. type OptionMap = M.Map String (DarcsOptDescr DarcsFlag)  -- | Build an 'OptionMap' from a list of 'DarcsOption's.
src/Darcs/UI/Options/Util.hs view
@@ -183,7 +183,7 @@   ocheck fs = case map snd (rawParse ropts fs) of     [] -> [] -- error "this should not happen"     [_] -> []-    ropts' -> ["conflicting flags: " ++ intercalate ", " (map (intercalate "/" . switchNames) ropts')]+    ropts' -> ["conflicting options: " ++ intercalate ", " (map (intercalate "/" . switchNames) ropts')]   odesc = map (addDefaultHelp dval) ropts  -- * Simple primitive scalar valued options@@ -261,7 +261,7 @@   oparse k _ = k ()   ocheck fs = case map snd (rawParse ropts fs) of     [] -> []-    ropts' -> ("deprecated flag(s): " ++ intercalate ", " (concatMap switchNames ropts')) : comments+    ropts' -> ("deprecated option(s): " ++ intercalate ", " (concatMap switchNames ropts')) : comments   odesc = map noDefaultHelp ropts   noDefaultHelp (RawNoArg s l f _ h) = noArg s l f h   noDefaultHelp (RawStrArg s l mkF _ _ _ a h) = strArg s l mkF a h
src/Darcs/UI/RunCommand.hs view
@@ -22,6 +22,7 @@  import Prelude hiding ( (^) ) import Data.Functor ((<$>))+import Data.List ( intercalate ) import Control.Monad ( unless, when ) import System.Console.GetOpt( ArgOrder( Permute, RequireOrder ),                               OptDescr( Option ),@@ -35,45 +36,45 @@     , preHook, postHook )  import Darcs.UI.Defaults ( applyDefaults )+import Darcs.UI.External ( viewDoc ) import Darcs.UI.Flags ( DarcsFlag (NewRepo), toMatchFlags, fixRemoteRepos )-import Darcs.UI.Commands ( CommandArgs( CommandOnly, SuperCommandOnly, SuperCommandSub ),-                        CommandControl,-                        DarcsCommand,-                        commandName,-                        commandCommand,-                        commandPrereq,-                        commandExtraArgHelp,-                        commandExtraArgs,-                        commandArgdefaults,-                        commandGetArgPossibilities,-                        commandOptions,-                        commandParseOptions,-                        wrappedCommandName,-                        disambiguateCommands,-                        getCommandHelp, getCommandMiniHelp,-                        getSubcommands,-                        extractCommands,-                        superName,-                        subusage+import Darcs.UI.Commands+    ( CommandArgs( CommandOnly, SuperCommandOnly, SuperCommandSub )+    , CommandControl+    , DarcsCommand+    , commandName+    , commandCommand+    , commandPrereq+    , commandExtraArgHelp+    , commandExtraArgs+    , commandArgdefaults+    , commandGetArgPossibilities+    , commandOptions+    , commandParseOptions+    , wrappedCommandName+    , disambiguateCommands+    , getCommandHelp+    , getCommandMiniHelp+    , getSubcommands+    , extractCommands+    , superName+    , subusage     , formatPath     ) import Darcs.UI.Commands.GZCRCs ( doCRCWarnings ) import Darcs.UI.Commands.Clone ( makeRepoName, cloneToSSH ) -import Darcs.UI.External ( viewDoc )+import Darcs.Patch.Match ( checkMatchSyntax )+import Darcs.Repository.Prefs ( getGlobal, getPreflist )+import Darcs.Repository.Test ( runPosthook, runPrehook ) import Darcs.Util.AtExit ( atexit )+import Darcs.Util.Download ( setDebugHTTP, disableHTTPPipelining ) import Darcs.Util.Global ( setDebugMode, setTimingsMode )-import Darcs.Patch.Match ( checkMatchSyntax )-import Darcs.Util.Progress ( setProgressMode ) import Darcs.Util.Path ( AbsolutePath, getCurrentDirectory, toPath, ioAbsoluteOrRemote, makeAbsolute )--import Darcs.Repository.Test ( runPosthook, runPrehook )-import Data.List ( intercalate ) import Darcs.Util.Printer ( text )-import Darcs.Util.Download ( setDebugHTTP, disableHTTPPipelining )+import Darcs.Util.Progress ( setProgressMode ) import Darcs.Util.Text ( chompTrailingNewline ) - runTheCommand :: [CommandControl] -> String -> [String] -> IO () runTheCommand commandControlList cmd args =   either fail rtc $ disambiguateCommands commandControlList cmd args@@ -89,35 +90,42 @@ runCommand msuper cmd args = do   old_wd <- getCurrentDirectory   let options = commandOptions old_wd cmd-  case getOpt Permute options args of-    (cmdline_flags,orig_extra,[]) -> do+  case fixupMsgs $ getOpt Permute options args of+    (cmdline_flags,orig_extra,getopt_errs) -> do+      -- FIXME This code is highly order-dependent because of hidden state: the+      -- current directory. Like almost all Repository functions, getGlobal and+      -- getPreflist assume that the cwd is the base of our work repo (if any).+      -- This is supposed to be ensured by commandPrereq. Which means we must+      -- first call commandPrereq, then getGlobal and getPreflist, and then we+      -- must use the (saved) original working directory to resolve possibly+      -- relative paths to absolute paths.       prereq_errors <- commandPrereq cmd cmdline_flags-      -- Important: we must applyDefaults only after commandPrereq has been run,-      -- so it sees the cwd after commandPrereq has changed it.-      flags <- applyDefaults (fmap commandName msuper) cmd cmdline_flags+      user_defs <- getGlobal   "defaults"+      repo_defs <- getPreflist "defaults"+      let (flags,flag_errors) =+            applyDefaults (fmap commandName msuper) cmd old_wd user_defs repo_defs cmdline_flags       case parseFlags stdCmdActions flags of         Just Help -> viewDoc $ text $ getCommandHelp msuper cmd         Just ListOptions -> do           setProgressMode False           file_args <- commandGetArgPossibilities cmd-          putStrLn $ unlines $ getOptionsOptions options : file_args+          putStrLn $ intercalate "\n" $ getOptionsOptions options : file_args         Just Disable ->           fail $ "Command "++commandName cmd++" disabled with --disable option!"         Nothing -> case prereq_errors of           Left complaint -> fail $             "Unable to " ++ formatPath ("darcs " ++ superName msuper ++ commandName cmd) ++             " here.\n\n" ++ complaint-          Right () -> do-            extra <- commandArgdefaults cmd flags old_wd orig_extra-            case extraArgumentsError extra cmd msuper of-              Nothing     -> runWithHooks cmd old_wd flags extra-              Just msg    -> fail msg-    (_,_,ermsgs) -> fail $ chompTrailingNewline(unlines ermsgs)+          Right () -> case getopt_errs ++ flag_errors of+            [] -> do+              extra <- commandArgdefaults cmd flags old_wd orig_extra+              case extraArgumentsError extra cmd msuper of+                Nothing     -> runWithHooks cmd old_wd flags extra+                Just msg    -> fail msg+            es -> fail (intercalate "\n" es) -{- removed the --debug-verbose flag-    where addVerboseIfDebug opts | DebugVerbose `elem` opts = Debug:Verbose:opts-                                 | otherwise = opts--}+fixupMsgs :: (a, b, [String]) -> (a, b, [String])+fixupMsgs (fs,as,es) = (fs,as,map (("command line: "++).chompTrailingNewline) es)  withHookOpts :: DarcsOption a (t2 -> t3 -> t4 -> t1)                       -> (t2 -> t3 -> t4 -> t -> t1) -> [DarcsFlag] -> t -> a@@ -206,9 +214,9 @@              ++ subusage super runRawSupercommand super args = do   cwd <- getCurrentDirectory-  case getOpt RequireOrder (map (optDescr cwd) (odesc stdCmdActions)) args of+  case fixupMsgs $ getOpt RequireOrder (map (optDescr cwd) (odesc stdCmdActions)) args of     -- note: we do not apply defaults here-    (flags,_,[]) -> case parseFlags stdCmdActions flags of+    (flags,_,getopt_errs) -> case parseFlags stdCmdActions flags of       Just Help ->         viewDoc $ text $ getCommandHelp Nothing super       Just ListOptions -> do@@ -217,6 +225,6 @@       Just Disable -> do         fail $ "Command " ++ commandName super ++                " disabled with --disable option!"-      Nothing ->-        fail $ "Invalid subcommand!\n\n" ++ subusage super-    (_,_,ermsgs) -> fail $ chompTrailingNewline(unlines ermsgs)+      Nothing -> fail $ case getopt_errs of+        [] -> "Invalid subcommand!\n\n" ++ subusage super+        _ -> intercalate "\n" getopt_errs
src/Darcs/Util/ByteString.hs view
@@ -83,6 +83,9 @@ import Data.Text.Encoding       ( encodeUtf8, decodeUtf8With ) import Data.Text.Encoding.Error ( lenientDecode ) import Control.Monad            ( when )+#if MIN_VERSION_zlib(0,6,0)+import Control.Monad.ST.Lazy    ( ST )+#endif  import Foreign.Ptr              ( plusPtr, Ptr ) import Foreign.ForeignPtr       ( withForeignPtr )@@ -279,12 +282,26 @@ gzDecompress mbufsize =     -- This is what the code would be without the bad CRC recovery logic:     -- return . BL.toChunks . GZ.decompressWith decompressParams+#if MIN_VERSION_zlib(0,6,0)+    decompressWarn (ZI.decompressST ZI.gzipFormat decompressParams)+#else     toListWarn . ZI.decompressWithErrors ZI.gzipFormat decompressParams+#endif   where         decompressParams = case mbufsize of                               Just bufsize -> GZ.defaultDecompressParams { GZ.decompressBufferSize = bufsize }                               Nothing -> GZ.defaultDecompressParams +#if MIN_VERSION_zlib(0,6,0)+        decompressWarn :: (forall s . ZI.DecompressStream (ST s)) -> BL.ByteString -> ([B.ByteString], Bool)+        decompressWarn = ZI.foldDecompressStreamWithInput+                           (\x ~(xs, b) -> (x:xs, b))+                           (\xs -> if BL.null xs+                                      then ([], False)+                                      else error "trailing data at end of compressed stream"+                           )+                           handleBad+#else         toListWarn :: ZI.DecompressStream -> ([B.ByteString], Bool)         toListWarn = foldDecompressStream (\x ~(xs, b) -> (x:xs, b)) ([], False) handleBad @@ -297,12 +314,18 @@                        fold ZI.StreamEnd               = end                        fold (ZI.StreamChunk bs stream) = chunk bs (fold stream)                        fold (ZI.StreamError code msg)  = err code msg+#endif          -- For a while a bug in darcs caused gzip files with good data but bad CRCs to be         -- produced. Trap bad CRC messages, run the specified action to report that it happened,         -- but continue on the assumption that the data is valid.+#if MIN_VERSION_zlib(0,6,0)+        handleBad (ZI.DataFormatError "incorrect data check") = ([], True)+        handleBad e = error (show e)+#else         handleBad ZI.DataError "incorrect data check" = ([], True)         handleBad _ msg = error msg+#endif  isGZFile :: FilePath -> IO (Maybe Int) isGZFile f = do
src/Darcs/Util/Printer.hs view
@@ -41,6 +41,7 @@     , hPutDoc,     hPutDocLn,     putDoc,     putDocLn     , hPutDocWith, hPutDocLnWith, putDocWith, putDocLnWith     , hPutDocCompr+    , debugDocLn     , renderString, renderStringWith, renderPS, renderPSWith     , renderPSs, renderPSsWith, lineColor     , prefix, insertBeforeLastline, colorText, invisibleText@@ -57,13 +58,18 @@     , errorDoc     ) where +import Control.Exception ( throwIO, ErrorCall(..) ) import Data.String ( IsString(..) ) import Data.List (intersperse)+import GHC.Stack ( currentCallStack ) import System.IO (Handle, stdout, hPutStr)-import Darcs.Util.ByteString ( linesPS, encodeLocale, gzWriteHandle )+import System.IO.Unsafe ( unsafePerformIO ) import qualified Data.ByteString as B (ByteString, hPut, concat) import qualified Data.ByteString.Char8 as BC (unpack, pack, singleton) +import Darcs.Util.ByteString ( linesPS, encodeLocale, gzWriteHandle )+import Darcs.Util.Global ( debugMessage )+ -- | A 'Printable' is either a String, a packed string, or a chunk of -- text with both representations. data Printable = S !String@@ -101,7 +107,9 @@ parens d = lparen <> d <> rparen  errorDoc :: Doc -> a-errorDoc = error . renderStringWith simplePrinters' Encode+errorDoc x = unsafePerformIO $ do+   stack <- currentCallStack+   throwIO $ ErrorCall $ renderString Encode $ x $$ vcat (map text stack)  -- | 'putDocWith' puts a doc on stdout using the given printer. putDocWith :: Printers -> Doc -> IO ()@@ -142,6 +150,10 @@ -- | like 'hPutDoc' but with compress data before writing hPutDocCompr :: RenderMode -> Handle -> Doc -> IO () hPutDocCompr target h = gzWriteHandle h . renderPSs target++-- | Write a 'Doc' to stderr if debugging is turned on.+debugDocLn :: Doc -> IO ()+debugDocLn = debugMessage . renderString Standard  -- | @'hPrintPrintables' h@ prints a list of 'Printable's to the handle h hPrintPrintables :: RenderMode -> Handle -> [Printable] -> IO ()
tests/disable.sh view
@@ -13,7 +13,7 @@   grep disable log   rm log   # --disable works from defaults-  sub_commands=$(darcs $cmd --list-options | grep -v -- --)+  sub_commands="$(darcs $cmd --list-options | grep -v -- -- || true)"   # disabling super commands in the defaults file is broken   if test -z "$sub_commands"; then     echo "$cmd --disable" > _darcs/prefs/defaults@@ -21,8 +21,8 @@     rm _darcs/prefs/defaults     grep disable log     rm log-  elif $cmd != setpref; then-    # setpref is not a proper super command+  elif test $cmd != "setpref" -a $cmd != "help"; then+    # setpref and help are not proper super commands     for scmd in $sub_commands; do       echo "$cmd $scmd --disable" > _darcs/prefs/defaults       not darcs $cmd 2> log
+ tests/issue2447-show-content-of-removed-file.sh view
@@ -0,0 +1,52 @@+#!/usr/bin/env bash+## Test for issue2447 - get contents of deleted file +##+## Copyright (C) 2015  Ben Franksen+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib                           # Load some portability helpers.+darcs init      --repo R        # Create our test repos.++cd R++echo 'example content' > f+darcs add f+darcs record -am 'add f'+hash1=$(darcs log --last=1 | grep '^patch' | cut -d ' ' -f 2)+rm f+darcs record -am 'removed f'+darcs show contents --hash $hash1 f | grep 'example content'++mkdir d+echo 'example content' > d/f+darcs add d/f+darcs record -am 'add d/f'+hash2=$(darcs log --last=1 | grep '^patch' | cut -d ' ' -f 2)+rm d/f+darcs record -am 'removed d/f'+darcs show contents --hash $hash2 d/f | grep 'example content'++darcs obliterate -a --last=1++rm -rf d+darcs record -am 'removed d and d/f'+darcs show contents --hash $hash2 d/f | grep 'example content'
tests/network/log.sh view
@@ -1,5 +1,17 @@ #!/usr/bin/env bash-set -ev -# Demonstrates issue385+. lib++# Demonstrates issue385 and others darcs log --repo=http://darcs.net GNUmakefile --last 300++# Test things mentioned in issue2461:++# no _darcs should remain+test ! -d _darcs+# go to a directory where we have no write access+cd /+# and try again (with less patches to fetch)+darcs log --repo=http://darcs.net GNUmakefile --last 3+# an absolute path should give an error+not darcs log --repo=http://darcs.net /GNUmakefile --last 3
+ tests/show-removed-file.sh view
@@ -0,0 +1,53 @@+#!/usr/bin/env bash+## Test that 'show files --hash' acts as expected+## when selecting changes up to a given patch+##+## Copyright (C) 2015  Ben Franksen+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib                           # Load some portability helpers.+darcs init      --repo R        # Create our test repos.++cd R++touch f+darcs add f+darcs record -am 'add f'+hash1=$(darcs log --last=1 | grep '^patch' | cut -d ' ' -f 2)+darcs show files > add-f.1++rm f+darcs record -am 'removed f'+darcs show files --hash $hash1 --no-pending > add-f.2+diff add-f.1 add-f.2++mkdir d+touch d/f+darcs add d/f+darcs record -am 'add d/f'+hash2=$(darcs log --last=1 | grep '^patch' | cut -d ' ' -f 2)+darcs show files > add-df.1++rm -rf d+darcs record -am 'removed d and d/f'+darcs show files --hash $hash2 --no-pending > add-df.2+diff add-df.1 add-df.2