darcs 2.10.1 → 2.10.2

raw patch · 51 files changed

+609/−318 lines, 51 filesdep +sandidep −dataencdep ~HTTPdep ~HUnitdep ~binarysetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: sandi

Dependencies removed: dataenc

Dependency ranges changed: HTTP, HUnit, binary, process, tar, text, time, transformers, vector

API changes (from Hackage documentation)

Files

• NEWS +39/−0
• README +30/−73
• Setup.lhs +2/−2
• contrib/cygwin-wrapper.bash +6/−5
• contrib/upload.cgi +7/−7
• darcs.cabal +18/−5
• harness/Darcs/Test/Patch.hs +71/−62
• harness/Darcs/Test/Patch/Arbitrary/Generic.hs +23/−0
• harness/Darcs/Test/Patch/Arbitrary/PatchV1.hs +3/−0
• harness/Darcs/Test/Patch/Arbitrary/PrimV1.hs +6/−0
• harness/Darcs/Test/Patch/Arbitrary/Real.hs +3/−0
• harness/Darcs/Test/Patch/Properties/Generic.hs +24/−7
• harness/Darcs/Test/Patch/Properties/GenericUnwitnessed.hs +7/−5
• harness/test.hs +41/−20
• hashed-storage/Storage/Hashed/Hash.hs +9/−9
• hashed-storage/Storage/Hashed/Index.hs +2/−2
• hashed-storage/Storage/Hashed/Utils.hs +3/−3
• release/distributed-context +1/−1
• src/Darcs/Patch/Match.hs +6/−7
• src/Darcs/Patch/Rebase/Viewing.hs +5/−5
• src/Darcs/Repository.hs +1/−1
• src/Darcs/UI/ApplyPatches.hs +2/−2
• src/Darcs/UI/Commands/Apply.hs +1/−1
• src/Darcs/UI/Commands/Clone.hs +1/−1
• src/Darcs/UI/Commands/GZCRCs.hs +1/−1
• src/Darcs/UI/Commands/Help.hs +1/−1
• src/Darcs/UI/Commands/Log.hs +7/−7
• src/Darcs/UI/Commands/Optimize.hs +3/−4
• src/Darcs/UI/Commands/Pull.hs +4/−4
• src/Darcs/UI/Commands/Push.hs +5/−5
• src/Darcs/UI/Commands/Rebase.hs +15/−15
• src/Darcs/UI/Commands/Record.hs +1/−1
• src/Darcs/UI/Commands/Revert.hs +1/−1
• src/Darcs/UI/Commands/Rollback.hs +1/−1
• src/Darcs/UI/Commands/Send.hs +7/−5
• src/Darcs/UI/Commands/ShowAuthors.hs +1/−1
• src/Darcs/UI/Commands/Tag.hs +1/−1
• src/Darcs/UI/Commands/Unrecord.hs +2/−2
• src/Darcs/UI/Commands/Unrevert.hs +1/−1
• src/Darcs/UI/Commands/WhatsNew.hs +1/−1
• src/Darcs/UI/Flags.hs +4/−4
• src/Darcs/UI/Message/Send.hs +4/−2
• src/Darcs/UI/SelectChanges.hs +4/−5
• src/Darcs/Util/ByteString.hs +21/−30
• tests/bin/renameHelper.hs +205/−0
• tests/get-http.sh +1/−1
• tests/issue279_get_extra.sh +1/−1
• tests/pull.sh +1/−1
• tests/pull_compl.sh +2/−2
• tests/push-formerly-pl.sh +1/−1
• tests/v1-braced.sh +2/−2

@@ -1,3 +1,42 @@+Darcs 2.10.2, 9 November 2015++ * switch from dataenc (deprecated) to sandi+ * finish updating help strings with new command names+ * make patch selection lazier in presence of matchers+ * clean contrib scripts+ * switch patches retrieval order when using packs+ * disable mmap on Windows+ * enhance darcs send message+ * fix quickcheck suite+ * optimize patch apply code memory use+ * shorter README with quickstart instructions+ * fixed the following bugs:++    * 2457: fix darcs-test command line options+    * 2463: building darcs on powerpc+    * 2444: added default interactivity parameter to isInteractive+++Darcs 2.10.1, 9 July 2015++ * generalized doFastZip for darcsden support+ * support terminfo 0.4, network 2.6, zlib 0.6, quickcheck 2.8 and+   attoparsec 0.13+ * errorDoc now prints a stack trace (if profiling was enabled)+ * beautified error messages for command line and default files+ * fixed the following bugs:++    * 2449: test harness/shelly: need to handle mis-encoded/binary data+    * 2423: diff only respecting --diff-command when a diff.exe is present+    * 2447: get contents of deleted file+    * 2307: add information about 'darcs help manpage' and+     'darcs help markdown'+    * 2461: darcs log --repo=remoterepo creates and populates+      _darcs+    * 2459: cloning remote repo fails to use packs if cache is+      on a different partition++ Darcs 2.10.0, 19 April 2015   * Important changes in Darcs 2.10

@@ -1,91 +1,48 @@ Darcs ===== -This is the source tree for darcs, a distributed version control system+[Darcs](http://darcs.net) is a distributed version control system written in Haskell. -For more information, visit the darcs website: <http://www.darcs.net>.---Compilation and Installation-============================--Building Darcs is best done with the Haskell Platform:-<http://www.haskell.org/platform/>. Any release of darcs should build with-the most recent version of the Platform at the time of the release. This-will also generally apply to unstable versions.--If you are not using the Platform, then you need GHC and Cabal.-The versions required can be found in the darcs.cabal file under-'build-tools' and 'Cabal-Version' respectively.--The cabal-install package is also recommended.--If you have the Platform or otherwise have the "cabal-install" package-on your system (that is, there is a "cabal" executable in your path),-you can use the following command to create an executable in-`~/.cabal/bin/darcs` (this will also automatically fetch and build-dependencies from the Hackage server).--    $ cabal update-    $ cabal install--Otherwise, if you have the "cabal" package but not the "cabal-install"-package, run the following:--    $ runghc Setup configure-    $ runghc Setup build-    $ sudo runghc Setup install--You may also omit the last step and copy the darcs executable (found in-`dist/build/darcs/darcs`) to a location of your choosing.--More detailed instructions can be found at-<http://www.haskell.org/haskellwiki/Cabal/How_to_install_a_Cabal_package>-including instructions on obtaining a copy of cabal-install.---Flags to alter compilation-==========================+Getting started+=============== -There some flags that can be used to alter compilation. They are specified like this:+Compiling+--------- -    $ cabal install -fflag_name+Build instructions are available at <http://darcs.net/Binaries>. -Here are some may be of interest. Search for "flags" in the `darcs.cabal` file-file for the complete list.+Using+----- -* `-f-curl`:-  By default the cabal-based build requires the cURL library and development-  headers. If you can't provide cURL, use this flag to disable the use of it.-  The pure Haskell 'HTTP' package will be used instead.+To clone a repository from HTTP and send patches by mail: -* `-frts`:-  When trying to use the patch-index feature, you can may get an error like-  this: "Stack space overflow: current size 8388608 bytes." darcs can be-  recompiled with this flag to avoid the issue. Some more detail is here:-  <http://darcs.net/Using/PatchIndex>+    $ darcs clone --lazy http://darcs.net+    $ (edit files)+    $ darcs add (new files)+    $ darcs record -m "my changes"+    $ darcs send -* `-fstatic`:-  Builds a static binary, which bundles most dependencies. The resulting binary-  is larger, but is able to be installed on similar machines without also-  installing all the dependencies separately.+To clone from SSH and push patches: -Hacking-=======+    $ darcs clone user@hub.darcs.net:user/repo+    $ (edit files)+    $ darcs add (new files)+    $ darcs record -m "my changes"+    $ darcs push -For more information about darcs hacking and best practices please check-the darcs website <http://wiki.darcs.net>+To create a project and start working: -Of particular interest are the following pages:+    $ darcs init (project)+    $ cd (project)+    $ (add files)+    $ darcs add (files)+    $ darcs record -m "initial version" -* <http://darcs.net/Development/GettingStarted>-* <http://darcs.net/Development/FAQ>+See <http://darcs.net/Using> for more information. -Testing-=======+Reporting bugs+============== -For more information about the test suite, including how to run specific-tests <http://darcs.net/Development/RegressionTests>.+Please send bug reports to <bugs@darcs.net>. -Happy hacking!

@@ -252,7 +252,7 @@ versionPatches verbosity darcsVersion = do   numPatchesDarcs <- do       out <- rawSystemStdout verbosity "darcs"-               ["changes", "-a", "--from-tag", display darcsVersion, "--count"]+               ["log", "-a", "--from-tag", display darcsVersion, "--count"]       case reads (out) of         ((n,_):_) -> return $ Just ((n :: Int) - 1)         _         -> return Nothing@@ -290,7 +290,7 @@   contextDarcs <- do       inrepo <- doesDirectoryExist "_darcs"       unless inrepo $ fail "Not a repository."-      out <- rawSystemStdout verbosity "darcs" ["changes", "-a", "--context"]+      out <- rawSystemStdout verbosity "darcs" ["log", "-a", "--context"]       return $ Just out    `catchAny` \_ -> return Nothing 

@@ -123,11 +123,12 @@ # treat the option argument like a file. declare -a opaque_binary_opts=( \    '--repo-name' \-   '--to-match' '--to-patch' '--to-tag' \-   '--from-match' '--from-patch' '--from-tag' \+   '--to-match' '--to-patch' '--to-tag' '--to-hash' \+   '--from-match' '--from-patch' '--from-tag' '--from-hash' \    '-t' '--tag' '--tags' '--tag-name' \    '-p' '--patch' '--patches' \    '-m' '--patch-name' \+   '-h' '--hash' \    '--matches' '--match' \    '--token-chars' \    '-A' '--author' '--from' '--to' '--cc' \@@ -154,16 +155,16 @@ # converted and some that don't.  # Commands whose arguments are file paths that need to be translated.-cmds_convert_nonoption_args='|get|put|pull|push|send|apply'+cmds_convert_nonoption_args='|clone|pull|push|send|apply'  # Commands who's arguments should be left alone.  File paths that # refer to files in the repo should NOT be converted because they # are relative paths, which Darcs will handle just fine.  Cygwin # sometimes makes them absolute paths, which confuses Darcs.-#cmds_no_convert_nonoption_paths='|add|remove|mv|replace|record|whatsnew|changes|setpref|trackdown|amend-record|revert|diff|annotate'+#cmds_no_convert_nonoption_paths='|add|remove|mv|replace|record|whatsnew|log|setpref|test|amend|revert|diff|annotate'  # Commands that don't accept non-option arguments-#cmds_no_nonoption_args='|initialize|tag|check|optimize|rollback|unrecord|unpull|resolve|dist|repair'+#cmds_no_nonoption_args='|initialize|tag|optimize|rollback|unrecord|unpull|dist|repair'  # See if we need to convert the non-option args for the current # command.  This matches some prefix of one of the commands in the

@@ -27,9 +27,9 @@ my $patch_test_cmd; # command to test patches with $patch_test_cmd = "darcs apply --dry-run --repodir 'TARGETREPO' 'TARGETPATCH'"; -my $repo_get_cmd; # command to get testing repo-                  # used only when $target_repo is blank-$repo_get_cmd = "darcs get --lazy --repodir 'TARGETDIR' 'TARGETREPO'";+my $repo_clone_cmd; # command to clone testing repo+                    # used only when $target_repo is blank+$repo_clone_cmd = "darcs clone --lazy --repodir 'TARGETDIR' 'TARGETREPO'";   sub error_page {@@ -103,10 +103,10 @@          my $test_dir = tempdir(CLEANUP => 1).'/repo' or             return "$!: Could not create test directory";-        $repo_get_cmd =~ s/TARGETDIR/$test_dir/;-        $repo_get_cmd =~ s/TARGETREPO/$darcsurl/;-        system("$repo_get_cmd >/dev/null 2>/dev/null") == 0 or-            return "Could not get target repo: '$repo_get_cmd' failed";+        $repo_clone_cmd =~ s/TARGETDIR/$test_dir/;+        $repo_clone_cmd =~ s/TARGETREPO/$darcsurl/;+        system("$repo_clone_cmd >/dev/null 2>/dev/null") == 0 or+            return "Could not clone target repo: '$repo_clone_cmd' failed";         $target_repo = $test_dir;     }     $patch_test_cmd =~ s/TARGETREPO/$target_repo/;

@@ -1,5 +1,5 @@ Name:           darcs-version:        2.10.1+version:        2.10.2 License:        GPL License-file:   COPYING Author:         David Roundy <droundy@darcs.net>, <darcs-devel@darcs.net>@@ -55,6 +55,7 @@   tests/data/*.dpatch   tests/data/convert/darcs1/*.dpatch tests/data/convert/darcs2/*.dpatch   tests/*.sh+  tests/bin/renameHelper.hs   tests/bin/trackdown-bisect-helper.hs   tests/bin/hspwd.hs   tests/network/*.sh@@ -447,7 +448,6 @@       build-depends: unix >= 2.5 && < 2.8      build-depends: bytestring >= 0.9.0 && < 0.11,-                   text       >= 0.11.2.0 && < 1.3,                    old-time   >= 1.1 && < 1.2,                    directory  >= 1.1.0.2 && < 1.3.0.0,                    process    >= 1.1.0.1 && < 1.3.0.0,@@ -455,6 +455,13 @@                    random     >= 1.0 && < 1.2,                    hashable   >= 1.0 && < 1.3 +    -- release notes of GHC 7.10.2 recommends to use text >= 1.2.1.3:+    -- https://mail.haskell.org/pipermail/haskell/2015-July/024641.html+    if impl(ghc>=7.10)+      build-depends:   text       >= 1.2.1.3 && < 1.3+    else+      build-depends:   text       >= 0.11.3.1 && < 1.3+     if flag(use-time-1point5)       build-depends: time         >= 1.5 && < 1.6     else@@ -559,7 +566,7 @@         Bundled.Posix         Storage.Hashed.Utils -    build-depends: dataenc >=0.11 && < 0.15,+    build-depends: sandi >= 0.2 && < 0.4,                    unix-compat >= 0.1.2 && < 0.5,                    cryptohash >= 0.4 && < 0.12 @@ -662,7 +669,6 @@                    regex-compat-tdfa >= 0.95.1 && < 0.96,                    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.9,@@ -671,6 +677,13 @@                    test-framework-hunit       >= 0.2.2 && < 0.4,                    test-framework-quickcheck2 >= 0.3 && < 0.4 +  -- release notes of GHC 7.10.2 recommends to use text >= 1.2.1.3:+  -- https://mail.haskell.org/pipermail/haskell/2015-July/024641.html+  if impl(ghc>=7.10)+    build-depends:   text       >= 1.2.1.3 && < 1.3+  else+    build-depends:   text       >= 0.11.3.1 && < 1.3+   -- list all unit test modules not exported by libdarcs; otherwise Cabal won't   -- include them in the tarball   other-modules:    Darcs.Test.Email@@ -782,7 +795,7 @@                    directory,                    filepath,                    bytestring,-                   dataenc,+                   sandi,                    cryptohash,                    binary,                    zlib,

@@ -64,10 +64,10 @@ import qualified Darcs.Test.Patch.Examples.Set2Unwitnessed as ExU  import Darcs.Test.Patch.Properties.Check( Check(..) )-import qualified Darcs.Test.Patch.Properties.V1Set1 as Prop-import qualified Darcs.Test.Patch.Properties.V1Set2 as Prop-import qualified Darcs.Test.Patch.Properties.Generic as Prop-import qualified Darcs.Test.Patch.Properties.Real as Prop+import qualified Darcs.Test.Patch.Properties.V1Set1 as Prop1+import qualified Darcs.Test.Patch.Properties.V1Set2 as Prop2+import qualified Darcs.Test.Patch.Properties.Generic as PropG+import qualified Darcs.Test.Patch.Properties.Real as PropR import qualified Darcs.Test.Patch.Properties.GenericUnwitnessed as PropU  import qualified Darcs.Test.Patch.Rebase as Rebase@@ -97,20 +97,20 @@  unit_V1P1:: [Test] unit_V1P1 =-  [ testCases "known commutes" Prop.checkCommute Ex.knownCommutes-  , testCases "known non-commutes" Prop.checkCantCommute Ex.knownCantCommutes-  , testCases "known merges" Prop.checkMerge Ex.knownMerges-  , testCases "known merges (equiv)" Prop.checkMergeEquiv Ex.knownMergeEquivs-  , testCases "known canons" Prop.checkCanon Ex.knownCanons-  , testCases "merge swaps" Prop.checkMergeSwap Ex.mergePairs2-  , testCases "the patch validation works" Prop.tTestCheck Ex.validPatches-  , testCases "commute/recommute" (Prop.recommute commute) Ex.commutePairs-  , testCases "merge properties: merge either way valid" Prop.tMergeEitherWayValid Ex.mergePairs-  , testCases "merge properties: merge swap" Prop.mergeEitherWay Ex.mergePairs-  , testCases "primitive patch IO functions" (Prop.tShowRead eqFLUnsafe) Ex.primitiveTestPatches-  , testCases "IO functions (test patches)" (Prop.tShowRead eqFLUnsafe) Ex.testPatches-  , testCases "IO functions (named test patches)" (Prop.tShowRead unsafeCompare) Ex.testPatchesNamed-  , testCases "primitive commute/recommute" (Prop.recommute commute) Ex.primitiveCommutePairs+  [ testCases "known commutes" Prop1.checkCommute Ex.knownCommutes+  , testCases "known non-commutes" Prop1.checkCantCommute Ex.knownCantCommutes+  , testCases "known merges" Prop1.checkMerge Ex.knownMerges+  , testCases "known merges (equiv)" Prop1.checkMergeEquiv Ex.knownMergeEquivs+  , testCases "known canons" Prop1.checkCanon Ex.knownCanons+  , testCases "merge swaps" Prop1.checkMergeSwap Ex.mergePairs2+  , testCases "the patch validation works" Prop1.tTestCheck Ex.validPatches+  , testCases "commute/recommute" (PropG.recommute commute) Ex.commutePairs+  , testCases "merge properties: merge either way valid" Prop1.tMergeEitherWayValid Ex.mergePairs+  , testCases "merge properties: merge swap" PropG.mergeEitherWay Ex.mergePairs+  , testCases "primitive patch IO functions" (Prop1.tShowRead eqFLUnsafe) Ex.primitiveTestPatches+  , testCases "IO functions (test patches)" (Prop1.tShowRead eqFLUnsafe) Ex.testPatches+  , testCases "IO functions (named test patches)" (Prop1.tShowRead unsafeCompare) Ex.testPatchesNamed+  , testCases "primitive commute/recommute" (PropG.recommute commute) Ex.primitiveCommutePairs   ]  unit_V2P1 :: [Test]@@ -155,6 +155,8 @@            , Show1 (ModelOf prim)            , Check prim, PrimPatchBase prim, PrimOf prim ~ prim            , FromPrim prim+           , MightBeEmptyHunk prim+           , MightHaveDuplicate prim            , Show1 (prim wA)            , Show1 ((prim :> prim) wA)            , Show1 (WithState model prim wA)@@ -174,7 +176,7 @@   -- testProperty "prim inverse doesn't commute" (inverseDoesntCommute :: Prim -> Maybe Doc)   (if runCoalesceTests p then     [ testProperty "prim coalesce effect preserving... "-      (unseal2 $ Prop.coalesceEffectPreserving coalesce :: Sealed2 (WithState model (prim :> prim)) -> TestResult)+      (unseal2 $ PropG.coalesceEffectPreserving coalesce :: Sealed2 (WithState model (prim :> prim)) -> TestResult)     ]    else [])     ++ concat@@ -195,19 +197,19 @@ qc_V2P1 :: [Test] qc_V2P1 =   [ testProperty "tree flattenings are consistent... "-    Prop.propConsistentTreeFlattenings+    PropR.propConsistentTreeFlattenings   , testProperty "with quickcheck that real patches are consistent... "     (unseal $ P1.patchFromTree $ fromMaybe . isConsistent)   -- permutivity ----------------------------------------------------------------------------   , testConditional "permutivity"     (unseal $ P1.commuteTripleFromTree notDuplicatestriple)-    (unseal $ P1.commuteTripleFromTree $ Prop.permutivity commuteReals)+    (unseal $ P1.commuteTripleFromTree $ PropG.permutivity commuteReals)   , testConditional "partial permutivity"     (unseal $ P1.commuteTripleFromTree notDuplicatestriple)-    (unseal $ P1.commuteTripleFromTree $ Prop.partialPermutivity commuteReals)+    (unseal $ P1.commuteTripleFromTree $ PropG.partialPermutivity commuteReals)   , testConditional "nontrivial permutivity"     (unseal $ P1.commuteTripleFromTree (\t -> nontrivialTriple t && notDuplicatestriple t))-    (unseal $ P1.commuteTripleFromTree $ (Prop.permutivity commuteReals))+    (unseal $ P1.commuteTripleFromTree $ (PropG.permutivity commuteReals))   ]  qc_V2 :: forall prim wXx wYy . (PrimPatch prim, Show1 (ModelOf prim), RepoModel (ModelOf prim),@@ -216,11 +218,11 @@       => prim wXx wYy -> [Test] qc_V2 _ =   [ testProperty "readPatch and showPatch work on RealPatch... "-    (unseal $ patchFromTree $ (Prop.show_read :: RealPatch prim wX wY -> TestResult))+    (unseal $ patchFromTree $ (PropG.show_read :: RealPatch prim wX wY -> TestResult))   , testProperty "readPatch and showPatch work on FL RealPatch... "-    (unseal2 $ (Prop.show_read :: FL (RealPatch prim) wX wY -> TestResult))+    (unseal2 $ (PropG.show_read :: FL (RealPatch prim) wX wY -> TestResult))   , testProperty "we can do merges using QuickCheck"-    (isNothing . (Prop.propIsMergeable ::+    (isNothing . (PropG.propIsMergeable ::                      Sealed (WithStartState (ModelOf prim) (Tree prim))                      -> Maybe (Tree (RealPatch prim) wX)))   ]@@ -247,22 +249,28 @@  type PropList what gen = String -> TestGenerator what gen -> [Test] -pair_properties :: forall p gen x y. (Show1 gen, Arbitrary (Sealed gen), Patchy p, ShowPatchBasic p, MyEq p)-                   => p x y -> PropList (p :> p) gen+pair_properties :: forall p gen x y+                 . ( Show1 gen, Arbitrary (Sealed gen), Patchy p, MightHaveDuplicate p+                   , ShowPatchBasic p, MyEq p+                   )+                => p x y -> PropList (p :> p) gen pair_properties _ genname gen =   properties gen "commute" genname-  [ ("recommute"              , const True       , Prop.recommute commute             )-  , ("nontrivial recommute"   , nontrivialCommute, Prop.recommute commute             )-  , ("inverses commute"       , const True       , Prop.commuteInverses commute       )-  , ("nontrivial inverses"    , nontrivialCommute, Prop.commuteInverses commute       )-  , ("inverse composition"    , const True       , Prop.inverseComposition            )+  [ ("recommute"              , const True       , PropG.recommute commute             )+  , ("nontrivial recommute"   , nontrivialCommute, PropG.recommute commute             )+  , ("inverses commute"       , const True       , PropG.commuteInverses commute       )+  , ("nontrivial inverses"    , nontrivialCommute, PropG.commuteInverses commute       )+  , ("inverse composition"    , const True       , PropG.inverseComposition            )   ] -coalesce_properties :: forall p gen x y. (Show1 gen, Arbitrary (Sealed gen), Patchy p, PrimPatch p, ArbitraryPrim p)+coalesce_properties :: forall p gen x y+                     . ( Show1 gen, Arbitrary (Sealed gen), Patchy p, PrimPatch p+                       , ArbitraryPrim p, MightBeEmptyHunk p+                       )                     => p x y -> PropList (p :> p :> p) gen coalesce_properties p genname gen =   properties gen "commute" genname-   (if runCoalesceTests p then [ ("coalesce commutes with commute", const True, Prop.coalesceCommute coalesce) ] else [])+   (if runCoalesceTests p then [ ("coalesce commutes with commute", const True, PropG.coalesceCommute coalesce) ] else [])  -- The following properties do not hold for "Real" patches (conflictors and -- duplicates, specifically) .@@ -271,15 +279,15 @@                            => p x y -> PropList (p :> p) gen nonreal_commute_properties _ genname gen =   properties gen "commute" genname-  [ ("patch & inverse commute", const True       , Prop.patchAndInverseCommute commute)-  , ("patch & inverse commute", nontrivialCommute, Prop.patchAndInverseCommute commute)+  [ ("patch & inverse commute", const True       , PropG.patchAndInverseCommute commute)+  , ("patch & inverse commute", nontrivialCommute, PropG.patchAndInverseCommute commute)   ]  patch_properties :: forall p gen x y. (Show1 gen, Arbitrary (Sealed gen), Patchy p, MyEq p)                  => p x y -> PropList p gen patch_properties _ genname gen =   properties gen "patch" genname-  [ ("inverse . inverse is id"  , const True       , Prop.invertSymmetry)+  [ ("inverse . inverse is id"  , const True       , PropG.invertSymmetry)   ]  patch_repo_properties :: forall p gen x y. (Show1 gen, Arbitrary (Sealed gen),@@ -289,60 +297,61 @@                       => p x y -> PropList (WithState (ModelOf (PrimOf p)) p) gen patch_repo_properties _ genname gen =   properties gen "patch/repo" genname-  [ ("invert rollback"          , const True       , Prop.invertRollback)+  [ ("invert rollback"          , const True       , PropG.invertRollback)   ]  pair_repo_properties :: forall p gen x y. (Show1 gen, Arbitrary (Sealed gen), Patchy p,+                                            MightBeEmptyHunk p,                                             RepoModel (ModelOf p),                                             RepoState (ModelOf p) ~ ApplyState p)                       => p x y -> PropList (WithState (ModelOf p) (p :> p)) gen pair_repo_properties _ genname gen =   properties gen "patch/repo" genname-  [ ("commute is effect preserving" , const True       , Prop.effectPreserving commute )+  [ ("commute is effect preserving" , const True       , PropG.effectPreserving commute )   ]  merge_properties :: forall p gen x y. (Show1 gen, Arbitrary (Sealed gen)                                       , Patchy p, MyEq p, Merge p, ShowPatchBasic p-                                      , Show2 p, Check p)+                                      , MightHaveDuplicate p, Show2 p, Check p)                  => p x y -> PropList (p :\/: p) gen merge_properties _ genname gen =   properties gen "merge" genname-  [ ("merge either way"           , const True     , Prop.mergeEitherWay      )-  , ("merge either way valid"     , const True     , Prop.tMergeEitherWayValid)-  , ("nontrivial merge either way", nontrivialMerge, Prop.mergeEitherWay      )-  , ("merge commute"              , const True     , Prop.mergeCommute        )+  [ ("merge either way"           , const True     , PropG.mergeEitherWay      )+  , ("merge either way valid"     , const True     , Prop1.tMergeEitherWayValid)+  , ("nontrivial merge either way", nontrivialMerge, PropG.mergeEitherWay      )+  , ("merge commute"              , const True     , PropG.mergeCommute        )   ]  qc_V1P1 :: [Test] qc_V1P1 =   [-    testProperty "show and read work right" (unseal Prop.propReadShow)+    testProperty "show and read work right" (unseal Prop2.propReadShow)   ]-  ++ Prop.checkSubcommutes Prop.subcommutesInverse "patch and inverse both commute"-  ++ Prop.checkSubcommutes Prop.subcommutesNontrivialInverse "nontrivial commutes are correct"-  ++ Prop.checkSubcommutes Prop.subcommutesFailure "inverses fail"+  ++ Prop2.checkSubcommutes Prop2.subcommutesInverse "patch and inverse both commute"+  ++ Prop2.checkSubcommutes Prop2.subcommutesNontrivialInverse "nontrivial commutes are correct"+  ++ Prop2.checkSubcommutes Prop2.subcommutesFailure "inverses fail"   ++-  [ testProperty "commuting by patch and its inverse is ok" Prop.propCommuteInverse+  [ testProperty "commuting by patch and its inverse is ok" Prop2.propCommuteInverse   -- , testProperty "conflict resolution is valid... " Prop.propResolveConflictsValid   , testProperty "a patch followed by its inverse is identity"-    Prop.propPatchAndInverseIsIdentity-  , testProperty "'simple smart merge'" Prop.propSimpleSmartMergeGoodEnough-  , testProperty "commutes are equivalent" Prop.propCommuteEquivalency-  , testProperty "merges are valid" Prop.propMergeValid-  , testProperty "inverses being valid" Prop.propInverseValid-  , testProperty "other inverse being valid" Prop.propOtherInverseValid+    Prop2.propPatchAndInverseIsIdentity+  , testProperty "'simple smart merge'" Prop2.propSimpleSmartMergeGoodEnough+  , testProperty "commutes are equivalent" Prop2.propCommuteEquivalency+  , testProperty "merges are valid" Prop2.propMergeValid+  , testProperty "inverses being valid" Prop2.propInverseValid+  , testProperty "other inverse being valid" Prop2.propOtherInverseValid   -- The patch generator isn't smart enough to generate correct test cases for   -- the following: (which will be obsoleted soon, anyhow)   -- , testProperty "the order dependence of unravel... " Prop.propUnravelOrderIndependent   -- , testProperty "the unravelling of three merges... " Prop.propUnravelThreeMerge   -- , testProperty "the unravelling of a merge of a sequence... " Prop.propUnravelSeqMerge-  , testProperty "the order of commutes" Prop.propCommuteEitherOrder-  , testProperty "commute either way" Prop.propCommuteEitherWay-  , testProperty "the double commute" Prop.propCommuteTwice+  , testProperty "the order of commutes" Prop2.propCommuteEitherOrder+  , testProperty "commute either way" Prop2.propCommuteEitherWay+  , testProperty "the double commute" Prop2.propCommuteTwice   , testProperty "merges commute and are well behaved"-    Prop.propMergeIsCommutableAndCorrect-  , testProperty "merges can be swapped" Prop.propMergeIsSwapable-  , testProperty "again that merges can be swapped (I'm paranoid) " Prop.propMergeIsSwapable+    Prop2.propMergeIsCommutableAndCorrect+  , testProperty "merges can be swapped" Prop2.propMergeIsSwapable+  , testProperty "again that merges can be swapped (I'm paranoid) " Prop2.propMergeIsSwapable    ] -- the following properties are disabled, because they routinely lead to     -- exponential cases, making the tests run for ever and ever; nevertheless,

@@ -4,6 +4,7 @@  module Darcs.Test.Patch.Arbitrary.Generic        ( Tree(..), TreeWithFlattenPos(..), G2(..), ArbitraryPrim(..), NullPatch(..), RepoModel(..)+       , MightBeEmptyHunk(..), MightHaveDuplicate(..)        , flattenOne, flattenTree, mapTree, sizeTree        , commutePairFromTree, mergePairFromTree        , commuteTripleFromTree, mergePairFromCommutePair@@ -105,6 +106,28 @@  class NullPatch p where   nullPatch :: p wX wY -> EqCheck wX wY++class MightBeEmptyHunk p where+  -- |V1 Prims support the value 'Hunk n [] []' that is treated specially in the+  -- commute code and ends up breaking certain tests by behaving anomalously.+  -- In practice they shouldn't appear in real repositories. For later,+  -- as yet unreleased patch types, we should eliminate them completely.+  -- An alternative to using this as a guard might be to avoid generating them.+  isEmptyHunk :: p wX wY -> Bool+  isEmptyHunk _ = False++instance MightBeEmptyHunk (FL p)++class MightHaveDuplicate p where+  -- |"duplicates" in V2 patches (RealPatch) have lots of bugs+  -- that break various commute/merge properties.+  hasDuplicate :: p wX wY -> Bool+  hasDuplicate _ = False++instance MightHaveDuplicate p => MightHaveDuplicate (FL p) where+  hasDuplicate NilFL = False+  hasDuplicate (p :>: ps) = hasDuplicate p || hasDuplicate ps+  class ( ArbitraryState (ModelOf prim) prim       , NullPatch prim

@@ -46,6 +46,7 @@ -- probably means we want to move this elsewhere, but Darcs.Test.Patch.Check is -- already taken with something apparently only semi-related import Darcs.Test.Patch.Properties.Check( checkAPatch )+import Darcs.Test.Patch.Arbitrary.Generic ( MightHaveDuplicate )  #include "impossible.h" @@ -109,6 +110,8 @@  instance ArbitraryP Prim where     arbitraryP = onepatchgen++instance MightHaveDuplicate (V1.Patch prim)  hunkgen :: Gen (Sealed (Prim wX)) hunkgen = do

@@ -77,6 +77,12 @@   nullPatch (Hunk _ [] []) = unsafeCoerceP IsEq -- is this safe?   nullPatch _ = NotEq +instance MightBeEmptyHunk Prim where+  isEmptyHunk (FP _ (Hunk _ [] [])) = True+  isEmptyHunk _ = False++instance MightHaveDuplicate Prim+ instance Arbitrary (Sealed2 (FL (WithState V1Model Prim))) where   arbitrary = do repo <- ourSmallRepo                  liftM (unseal (seal2 . wesPatch)) $ arbitraryState repo

@@ -36,6 +36,9 @@                               y' :/\: x' -> not (y' `unsafeCompare` y) ||                                             not (x' `unsafeCompare` x) +instance MightHaveDuplicate (RealPatch prim) where+  hasDuplicate = isDuplicate+ instance (RepoModel (ModelOf prim), ArbitraryPrim prim)          => Arbitrary (Sealed2 (FL (RealPatch prim))) where     arbitrary = do Sealed (WithStartState _ tree) <- arbitrary :: Gen (Sealed (WithStartState (ModelOf prim) (Tree prim)))

@@ -34,7 +34,7 @@ import Darcs.Test.Patch.RepoModel ( RepoModel, RepoState, repoApply, eqModel, showModel                                   , maybeFail ) import Darcs.Test.Patch.WithState ( WithState(..), WithStartState(..) )-import Darcs.Test.Patch.Arbitrary.Generic ( Tree, flattenOne )+import Darcs.Test.Patch.Arbitrary.Generic ( Tree, flattenOne, MightBeEmptyHunk(..), MightHaveDuplicate(..) )  import Control.Monad ( msum ) import Darcs.Patch.Witnesses.Show ( Show2(..), show2 )@@ -89,12 +89,19 @@                                   $$ redText "with (invert x) on top:" $$ showPatch (invert x)  -- | recommute   AB ↔ B′A′ if and only if B′A′ ↔ AB-recommute :: (Patchy p, ShowPatchBasic p, MyEq p) => (forall wX wY . ((p :> p) wX wY -> Maybe ((p :> p) wX wY)))+recommute :: (Patchy p, ShowPatchBasic p, MyEq p, MightHaveDuplicate p)+          => (forall wX wY . ((p :> p) wX wY -> Maybe ((p :> p) wX wY)))           -> (p :> p) wA wB -> TestResult recommute c (x :> y) =     case c (x :> y) of     Nothing -> rejected-    Just (y' :> x') ->+    Just (y' :> x')+      -- this test unfortunately fails on some V2 patches that contain duplicates+      -- after the commute. While in theory the underlying bug should be fixed,+      -- we don't know how to and even if we did, it would probably involve a repository+      -- migration to a new patch type.+      | hasDuplicate y' || hasDuplicate x' -> rejected+      | otherwise ->        case c (y' :> x') of          Nothing -> failed (redText "failed" $$ showPatch y' $$ redText ":>" $$ showPatch x')          Just (x'' :> y'') ->@@ -136,9 +143,10 @@                     IsEq -> succeeded  -- | effect preserving  AB <--> B'A' then effect(AB) = effect(B'A')-effectPreserving :: (Patchy p, RepoModel model, ApplyState p ~ RepoState model) =>+effectPreserving :: (Patchy p, MightBeEmptyHunk p, RepoModel model, ApplyState p ~ RepoState model) =>                         (forall wX wY . (p :> p) wX wY -> Maybe ((p :> p) wX wY))                      -> WithState model (p :> p) wA wB -> TestResult+effectPreserving _ (WithState _ (x :> _) _) | isEmptyHunk x = rejected effectPreserving c (WithState r (x :> y) r')   = case c (x :> y) of     Nothing         -> rejected@@ -282,10 +290,17 @@                                  IsEq <- y'' =\/= y' -> succeeded                                | otherwise -> failed $ redText "mergeEitherWay bug" -mergeCommute :: (Patchy p, MyEq p, ShowPatchBasic p, Merge p) => (p :\/: p) wX wY -> TestResult+mergeCommute :: (Patchy p, MyEq p, ShowPatchBasic p, Merge p, MightHaveDuplicate p)+             => (p :\/: p) wX wY -> TestResult mergeCommute (x :\/: y) =     case merge (x :\/: y) of-    y' :/\: x' ->+    y' :/\: x'+     -- this test unfortunately fails on some V2 patches that contain duplicates+     -- after the merge. While in theory the underlying bug should be fixed,+     -- we don't know how to and even if we did, it would probably involve a repository+     -- migration to a new patch type.+     | hasDuplicate x' || hasDuplicate y' -> rejected+     | otherwise ->         case commute (x :> y') of         Nothing -> failed $ redText "mergeCommute 1" $$                             redText "x" $$ showPatch x $$@@ -335,8 +350,10 @@                                       else failed $ redText "r_x /= r'"  coalesceCommute-          :: (PrimPatch prim) => (forall wX wY . (prim :> prim) wX wY -> Maybe (FL prim wX wY))+          :: (PrimPatch prim, MightBeEmptyHunk prim)+          => (forall wX wY . (prim :> prim) wX wY -> Maybe (FL prim wX wY))           -> (prim :> prim :> prim) wA wB -> TestResult+coalesceCommute _ (a :> _ :> _) | isEmptyHunk a = rejected coalesceCommute j (a :> b :> c) =     case j (b :> c) of     Nothing -> rejected

@@ -6,7 +6,7 @@      , mergeCommute, patchAndInverseCommute, coalesceCommute, commuteInverses      , recommute      , show_read )-import Darcs.Test.Patch.Arbitrary.Generic ( Tree )+import Darcs.Test.Patch.Arbitrary.Generic ( Tree, MightBeEmptyHunk, MightHaveDuplicate ) import Darcs.Test.Patch.RepoModel( RepoModel, RepoState ) import Darcs.Test.Patch.WithState( WithStartState ) @@ -45,12 +45,13 @@                  -> (p :> p) wA wB -> TestResult commuteInverses f = W.commuteInverses (fmap toW . f . fromW) . toW -recommute :: (Patchy wp, ShowPatchBasic wp, MyEq wp, WSub wp p)+recommute :: (Patchy wp, ShowPatchBasic wp, MightHaveDuplicate wp, MyEq wp, WSub wp p)           => (forall wX wY . ((p :> p) wX wY -> Maybe ((p :> p) wX wY)))           -> (p :> p) wA wB -> TestResult recommute f = W.recommute (fmap toW . f . fromW) . toW -mergeCommute :: (Patchy wp, ShowPatchBasic wp, MyEq wp, Merge wp, WSub wp p) => (p :\/: p) wX wY -> TestResult+mergeCommute :: (Patchy wp, MightHaveDuplicate wp, ShowPatchBasic wp, MyEq wp, Merge wp, WSub wp p)+             => (p :\/: p) wX wY -> TestResult mergeCommute = W.mergeCommute . toW  mergeConsistent :: (Patchy wp, Merge wp, ShowPatchBasic wp, WSub wp p) =>@@ -72,8 +73,9 @@ patchAndInverseCommute f = W.patchAndInverseCommute (fmap toW . f . fromW) . toW  -coalesceCommute :: (forall wX wY . (Prim :> Prim) wX wY -> Maybe (FL Prim wX wY))-             -> (Prim :> Prim :> Prim) wA wB -> TestResult+coalesceCommute :: MightBeEmptyHunk Prim+                => (forall wX wY . (Prim :> Prim) wX wY -> Maybe (FL Prim wX wY))+                -> (Prim :> Prim :> Prim) wA wB -> TestResult coalesceCommute f = W.coalesceCommute (fmap toW . f . fromW) . toW  consistentTreeFlattenings :: (RepoState model ~ HST.Tree, RepoModel model)

@@ -29,7 +29,8 @@ import System.FilePath( takeDirectory, takeBaseName, isAbsolute ) import System.IO( hSetBinaryMode, hSetBuffering, BufferMode( NoBuffering ), stdin, stdout, stderr, localeEncoding ) import Test.Framework.Providers.API-import Test.Framework+  ( TestResultlike(..), Testlike(..), Test, runImprovingIO, yieldImprovement, Test(..), liftIO )+import Test.Framework ( defaultMainWithArgs ) import Shelly hiding ( liftIO, run, FilePath, path ) import qualified Shelly @@ -207,32 +208,42 @@                      , shell :: Bool                      , network :: Bool                      , unit :: Bool-                     , diffAlgorithm :: [DiffAlgorithm]-                     , repoFormat :: [Format]+                     , myers :: Bool+                     , patience :: Bool+                     , darcs1 :: Bool+                     , darcs2 :: Bool                      , darcs :: String                      , tests :: [String]                      , testDir :: Maybe FilePath                      , plain :: Bool                      , hideSuccesses :: Bool-                     , threads :: Int }+                     , threads :: Int+                     , qcCount :: Int+                     }             deriving (Data, Typeable, Eq)   defaultConfig :: Annotate Ann defaultConfig  = record Config{}-     [ failing       := False    += help "Run the failing (shell) tests."-     , shell         := True     += help "Run the passing, non-network shell tests."-     , network       := False    += help "Run the network shell tests."-     , unit          := True     += help "Run the unit tests."-     , diffAlgorithm := [PatienceDiff] += help "Diff algorithm(s) to test (myers, patience)."-     , repoFormat    := [Darcs2] += help "Repo formats to test (darcs-1, darcs-2)."-     , darcs         := ""       += help "Darcs binary path." += typ "PATH"-     , tests         := []       += name "t" += help "Pattern to limit the tests to run." += typ "PATTERN"-     , testDir       := Nothing  += help "Directory to run tests in" += typ "PATH"-     , plain         := False    += help "Use plain-text output."-     , hideSuccesses := False    += help "Hide successes."-     , threads       := 1        += name "j" ]+     [ failing       := False    += help "Run the failing (shell) tests [no]"+     , shell         := True     += help "Run the passing, non-network shell tests [yes]"+     , network       := False    += help "Run the network shell tests [no]"+     , unit          := True     += help "Run the unit tests [yes]"+     , myers         := False    += help "Use myers diff [no]"+     , patience      := True     += help "Use patience diff [yes]" += name "p"+     , darcs1        := False    += help "Use darcs-1 repo format [no]" += name "1"+     , darcs2        := True     += help "Use darcs-2 repo format [yes]" += name "2"+     , darcs         := ""       += help "Darcs binary path" += typ "PATH"+     , tests         := []       += help "Pattern to limit the tests to run" += typ "PATTERN" += name "t"+     , testDir       := Nothing  += help "Directory to run tests in" += typ "PATH" += name "d"+     , plain         := False    += help "Use plain-text output [no]"+     , hideSuccesses := False    += help "Hide successes [no]"+     , threads       := 1        += help "Number of threads [1]" += name "j"+     , qcCount       := 100      += help "Number of QuickCheck iterations per test [100]" += name "q"+     ]+   += summary "Darcs test harness"+   += program "darcs-test"  run :: Config -> IO () run conf = do@@ -240,7 +251,10 @@              ++ concat [ ["-t", x ] | x <- tests conf ]              ++ [ "--plain" | True <- [plain conf] ]              ++ [ "--hide-successes" | True <- [hideSuccesses conf] ]-             ++ [ "--maximum-unsuitable-generated-tests", "700" ]+                -- this multiplier is calibrated against the observed behaviour of the test harness -+                -- increase it if we see lots of "arguments exhausted" errors or similar+             ++ [ "--maximum-unsuitable-generated-tests", show (7 * qcCount conf) ]+             ++ [ "--maximum-generated-tests", show (qcCount conf) ]     case testDir conf of        Nothing -> return ()        Just d  -> do e <- shelly (test_e (fromText $ pack d))@@ -273,10 +287,17 @@      putStrLn $ "Locale encoding is " ++ textEncodingName localeEncoding -    ftests <- shelly $ if failing conf then findShell darcsBin (testDir conf) True (diffAlgorithm conf) (repoFormat conf) else return []-    stests <- shelly $ if shell conf then findShell darcsBin (testDir conf) False (diffAlgorithm conf) (repoFormat conf) else return []+    let repoFormat    = (if darcs1 conf then (Darcs1:) else id)+                      . (if darcs2 conf then (Darcs2:) else id)+                      $ []+    let diffAlgorithm = (if myers conf then (MyersDiff:) else id)+                      . (if patience conf then (PatienceDiff:) else id)+                      $ []++    ftests <- shelly $ if failing conf then findShell darcsBin (testDir conf) True diffAlgorithm repoFormat else return []+    stests <- shelly $ if shell conf then findShell darcsBin (testDir conf) False diffAlgorithm repoFormat else return []     utests <- if unit conf then doUnit else return []-    ntests <- shelly $ if network conf then findNetwork darcsBin (testDir conf) (diffAlgorithm conf) (repoFormat conf) else return []+    ntests <- shelly $ if network conf then findNetwork darcsBin (testDir conf) diffAlgorithm repoFormat else return []     defaultMainWithArgs (ftests ++ stests ++ utests ++ ntests) args        where           exeSuffix :: String

@@ -5,8 +5,8 @@  import qualified Crypto.Hash.SHA256 as SHA256 ( hash ) import qualified Data.ByteString as BS-import qualified Data.ByteString.Internal as BSI import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Char8 as BS8  import qualified Codec.Binary.Base64Url as B64U import qualified Codec.Binary.Base16 as B16@@ -27,14 +27,14 @@ base64u :: BS.ByteString -> BS.ByteString debase64u :: BS.ByteString -> Maybe BS.ByteString -base16 = BS.pack . map (BSI.c2w . toLower) . B16.encode . BS.unpack-base64u = BS.pack . map BSI.c2w . B64U.encode . BS.unpack-debase64u bs = case B64U.decode $ map BSI.w2c $ BS.unpack bs of-                 Just s -> Just $ BS.pack s-                 Nothing -> Nothing-debase16 bs = case B16.decode $ map (toUpper . BSI.w2c) $ BS.unpack bs of-                Just s -> Just $ BS.pack s-                Nothing -> Nothing+base16 = BS8.map toLower . B16.b16_enc+base64u = B64U.encode+debase64u bs = case B64U.decode bs of+                 Right s -> Just s+                 Left _ -> Nothing+debase16 bs = case B16.b16_dec $ BS8.map toUpper bs of+                Right (s, _) -> Just s+                Left _ -> Nothing  encodeBase64u :: Hash -> BS.ByteString encodeBase64u (SHA256 bs) = base64u bs

@@ -166,11 +166,11 @@ itemIsDir i = unsafeHead (iDescriptor i) == c2w 'D'  -- xlatePeek32 = fmap xlate32 . peek-xlatePeek64 :: (Storable a, Bits a) => Ptr a -> IO a+xlatePeek64 :: (Storable a, Num a, Bits a) => Ptr a -> IO a xlatePeek64 = fmap xlate64 . peek  -- xlatePoke32 ptr v = poke ptr (xlate32 v)-xlatePoke64 :: (Storable a, Bits a) => Ptr a -> a -> IO ()+xlatePoke64 :: (Storable a, Num a, Bits a) => Ptr a -> a -> IO () xlatePoke64 ptr v = poke ptr (xlate64 v)  -- | Lay out the basic index item structure in memory. The memory location is

@@ -91,8 +91,8 @@                      x -> i + boundary - x {-# INLINE align #-} -xlate32 :: (Bits a) => a -> a-xlate64 :: (Bits a) => a -> a+xlate32 :: (Num a, Bits a) => a -> a+xlate64 :: (Num a, Bits a) => a -> a  #ifdef LITTLEENDIAN xlate32 = id@@ -100,7 +100,7 @@ #endif  #ifdef BIGENDIAN-bytemask :: (Bits a) => a+bytemask :: (Num a, Bits a) => a bytemask = 255  xlate32 a = ((a .&. (bytemask `shift`  0)) `shiftL` 24) .|.

@@ -1,1 +1,1 @@-Just "\nContext:\n\n[TAG 2.10.1\nGuillaume Hoffmann <guillaumh@gmail.com>**20150709164849\n Ignore-this: 91f5dd97c5899801364cdfc0a8266faa\n] \n"+Just "\nContext:\n\n[TAG 2.10.2\nGuillaume Hoffmann <guillaumh@gmail.com>**20151109135257\n Ignore-this: b5175dd8e51689988632b312af9611da\n] \n"

@@ -119,8 +119,7 @@ import Darcs.Patch.Matchable ( Matchable ) import Darcs.Patch.MaybeInternal ( MaybeInternal, patchInternalChecker, isInternal, flIsInternal ) import Darcs.Patch.MonadProgress ( MonadProgress )-import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info, piap,-                         conscientiously, hopefully, n2pia )+import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info, conscientiously, hopefully ) import Darcs.Patch.Set ( PatchSet(..), Tagged(..), SealedPatchSet, newset2RL, Origin ) import Darcs.Patch.Type ( PatchType(..) ) import Darcs.Patch.Apply( ApplyState )@@ -538,11 +537,11 @@  -- | @matchAPatch fs p@ tells whether @p@ matches the matchers in -- the flags @fs@-matchAPatch :: Matchable p => [MatchFlag] -> Named p wX wY -> Bool+matchAPatch :: Matchable p => [MatchFlag] -> PatchInfoAnd p wX wY -> Bool matchAPatch fs p =     case nonrangeMatcher fs of     Nothing -> True-    Just m -> applyMatcher m (patch2patchinfo p `piap` p)+    Just m -> applyMatcher m p  matchPatch :: Matchable p => [MatchFlag] -> PatchSet p wStart wX -> Sealed2 (Named p) matchPatch fs ps =@@ -619,7 +618,7 @@ -- the earliest patch in a sequence, as opposed to 'matchSecondPatchset' which picks up the -- first match starting from the latest patch splitSecondFL :: Matchable p-              => (forall wA wB . q wA wB -> Sealed2 (Named p))+              => (forall wA wB . q wA wB -> Sealed2 (PatchInfoAnd p))               -> [MatchFlag]               -> FL q wX wY               -> (FL q :> FL q) wX wY -- ^The first element is the patches before and including the first patch matching the second matcher,@@ -666,10 +665,10 @@             Just (patchSet :> _) -> seal patchSet     | otherwise = getMatchingTag m (PatchSet ps ts) -splitMatchFL :: Matchable p => (forall wA wB . q wA wB -> Sealed2 (Named p)) -> Matcher p -> FL q wX wY -> (FL q :> FL q) wX wY+splitMatchFL :: Matchable p => (forall wA wB . q wA wB -> Sealed2 (PatchInfoAnd p)) -> Matcher p -> FL q wX wY -> (FL q :> FL q) wX wY splitMatchFL _extract m NilFL = error $ "Couldn't find patch matching " ++ show m splitMatchFL extract m (p :>: ps)-   | unseal2 (applyMatcher m . n2pia) . extract $ p = (p :>: NilFL) :> ps+   | unseal2 (applyMatcher m) . extract $ p = (p :>: NilFL) :> ps    | otherwise = case splitMatchFL extract m ps of                     before :> after -> (p :>: before) :> after 

@@ -6,7 +6,7 @@     ( RebaseSelect(..)     , toRebaseSelect, fromRebaseSelect, extractRebaseSelect, reifyRebaseSelect     , partitionUnconflicted-    , rsToNamed+    , rsToPia     , WithDroppedDeps(..), WDDNamed, commuterIdWDD     , RebaseChange(..), toRebaseChanges     ) where@@ -129,10 +129,10 @@             showString "RCRev " . showsPrec2 (appPrec + 1) fixups .             showString " " . showsPrec2 (appPrec + 1) changes --- |Get hold of the 'Named' patch inside a 'RebaseSelect'.-rsToNamed :: RebaseSelect p wX wY -> Sealed2 (Named p)-rsToNamed (RSFwd _ toEdit) = Sealed2 toEdit-rsToNamed (RSRev _ toEdit) = Sealed2 toEdit+-- |Get hold of the 'PatchInfoAnd' patch inside a 'RebaseSelect'.+rsToPia :: RebaseSelect p wX wY -> Sealed2 (PatchInfoAnd p)+rsToPia (RSFwd _ toEdit) = Sealed2 (n2pia toEdit)+rsToPia (RSRev _ toEdit) = Sealed2 (n2pia toEdit)  instance PrimPatchBase p => PrimPatchBase (RebaseSelect p) where    type PrimOf (RebaseSelect p) = PrimOf p

@@ -575,7 +575,7 @@   allowCtrlC cloneKind cleanup $ do     cleanDir "patches"     putVerbose verb $ text "Using patches pack."-    unpackPatches toCache3 (mapFL hashedPatchFileName $ newset2FL us) .+    unpackPatches toCache3 (mapRL hashedPatchFileName $ newset2RL us) .       Tar.read . decompress =<< fetchFileLazyPS (fromDir ++ packsDir ++ "patches.tar.gz") Uncachable     pi <- doesPatchIndexExist toDir     when pi $ createPIWithInterrupt toRepo

@@ -95,7 +95,7 @@       (hasSummary O.NoSummary opts)       (dryRun opts)       (hasXmlOutput opts)-      (isInteractive opts)+      (isInteractive True opts)       to_be_applied    when (nullFL to_be_applied && reorder opts == O.NoReorder) $ do             putStrLn $ "You don't want to " ++ cmdName ++ " any patches, so I'm exiting!"@@ -117,7 +117,7 @@          (verbosity opts)          (testChanges opts)          (setScriptsExecutable opts)-         (isInteractive opts)+         (isInteractive True opts)          "those patches do not pass the tests." (cmdName ++ " them") Nothing     withSignalsBlocked $ do finalizeRepositoryChanges repository YesUpdateWorking (compression opts)                             _ <- applyToWorking repository (verbosity opts) pw `catch` \(e :: SomeException) ->

@@ -98,7 +98,7 @@  [ "The `darcs apply` command takes a patch bundle and attempts to insert"  , "it into the current repository.  In addition to invoking it directly"  , "on bundles created by `darcs send`, it is used internally by `darcs"- , "push` and `darcs put` on the remote end of an SSH connection."+ , "push` on the remote end of an SSH connection."  , ""  , "If no file is supplied, the bundle is read from standard input."  , ""

@@ -291,7 +291,7 @@   , "--tag .` would make a copy of the repository as at the latest release."   , ""   , "An untagged repository state can still be identified unambiguously by"-  , "a context file, as generated by `darcs changes --context`.  Given the"+  , "a context file, as generated by `darcs log --context`.  Given the"   , "name of such a file, the `--context` option will create a repository"   , "that includes only the patches from that context.  When a user reports"   , "a bug in an unreleased version of your project, the recommended way to"

@@ -70,7 +70,7 @@       ++ "optionally repairs it."     , "By default it also does this for any caches you have configured and "       ++ "any other local repositories listed as sources of patches for this "-      ++ "one, perhaps because of a lazy get. You can limit the scope to just "+      ++ "one, perhaps because of a lazy clone. You can limit the scope to just "       ++ "the current repo with the --just-this-repo flag."     , "Note that readonly caches, or other repositories listed as sources, "       ++ "will be checked but not repaired. Also, this command will abort if "

@@ -274,7 +274,7 @@  -- ".SH EXAMPLE",  -- FIXME:  -- new project: init, rec -la;- -- track upstream project: get, pull -a;+ -- track upstream project: clone, pull -a;  -- contribute to project: add, rec, push/send.  ".SH SEE ALSO",  "The Darcs website provides a lot of additional information.",

@@ -241,7 +241,7 @@     else do let header = if isJust files && XMLOutput `notElem` opts                           then text $ "Changes to "++unwords (fromJust recFiles)++":\n"                           else empty-            debugMessage "About to print the changes..."+            debugMessage "About to print the patches..."             let printers = if XMLOutput `elem` opts then simplePrinters else fancyPrinters             ps <- readRepo repository -- read repo again to prevent holding onto                                        -- values forced by filtered_changes@@ -257,10 +257,10 @@ logHelp' =  "When given one or more files or directories as arguments, only\n" ++  "patches which affect those files or directories are listed. This\n" ++- "includes changes that happened to files before they were moved or\n" +++ "includes patches that happened to files before they were moved or\n" ++  "renamed.\n" ++  "\n" ++- "When given a `--from-tag`, `--from-patch` or `--from-match`, only changes\n" +++ "When given a `--from-tag`, `--from-patch` or `--from-match`, only patches\n" ++  "since that tag or patch are listed.  Similarly, the `--to-tag`,\n" ++  "`--to-patch` and `--to-match` options restrict the list to older patches.\n" ++  "\n" ++@@ -348,7 +348,7 @@                 then returnFinal                 else case hopefullyM hp of                     Nothing -> do-                        let err = text "Can't find changes prior to:"+                        let err = text "Can't find patches prior to:"                                   $$ showPatchInfo (info hp)                         return ([], renames, Just err)                     Just p ->@@ -441,7 +441,7 @@ logHelp'' =  "Three output formats exist.  The default is `--human-readable`.  You can\n" ++  "also select `--context`, which is the internal format (as seen in patch\n" ++- "bundles) that can be re-read by Darcs (e.g. `darcs get --context`).\n" +++ "bundles) that can be re-read by Darcs (e.g. `darcs clone --context`).\n" ++  "\n" ++  "Finally, there is `--xml-output`, which emits valid XML... unless a the\n" ++  "patch metadata (author, name or description) contains a non-ASCII\n" ++@@ -449,7 +449,7 @@  "\n" ++  -- FIXME: can't we just disallow the following usage?  "Note that while the `--context` flag may be used in conjunction with\n" ++- "`--xml-output` or `--human-readable`, in neither case will darcs get be\n" +++ "`--xml-output` or `--human-readable`, in neither case will darcs clone be\n" ++  "able to read the output.  On the other hand, sufficient information\n" ++  "WILL be output for a knowledgeable human to recreate the current state\n" ++  "of the repository.\n"@@ -486,7 +486,7 @@     { S.verbosity = verbosity flags     , S.matchFlags = parseFlags O.matchSeveralOrRange flags     , S.diffAlgorithm = diffAlgorithm flags-    , S.interactive = isInteractive flags+    , S.interactive = isInteractive False flags     , S.selectDeps = O.PromptDeps -- option not supported, use default     , S.summary = hasSummary O.NoSummary flags     , S.withContext = isUnified flags

@@ -63,8 +63,7 @@ import Darcs.Repository.InternalTypes ( Repository(..) ) import Darcs.Repository.Util ( getRecursiveDarcsRepos ) import Darcs.Patch.Witnesses.Ordered-     ( mapRL-     , mapFL+     ( mapFL      , bunchFL      , lengthRL      )@@ -427,7 +426,7 @@  "`--sibling` option (which can be used multiple times).\n" ++  "\n" ++  "Darcs uses hard-links automatically, so this command is rarely needed.\n" ++- "It is most useful if you used `cp -r` instead of `darcs get` to copy a\n" +++ "It is most useful if you used `cp -r` instead of `darcs clone` to copy a\n" ++  "repository, or if you pulled the same patch from a remote repository\n" ++  "into multiple local repositories." @@ -532,7 +531,7 @@   Just hash <- readHashedPristineRoot repo   writeFile ( packsDir </> "pristine" ) hash   -- pack patchesTar-  ps <- mapRL hashedPatchFileName . newset2RL <$> readRepo repo+  ps <- mapFL hashedPatchFileName . newset2FL <$> readRepo repo   is <- map ((darcsdir </> "inventories") </>) <$> HashedRepo.listInventories   writeFile (darcsdir </> "meta-filelist-inventories") . unlines $     map takeFileName is

@@ -122,7 +122,7 @@  pullHelp :: String pullHelp = unlines- [ "Pull is used to bring changes made in another repository into the current"+ [ "Pull is used to bring patches made in another repository into the current"  , "repository (that is, either the one in the current directory, or the one"  , "specified with the `--repodir` option). Pull allows you to bring over all or"  , "some of the patches that are in that repository but not in this one. Pull"@@ -145,7 +145,7 @@  fetchHelp :: String fetchHelp = unlines- [ "Fetch is similar to `pull` except that it does not apply any changes"+ [ "Fetch is similar to `pull` except that it does not apply any patches"  , "to the current repository. Instead, it generates a patch bundle that"  , "you can apply later with `apply`."  , ""@@ -410,7 +410,7 @@         then filterOutConflicts (reverseFL us') repository ps         else return (False, Sealed ps)   when hadConflicts $ putStrLn "Skipping some patches which would cause conflicts."-  when  (nullFL psFiltered) $ do putInfo opts $ text "No remote changes to pull in!"+  when  (nullFL psFiltered) $ do putInfo opts $ text "No remote patches to pull in!"                                  setEnvDarcsPatches psFiltered                                  when (reorder opts /= O.Reorder) exitSuccess   let direction = if doReverse opts then FirstReversed else First@@ -482,7 +482,7 @@     { S.verbosity = verbosity flags     , S.matchFlags = parseFlags O.matchSeveral flags     , S.diffAlgorithm = diffAlgorithm flags-    , S.interactive = isInteractive flags+    , S.interactive = isInteractive True flags     , S.selectDeps = selectDeps flags     , S.summary = hasSummary O.NoSummary flags     , S.withContext = isUnified flags

@@ -84,11 +84,11 @@  pushHelp :: String pushHelp = unlines- [ "Push is the opposite of pull.  Push allows you to copy changes from the"+ [ "Push is the opposite of pull.  Push allows you to copy patches from the"  , "current repository into another repository."  , ""  , "If you give the `--apply-as` flag, darcs will use sudo to apply the"- , "changes as a different user.  This can be useful if you want to set up a"+ , "patches as a different user.  This can be useful if you want to set up a"  , "system where several users can modify the same repository, but you don't"  , "want to allow them full write access.  This isn't secure against skilled"  , "malicious attackers, but at least can protect your repository from clumsy,"@@ -234,7 +234,7 @@                       else empty   putVerbose opts $ text "We have the following patches to push:" $$ vcat (mapRL description us')   unless (nullRL us') $ putInfo opts pull_reminder-  when (nullRL us') $ do putInfo opts $ text "No recorded local changes to push!"+  when (nullRL us') $ do putInfo opts $ text "No recorded local patches to push!"                          exitSuccess  bundlePatches :: forall t p wZ wW wA. (RepoPatch p, ApplyState p ~ Tree)@@ -249,7 +249,7 @@         (hasSummary O.NoSummary opts)         (dryRun opts)         (hasXmlOutput opts)-        (isInteractive opts)+        (isInteractive True opts)         to_be_pushed       when (nullFL to_be_pushed) $ do           putInfo opts $@@ -279,7 +279,7 @@     { S.verbosity = verbosity flags     , S.matchFlags = parseFlags O.matchSeveral flags     , S.diffAlgorithm = diffAlgorithm flags-    , S.interactive = isInteractive flags+    , S.interactive = isInteractive True flags     , S.selectDeps = selectDeps flags     , S.summary = hasSummary O.NoSummary flags     , S.withContext = isUnified flags

@@ -83,7 +83,7 @@ import Darcs.Patch.Rebase.Fixup ( RebaseFixup(..), flToNamesPrims ) import Darcs.Patch.Rebase.Name ( RebaseName(..), commuteNameNamed ) import Darcs.Patch.Rebase.Viewing-    ( RebaseSelect(RSFwd), rsToNamed+    ( RebaseSelect(RSFwd), rsToPia     , toRebaseSelect, fromRebaseSelect, extractRebaseSelect, reifyRebaseSelect     , partitionUnconflicted     , WithDroppedDeps(..), WDDNamed, commuterIdWDD@@ -231,7 +231,7 @@                  then getLastPatches (parseFlags O.matchSeveralOrLast opts) allpatches_tail                  else matchingHead (parseFlags O.matchSeveralOrLast opts) allpatches_tail     let direction = if doReverse opts then Last else LastReversed-        patches_context = selectionContext direction "suspend" (patchSelOpts opts) Nothing Nothing+        patches_context = selectionContext direction "suspend" (patchSelOpts True opts) Nothing Nothing     (_ :> psToSuspend) <-         runSelection             (selectChanges patches)@@ -416,7 +416,7 @@     inRange :> outOfRange <-         return $             if secondMatch matchFlags then-            splitSecondFL rsToNamed matchFlags selects+            splitSecondFL rsToPia matchFlags selects             else selects :> NilFL      offer :> dontoffer <-@@ -431,7 +431,7 @@      warnSkip dontoffer -    let patches_context = selectionContextGeneric rsToNamed First "unsuspend" (patchSelOpts opts) Nothing+    let patches_context = selectionContextGeneric rsToPia First "unsuspend" (patchSelOpts True opts) Nothing     (chosen :> keep) <- runSelection (selectChanges offer) patches_context     when (nullFL chosen) $ do putStrLn "No patches selected!"                               exitSuccess@@ -501,7 +501,7 @@               -- TODO should catch logfiles (fst value from updatePatchHeader) and clean them up as in AmendRecord               p' <- snd <$> updatePatchHeader                       False -- askDeps-                      (patchSelOpts opts)+                      (patchSelOpts True opts)                       (parseFlags O.keepDate opts)                       (parseFlags O.selectAuthor opts)                       (parseFlags O.author opts)@@ -573,7 +573,7 @@      -- TODO this selection doesn't need to respect dependencies     -- TODO we only want to select one patch: generalise withSelectedPatchFromRepo-    let patches_context = selectionContextGeneric rsToNamed First "inject into" (patchSelOpts opts) Nothing+    let patches_context = selectionContextGeneric rsToPia First "inject into" (patchSelOpts True opts) Nothing     (chosens :> rest_selects) <- runSelection (selectChanges selects) patches_context      let extractSingle :: FL (RebaseSelect p) wX wY -> (FL (RebaseFixup p) :> Named p) wX wY@@ -585,7 +585,7 @@      name_fixups :> prim_fixups <- return $ flToNamesPrims fixups -    let changes_context = selectionContextPrim Last "inject" (patchSelOpts opts) (Just primSplitter) Nothing Nothing+    let changes_context = selectionContextPrim Last "inject" (patchSelOpts True opts) (Just primSplitter) Nothing Nothing     (rest_fixups :> injects) <- runSelection (selectChanges prim_fixups) changes_context      when (nullFL injects) $ do@@ -653,7 +653,7 @@     let selects = toRebaseSelect ps      -- TODO this selection doesn't need to respect dependencies-    let patches_context = selectionContextGeneric rsToNamed First "obliterate" (obliteratePatchSelOpts opts) Nothing+    let patches_context = selectionContextGeneric rsToPia First "obliterate" (obliteratePatchSelOpts opts) Nothing     (chosen :> keep) <- runSelection (selectChanges selects) patches_context     when (nullFL chosen) $ do putStrLn "No patches selected!"                               exitSuccess@@ -928,7 +928,7 @@         (hasSummary O.NoSummary opts)         (dryRun opts)         (hasXmlOutput opts)-        (isInteractive opts)+        (isInteractive True opts)         to_be_applied     setEnvDarcsPatches to_be_applied     when (nullFL to_be_applied) $ do@@ -986,16 +986,16 @@     }  obliteratePatchSelOpts :: [DarcsFlag] -> S.PatchSelectionOptions-obliteratePatchSelOpts opts = (patchSelOpts opts)+obliteratePatchSelOpts opts = (patchSelOpts True opts)     { S.selectDeps = O.NoDeps     } -patchSelOpts :: [DarcsFlag] -> S.PatchSelectionOptions-patchSelOpts flags = S.PatchSelectionOptions+patchSelOpts :: Bool -> [DarcsFlag] -> S.PatchSelectionOptions+patchSelOpts defInteractive flags = S.PatchSelectionOptions     { S.verbosity = verbosity flags     , S.matchFlags = parseFlags O.matchSeveralOrLast flags     , S.diffAlgorithm = diffAlgorithm flags-    , S.interactive = isInteractive flags+    , S.interactive = isInteractive defInteractive flags     , S.selectDeps = selectDeps flags     , S.summary = hasSummary O.NoSummary flags     , S.withContext = O.NoContext@@ -1055,8 +1055,8 @@         patches <- readRepo repository         (_, Sealed ps, _) <- return $ takeHeadRebase patches         let psToShow = toRebaseChanges ps-        if isInteractive opts-            then viewChanges (patchSelOpts opts) (mapFL Sealed2 psToShow)+        if isInteractive False opts+            then viewChanges (patchSelOpts False opts) (mapFL Sealed2 psToShow)             else do                 debugMessage "About to print the changes..."                 let printers = if XMLOutput `elem` opts then simplePrinters else fancyPrinters

@@ -540,7 +540,7 @@  "\n" ++  "The `--set-scripts-executable` option causes scripts to be made\n" ++  "executable in the clean copy of the working tree, prior to running the\n" ++- "test.  See `darcs get` for an explanation of the script heuristic.\n" +++ "test.  See `darcs clone` for an explanation of the script heuristic.\n" ++  "\n" ++  "If your test command is tediously slow (e.g. `make all`) and you are\n" ++  "recording several patches in a row, you may wish to use `--no-test` to\n" ++

@@ -110,7 +110,7 @@     { S.verbosity = verbosity flags     , S.matchFlags = []     , S.diffAlgorithm = diffAlgorithm flags-    , S.interactive = isInteractive flags+    , S.interactive = isInteractive True flags     , S.selectDeps = O.PromptDeps -- option not supported, use default     , S.summary = O.NoSummary -- option not supported, use default     , S.withContext = isUnified flags

@@ -117,7 +117,7 @@     { S.verbosity = verbosity flags     , S.matchFlags = parseFlags O.matchSeveralOrLast flags     , S.diffAlgorithm = diffAlgorithm flags-    , S.interactive = isInteractive flags+    , S.interactive = isInteractive True flags     , S.selectDeps = O.PromptDeps     , S.summary = O.NoSummary     , S.withContext = O.NoContext

@@ -131,6 +131,7 @@     ( Doc, vsep, text, ($$), (<+>), (<>), putDoc, putDocLn     , renderPS, RenderMode(..)     )+import Darcs.Util.English ( englishNum, Noun(..) ) import Darcs.Util.Path ( FilePathLike, toFilePath, AbsolutePath, AbsolutePathOrStd,                         getCurrentDirectory, useAbsoluteOrStd, makeAbsoluteOrStd ) import Darcs.Util.Download.HTTP ( postUrl )@@ -233,7 +234,7 @@     { S.verbosity = verbosity flags     , S.matchFlags = parseFlags O.matchSeveral flags     , S.diffAlgorithm = O.PatienceDiff-    , S.interactive = isInteractive flags+    , S.interactive = isInteractive True flags     , S.selectDeps = selectDeps flags     , S.summary = hasSummary O.NoSummary flags     , S.withContext = O.NoContext@@ -318,7 +319,7 @@       (hasSummary O.NoSummary opts)       (dryRun opts)       O.NoXml-      (isInteractive opts)+      (isInteractive True opts)       to_be_sent   when (nullFL to_be_sent) $ do       putInfo opts Msg.selectionIsNull@@ -541,12 +542,13 @@                                            return (doc, Just updatedFile, tryGetCharset doc)         Nothing -> return (patchdesc, Nothing, tryGetCharset patchdesc)-    where patchdesc = text (if lengthFL patches == 1-                               then "1 patch"-                               else show (lengthFL patches) ++ " patches")+    where patchdesc = text (show len)+                      <+> text (englishNum len (Noun "patch") "")                       <+> text "for repository" <+> text their_name <> text ":"                       $$ text ""                       $$ vsep (mapFL description patches)+            where+              len = lengthFL patches           updateFilename file =                  maybe (renameFile file darcsSendMessageFinal >>                        return darcsSendMessageFinal) (return . toFilePath) $ hasLogfile opts

@@ -82,7 +82,7 @@  "substring). Use ^,$ to match the whole string in regexps\n" ++  "\n" ++  "Currently this canonicalization step is done only in `darcs show\n" ++- "authors`.  Other commands, such as `darcs changes` use author strings\n" +++ "authors`.  Other commands, such as `darcs log` use author strings\n" ++  "verbatim.\n" ++  "\n" ++  "An example `.authorspelling` file is:\n" ++

@@ -74,7 +74,7 @@  "at <http://producingoss.com/en/development-cycle.html>.\n" ++  "\n" ++  "To reproduce the state of a repository `R` as at tag `t`, use the\n" ++- "command `darcs get --tag t R`.  The command `darcs show tags` lists\n" +++ "command `darcs clone --tag t R`.  The command `darcs show tags` lists\n" ++  "all tags in the current repository.\n" ++  "\n" ++  "Tagging also provides significant performance benefits: when Darcs\n" ++

@@ -351,7 +351,7 @@                       (hasSummary O.NoSummary opts)                       (dryRun opts)                       (hasXmlOutput opts)-                      (isInteractive opts)+                      (isInteractive True opts)                       removed                     setEnvDarcsPatches removed                     when (isJust $ getOutput opts "") $@@ -438,7 +438,7 @@     { S.verbosity = verbosity flags     , S.matchFlags = parseFlags O.matchSeveralOrLast flags     , S.diffAlgorithm = diffAlgorithm flags-    , S.interactive = isInteractive flags+    , S.interactive = isInteractive True flags     , S.selectDeps = selectDeps flags     , S.summary = hasSummary O.NoSummary flags     , S.withContext = O.NoContext

@@ -122,7 +122,7 @@     { S.verbosity = verbosity flags     , S.matchFlags = []     , S.diffAlgorithm = diffAlgorithm flags-    , S.interactive = isInteractive flags+    , S.interactive = isInteractive True flags     , S.selectDeps = O.PromptDeps -- option not supported, use default     , S.summary = O.NoSummary -- option not supported, use default     , S.withContext = isUnified flags

@@ -148,7 +148,7 @@     { S.verbosity = verbosity flags     , S.matchFlags = []     , S.diffAlgorithm = diffAlgorithm flags-    , S.interactive = isInteractive flags+    , S.interactive = isInteractive True flags     , S.selectDeps = O.PromptDeps -- option not supported, use default     , S.summary = hasSummary (defaultSummary flags) flags     , S.withContext = isUnified flags

@@ -182,9 +182,9 @@     hasPause = (== O.YesWantGuiPause) . parseFlags O.pauseForGui  -- | Non-trivial interaction between options. Explicit @-i@ or @-a@ dominates,--- else @--count@, @--xml@, or @--dry-run@ imply @-a@, else default to interactive.-isInteractive :: Config -> Bool-isInteractive = oparse (O.dryRunXml ^ O.changesFormat ^ O.interactive) decide+-- else @--count@, @--xml@, or @--dry-run@ imply @-a@, else use the def argument.+isInteractive :: Bool -> Config -> Bool+isInteractive def = oparse (O.dryRunXml ^ O.changesFormat ^ O.interactive) decide   where     decide :: O.DryRun -> O.XmlOutput -> Maybe O.ChangesFormat -> Maybe Bool -> Bool     decide _           _        _                     (Just True)  = True@@ -192,7 +192,7 @@     decide _           _        (Just O.CountPatches) Nothing      = False     decide _           O.YesXml _                     Nothing      = False     decide O.YesDryRun _        _                     Nothing      = False-    decide _           _        _                     Nothing      = True+    decide _           _        _                     Nothing      = def  maxCount :: Config -> Maybe Int maxCount = parseFlags O.matchMaxcount

@@ -163,8 +163,10 @@  savedButNotSent :: String -> Doc savedButNotSent to =-       text ("The usual recipent for this bundle is: " ++ to)-    $$ text "To send it automatically, mark sure sendmail is working, and add 'send mail' to _darcs/prefs/defaults or ~/.darcs/defaults"+        text ("The usual recipent for this bundle is: " ++ to)+    $$  text "To send it automatically, make sure sendmail is working,"+    <+> text "and add 'send mail' to _darcs/prefs/defaults or"+    <+> text " ~/.darcs/defaults"  willSendTo :: DryRun -> [String] -> Doc willSendTo dr addresses =

@@ -95,8 +95,7 @@ import Darcs.Patch.Inspect ( PatchInspect ) import Darcs.Patch.Invert ( Invert ) import Darcs.Patch.Match ( haveNonrangeMatch, matchAPatch, matchAPatchread )-import Darcs.Patch.Named ( Named )-import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, hopefully, info, n2pia )+import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info, n2pia ) import Darcs.Patch.Set ( PatchSet(..), newset2RL ) import Darcs.Patch.Show ( ShowPatch ) import Darcs.Patch.Split ( Splitter (..) )@@ -213,7 +212,7 @@  PSC { opts = o      , splitter = spl      , files = fs-     , matchCriterion = iswanted (seal2 . hopefully) (matchFlags o)+     , matchCriterion = iswanted seal2 (matchFlags o)      , jobname = jn      , allowSkipAll = True      , pristine = Nothing@@ -222,7 +221,7 @@  -- | A generic 'PatchSelectionContext'. selectionContextGeneric :: (RepoPatch p, Invert q)-                        => (forall wX wY . q wX wY -> Sealed2 (Named p))+                        => (forall wX wY . q wX wY -> Sealed2 (PatchInfoAnd p))                         -> WhichChanges                         -> String                         -> PatchSelectionOptions@@ -268,7 +267,7 @@ -- | 'iswanted' selects patches according to the given match flags iswanted :: forall p q           . (RepoPatch p, Invert q)-         => (forall wX wY . q wX wY -> Sealed2 (Named p))+         => (forall wX wY . q wX wY -> Sealed2 (PatchInfoAnd p))          -> [MatchFlag]          -> MatchCriterion q iswanted extract mflags = MatchCriterion

@@ -67,11 +67,14 @@ import Data.ByteString (intercalate) import Data.ByteString.Internal (fromForeignPtr) +#if mingw32_HOST_OS+#else import Control.Exception ( catch, SomeException )+#endif import System.IO import System.IO.Unsafe         ( unsafePerformIO ) -import Foreign.Storable         ( peekElemOff, peek )+import Foreign.Storable         ( peek ) import Foreign.Marshal.Array    ( advancePtr ) import Foreign.C.Types          ( CInt(..) ) @@ -101,9 +104,12 @@ import Darcs.Util.Encoding ( decode, encode ) import Darcs.Util.Global ( addCRCWarning ) +#if mingw32_HOST_OS+#else import System.IO.MMap( mmapFileByteString ) import System.Mem( performGC ) import System.Posix.Files( fileSize, getSymbolicLinkStatus )+#endif  -- ----------------------------------------------------------------------------- -- obsolete debugging code@@ -405,6 +411,9 @@ -- the file is assumed to be ISO-8859-1.  mmapFilePS :: FilePath -> IO B.ByteString+#if mingw32_HOST_OS+mmapFilePS = B.readFile+#else mmapFilePS f =   mmapFileByteString f Nothing    `catch` (\(_ :: SomeException) -> do@@ -412,6 +421,7 @@                      if size == 0                         then return B.empty                         else performGC >> mmapFileByteString f Nothing)+#endif  -- ------------------------------------------------------------------------- -- fromPS2Hex@@ -461,21 +471,13 @@ breakAfterNthNewline :: Int -> B.ByteString                         -> Maybe (B.ByteString, B.ByteString) breakAfterNthNewline 0 the_ps | B.null the_ps = Just (B.empty, B.empty)+                              | otherwise     = Just (B.empty, the_ps) breakAfterNthNewline n the_ps =-  case BI.toForeignPtr the_ps of-  (fp,the_s,l) ->-   unsafePerformIO $ withForeignPtr fp $ \p ->-   do let findit 0 s | s == end = return $ Just (the_ps, B.empty)-          findit _ s | s == end = return Nothing-          findit 0 s = let left_l = s - the_s-                       in return $ Just (fromForeignPtr fp the_s left_l,-                                         fromForeignPtr fp s (l - left_l))-          findit i s = do w <- peekElemOff p s-                          if w == nl then findit (i-1) (s+1)-                                     else findit i (s+1)-          nl = BI.c2w '\n'-          end = the_s + l-      findit n the_s+  go n (B.elemIndices (BI.c2w '\n') the_ps)+  where  go 0 []      = Just (the_ps, B.empty)+         go _ []      = Nothing+         go 1 (i:_)   = Just $ B.splitAt (i+1) the_ps+         go !m (_:is) = go (m-1) is  -- ------------------------------------------------------------------------- -- breakBeforeNthNewline@@ -484,21 +486,10 @@ breakBeforeNthNewline 0 the_ps  | B.null the_ps = (B.empty, B.empty) breakBeforeNthNewline n the_ps =- case BI.toForeignPtr the_ps of- (fp,the_s,l) ->-   unsafePerformIO $ withForeignPtr fp $ \p ->-   do let findit _ s | s == end = return (the_ps, B.empty)-          findit i s = do w <- peekElemOff p s-                          if w == nl-                            then if i == 0-                                 then let left_l = s - the_s-                                      in return (fromForeignPtr fp the_s left_l,-                                                 fromForeignPtr fp s (l - left_l))-                                 else findit (i-1) (s+1)-                            else findit i (s+1)-          nl = BI.c2w '\n'-          end = the_s + l-      findit n the_s+  go n (B.elemIndices (BI.c2w '\n') the_ps)+  where  go _ []      = (the_ps, B.empty)+         go 0 (i:_)   = B.splitAt i the_ps+         go !m (_:is) = go (m-1) is  -- | Test if a ByteString is made of ascii characters isAscii :: B.ByteString -> Bool

@@ -0,0 +1,205 @@+-- Helper to test renaming+--+-- Copyright (C) 2014 Owen Stephens+--+-- 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+module Main where++import Data.List ( sort, groupBy )+import Data.Function ( on )+import System.FilePath ( (</>) )+import Control.Monad ( forM, void, when, unless, forM_ )+import System.Directory ( createDirectory, removeFile, removeDirectory+                        , doesDirectoryExist, doesFileExist )+import System.Exit ( ExitCode(..) )+import System.Process ( system )++{-+N = nonexistent (unrecorded, not in working)+U = unadded     (unrecorded, in working)+S = shadow      (recorded, not in working)+K = known       (recorded, in working)++O = OK+F = Fail+           tgt+      N   U   S   K+   N  F1  F1  F1  F1+s  U  F2  F2  F2  F2+r  S  F3  O4  F5  O6+c  K  O7  F8  O9  OF10++Reasons:+ 1    no such source path+ 2    shouldn't move paths we don't manage+ 3    target not in WD/Repo+ 4    post-hoc move+ 5    target exists in Repo+ 6    target exists in WD/Repo, but could be successful post-hoc if target+      is made to appear deleted before the move+ 7    simple rename+ 8    target in WD+ 9    rename into file that has been deleted.+ 10   If target is dir then OK: move into dir, else Fail: target exists in WD+-}++data PathExistence = N+                   | U+                   | K+                   | S+                   deriving (Eq, Ord, Show)++data PathType = File+              | Dir+              deriving (Eq, Ord, Show )++-- OK takes a function to modify src/tgt names, used to check for tgt existence+data ExpectedResult = OK ((String, String) -> String)+                    | Fail++instance Show ExpectedResult where+    show (OK _) = "OK <check>"+    show Fail = "FAIL"++-- ExpectedResults are for: [File/File, File/Dir, Dir/File, Dir/Dir]+resList :: [ (PathExistence, [(PathExistence, [ExpectedResult])]) ]+resList =+    [ (N, [ (N, allFail)+          , (U, allFail)+          , (K, allFail)+          , (S, allFail)+          ])+    , (U, [ (N, allFail)+          , (U, allFail)+          , (K, allFail)+          , (S, allFail)+          ])+    , (K, [ (N, allOkSnd)+          , (U, allFail)+          , (K, [Fail, okMoveInto, Fail, okMoveInto])+          , (S, allOkSnd)+          ])+    , (S, [ (N, allFail)+          , (U, [okSnd, Fail, Fail, okSnd])+          , (K, [okSnd, Fail, Fail, okSnd])+          , (S, allFail)+          ])+    ]+  where+    allFail = replicate 4 Fail+    allOkSnd = replicate 4 okSnd+    okSnd = OK snd+    okMoveInto = OK $ \(s,d) -> d</>s++-- Add a newline, else we're not creating a valid textfile!+makeAtPath File = \p -> writeFile p (p ++ "\n")+makeAtPath Dir = createDirectory+removeAtPath File p = do+    removeFile p+    void $ system ("echo 'Removed file " ++ p ++ "'")+removeAtPath Dir p = do+    removeDirectory p+    void $ system ("echo 'Removed dir " ++ p ++ "'")++expectFailure args ExitSuccess =+    fail $ "Unexpected success: " ++ show args+expectFailure args ec = return ()++exists File = doesFileExist+exists Dir = doesDirectoryExist++checkTgtExists pathType mod src tgt args = do+    tgtExists <- exists pathType $ mod (src, tgt)+    unless tgtExists $+        fail $ "Unexpected absence of move tgt: "+                ++ show (mod (src, tgt)) ++ " " ++ show args++checkSrcDoesNotExist pathType src args = do+    srcExists <- exists pathType src+    when srcExists $+        fail $ "Unexpected presence of move src: " ++ show args++expectSuccess args (ExitFailure _) _ =+    fail $ "Unexpected failure: " ++ show args+expectSuccess (U,_,_,_,_,_,_) ExitSuccess _ = return ()+expectSuccess args@(K, srcPathType@File, src, K, Dir, tgt, _) _ mod = do+    checkSrcDoesNotExist srcPathType src args+    -- src is a file, tgt is a dir, so src will be moved inside dir+    checkTgtExists File mod src tgt args+expectSuccess args@(_, srcPathType, src, N, _, tgt, _) _ mod = do+    checkSrcDoesNotExist srcPathType src args+    -- tgt didn't exist so src will simply be renamed to tgt+    checkTgtExists srcPathType mod src tgt args+expectSuccess args@(K, srcPathType, src, S, _, tgt, _) _ mod = do+    checkSrcDoesNotExist srcPathType src args+    -- tgt was shadow, so src will simply be renamed to tgt+    checkTgtExists srcPathType mod src tgt args+expectSuccess args@(_, srcPathType, src,_, tgtPathType, tgt,_) _ mod = do+    checkSrcDoesNotExist srcPathType src args+    checkTgtExists tgtPathType mod src tgt args++type RenameInfo = (PathExistence, PathType, FilePath)++main = do+    -- Don't need to do anything with the nonexistent paths+    let [_, us, ks, ss] = groupBy ((==) `on` (\(x,_,_) -> x)) . sort .+            concatMap (\(x,y) -> [x,y]) . fst . unzip $ pathDetails+    -- Create all files/dirs+    mapM_ (\(_, ptype, p) -> makeAtPath ptype p) $ us ++ ks ++ ss+    -- Let darcs know about all knowns/shadows+    mapM_ (system . ("darcs add " ++) . unwords . map (\(_,_,x)->x)) [ks, ss]+    _ <- system "darcs rec -am 'add everything'"+    -- Remove from working all shadows+    mapM_ (\(_, ptype, p) -> removeAtPath ptype p) ss+    forM_ pathDetails $ \(( (srcType, srcPathType, srcName)+                          , (tgtType, tgtPathType, tgtName)), expected) -> do+        let movePatchName =+                "'move " ++ srcName ++ " -> " ++ tgtName ++ "'"+        ec <- system $ unwords [ "darcs whatsnew"+                               , "&& darcs move", srcName, tgtName+                               , "&& darcs rec -a ", tgtName, srcName+                               , "-m",  movePatchName]+        let args = ( srcType, srcPathType, srcName+                   , tgtType, tgtPathType, tgtName, expected)+        case expected of+            OK check -> expectSuccess args ec check+            Fail -> expectFailure args ec+  where+    fileDirCombos = [(a,b) | a <- [File, Dir], b <- [File, Dir]]++    zipErr [] [] = []+    zipErr (x : xs) (y : ys) = (x, y) : zipErr xs ys+    zipErr _ _ = error "uneven lists in zipErr"++    pathDetails :: [((RenameInfo, RenameInfo), ExpectedResult)]+    pathDetails =+        concatFor resList $ \(srcType, srcResults) ->+            concatFor srcResults $ \(tgtType, expected) ->+                concatFor (zipErr fileDirCombos expected) $+                    \((srcPathType, tgtPathType), expectedResult) ->+                        let nameBase = show srcType ++ show srcPathType+                                        ++ show tgtType ++ show tgtPathType+                            srcName = nameBase ++ "-src"+                            tgtName = nameBase ++ "-dst"+                            src = (srcType, srcPathType, srcName)+                            tgt = (tgtType, tgtPathType, tgtName)+                        in [((src, tgt), expectedResult)]+      where+        concatFor = flip concatMap

@@ -37,5 +37,5 @@ darcs get $baseurl/R S cd S darcs pull ../R | tee log-grep "No remote changes" log+grep "No remote" log darcs check

@@ -35,7 +35,7 @@ cd .. cd temp_d darcs pull -a ../temp_c > log-not grep -i "no remote changes" log+not grep -i "no remote" log not grep -i get_extra log cd .. 

@@ -18,7 +18,7 @@ mkdir two cd two echo darcs pull should work relative to the current directory-darcs pull -a ../../../temp1 | grep -i 'No remote changes to pull in'+darcs pull -a ../../../temp1 | grep -i 'No remote patches to pull in'  echo -- darcs pull should pull into repo specified with --repo cd ../..  # now in temp2

@@ -124,7 +124,7 @@ EOF  darcs pull --dry-run --complement ../temp2 ../temp3 > p8.out-grep "No remote changes to pull in!" p8.out+grep "No remote patches to pull in!" p8.out  # because duplicates are stripped before performing action, # this is the same as: darcs pull ../temp1@@ -136,7 +136,7 @@ # so the "null" pull must be tested this way: darcs get ../temp1 ../temp5 darcs pull --dry-run --complement ../temp1 ../temp5 > p9.out-grep "No remote changes to pull in!" p9.out+grep "No remote patches to pull in!" p9.out  darcs pull -av --complement ../temp1 ../temp3 darcs check

@@ -33,7 +33,7 @@ mkdir -p temp2/one/two cd temp2/one/two # darcs push should work relative to the current directory-darcs push -a ../../../temp1 | grep -i 'No recorded local changes to push'+darcs push -a ../../../temp1 | grep -i 'No recorded local patches to push' cd ../../../  # darcs push should push into repo specified with --repo

@@ -44,7 +44,7 @@ cd ..  cd braced-darcs pull -a ../empty | grep 'No remote changes to pull in'+darcs pull -a ../empty | grep 'No remote patches to pull in'  cd ../empty-darcs pull -a ../braced | grep 'No remote changes to pull in'+darcs pull -a ../braced | grep 'No remote patches to pull in'