diff --git a/CHANGELOG b/CHANGELOG.md similarity index 99% rename from CHANGELOG rename to CHANGELOG.md index eb2d1a36..a1296fd8 100644 --- a/CHANGELOG +++ b/CHANGELOG.md @@ -1,3 +1,29 @@ +Darcs 2.18.3, 26 May 2024 + + * relax upper bounds for some dependencies + + * with GHC up to 9.8 all tests now succeed (including Windows and MacOS) + + * resolve issue2714: cannot remove recursively + + * resolve issue2715: hub.darcs.net does not support "Extended Main Secret" + + We use a new addition to crypton-connection in order to change the default + setting back to old (tls < 2.0) default. + + * resolve issue2721 by excluding certain versions of directory package + + Versions 1.3.8 up to 1.3.8.4 of the directory package have a bug in their + implementation of copyFile on Windows. + + * work around issue2720 (caused by x509-system indirect dependency, see + (see https://github.com/kazu-yamamoto/crypton-certificate/issues/9) + + * make execution of release/gen-version-info.hs more robust + + Using cabal run instead of runghc inside of Setup.hs ensures that we use the + same ghc version that cabal uses, avoiding dependency errors. + Darcs 2.18.2, 24 Mar 2024 * Fix deprecated head/tail warnings on GHC 9.8, making the build there diff --git a/contrib/buildbot-try.sh b/contrib/buildbot-try.sh old mode 100755 new mode 100644 diff --git a/contrib/checkdeps.sh b/contrib/checkdeps.sh old mode 100755 new mode 100644 diff --git a/contrib/cygwin-wrapper.bash b/contrib/cygwin-wrapper.bash old mode 100755 new mode 100644 diff --git a/contrib/darcs-shell b/contrib/darcs-shell old mode 100755 new mode 100644 diff --git a/contrib/darcshoogle b/contrib/darcshoogle old mode 100755 new mode 100644 diff --git a/contrib/runHLint.sh b/contrib/runHLint.sh old mode 100755 new mode 100644 diff --git a/contrib/update_roundup.pl b/contrib/update_roundup.pl old mode 100755 new mode 100644 diff --git a/contrib/upload.cgi b/contrib/upload.cgi old mode 100755 new mode 100644 diff --git a/darcs.cabal b/darcs.cabal index 4c83b30d..3cdc0396 100644 --- a/darcs.cabal +++ b/darcs.cabal @@ -84,7 +84,7 @@ extra-source-files: GNUmakefile extra-doc-files: - CHANGELOG + CHANGELOG.md source-repository head type: darcs @@ -123,7 +123,7 @@ flag warn-as-error -- ---------------------------------------------------------------------- custom-setup - setup-depends: base >= 4.10 && < 4.20, + setup-depends: base >= 4.10 && < 4.21, Cabal >= 2.4 && < 3.11, process >= 1.2.3.0 && < 1.7, filepath >= 1.4.1 && < 1.5.0.0, @@ -412,7 +412,7 @@ Library else build-depends: unix >= 2.7.1.0 && < 2.9 - build-depends: base >= 4.10 && < 4.20, + build-depends: base >= 4.10 && < 4.21, safe >= 0.3.20 && < 0.4, stm >= 2.1 && < 2.6, binary >= 0.5 && < 0.11, @@ -619,17 +619,15 @@ test-suite darcs-test Darcs.Test.Patch.Check Darcs.Test.Patch.Depends Darcs.Test.Patch.Examples.Set1 - Darcs.Test.Patch.Examples.Set2Unwitnessed + Darcs.Test.Patch.Examples.Set2 Darcs.Test.Patch.Examples.Unwind - Darcs.Test.Patch.WSub Darcs.Test.Patch.Info Darcs.Test.Patch.Properties Darcs.Test.Patch.Properties.V1Set1 Darcs.Test.Patch.Properties.V1Set2 Darcs.Test.Patch.Properties.Generic - Darcs.Test.Patch.Properties.GenericUnwitnessed Darcs.Test.Patch.Properties.Check - Darcs.Test.Patch.Properties.RepoPatch + Darcs.Test.Patch.Properties.Mergeable Darcs.Test.Patch.Properties.RepoPatchV3 Darcs.Test.Patch.Arbitrary.Generic Darcs.Test.Patch.Arbitrary.Named @@ -637,7 +635,7 @@ test-suite darcs-test Darcs.Test.Patch.Arbitrary.PatchTree Darcs.Test.Patch.Arbitrary.PrimFileUUID Darcs.Test.Patch.Arbitrary.PrimV1 - Darcs.Test.Patch.Arbitrary.RepoPatch + Darcs.Test.Patch.Arbitrary.Mergeable Darcs.Test.Patch.Arbitrary.RepoPatchV1 Darcs.Test.Patch.Arbitrary.RepoPatchV2 Darcs.Test.Patch.Arbitrary.RepoPatchV3 diff --git a/harness/Darcs/Test/Patch.hs b/harness/Darcs/Test/Patch.hs index 528db259..a9cf4ed9 100644 --- a/harness/Darcs/Test/Patch.hs +++ b/harness/Darcs/Test/Patch.hs @@ -30,11 +30,12 @@ import Darcs.Patch.V1 ( RepoPatchV1 ) import Darcs.Patch.V2.RepoPatch ( RepoPatchV2 ) import Darcs.Patch.V3 ( RepoPatchV3 ) import Darcs.Patch.Commute ( Commute(..) ) +import qualified Darcs.Patch.RepoPatch as RP import Darcs.Test.Patch.Arbitrary.Generic import Darcs.Test.Patch.Arbitrary.Named () import Darcs.Test.Patch.Arbitrary.PrimFileUUID() -import Darcs.Test.Patch.Arbitrary.RepoPatch +import Darcs.Test.Patch.Arbitrary.Mergeable import Darcs.Test.Patch.Arbitrary.RepoPatchV1 () import Darcs.Test.Patch.Arbitrary.RepoPatchV2 () import Darcs.Test.Patch.Arbitrary.RepoPatchV3 () @@ -58,10 +59,12 @@ type Prim2 = V2.Prim -- tests (either QuickCheck or Unit) that should be run on any type of patch general_patchTests :: forall p - . ( ArbitraryRepoPatch p, CheckedMerge p + . ( ArbitraryMergeable p, CheckedMerge p + , RP.RepoPatch p , PrimBased p, Commute (OnlyPrim p), ArbitraryPrim (OnlyPrim p) , ShrinkModel (PrimOf p) , Show1 (ModelOf (PrimOf p)), Show2 p + , RepoApply (PrimOf p) ) => [Test] general_patchTests = @@ -76,6 +79,7 @@ testSuite = , repoPatchV1Tests , repoPatchV2Tests , repoPatchV3Tests + , namedPatchV3Tests , Darcs.Test.Patch.Depends.testSuite , Darcs.Test.Patch.Info.testSuite , Darcs.Test.Patch.Selection.testSuite @@ -109,3 +113,7 @@ testSuite = qc_V3 (undefined :: FileUUID.Prim wX wY) ++ general_patchTests @(RepoPatchV3 FileUUID.Prim) ] + namedPatchV3Tests = testGroup "Named RepoPatchV3" + [ testGroup "using V2.Prim wrapper for Prim.V1" $ + qc_Named_V3 (undefined :: Prim2 wX wY) + ] diff --git a/harness/Darcs/Test/Patch/Arbitrary/Generic.hs b/harness/Darcs/Test/Patch/Arbitrary/Generic.hs index 397eefd7..bfd490c7 100644 --- a/harness/Darcs/Test/Patch/Arbitrary/Generic.hs +++ b/harness/Darcs/Test/Patch/Arbitrary/Generic.hs @@ -28,7 +28,7 @@ import Darcs.Patch.Witnesses.Ordered import Darcs.Patch.Apply ( Apply, ApplyState ) import Darcs.Patch.Effect ( Effect(..) ) import Darcs.Patch.Format ( PatchListFormat ) -import Darcs.Patch.Merge ( Merge(..) ) +import Darcs.Patch.Merge ( CleanMerge, Merge(..) ) import Darcs.Patch.Invert ( Invert(..) ) import Darcs.Patch.Commute ( Commute(..) ) import Darcs.Patch.FromPrim ( PrimOf ) @@ -125,7 +125,7 @@ type ShrinkPrim prim = ) type TestablePrim prim = - ( Apply prim, Commute prim, Invert prim, Eq2 prim + ( Apply prim, CleanMerge prim, Commute prim, Invert prim, Eq2 prim, Show2 prim , PatchListFormat prim, ShowPatchBasic prim, ReadPatch prim , RepoModel (ModelOf prim), ApplyState prim ~ RepoState (ModelOf prim) , ArbitraryPrim prim @@ -147,4 +147,3 @@ instance (Commute (OnlyPrim p), PrimBased p) => PrimBased (FL p) where type OnlyPrim (FL p) = FL (OnlyPrim p) primEffect = concatFL . mapFL_FL (primEffect @p) liftFromPrim = mapFL_FL liftFromPrim - diff --git a/harness/Darcs/Test/Patch/Arbitrary/RepoPatch.hs b/harness/Darcs/Test/Patch/Arbitrary/Mergeable.hs similarity index 94% rename from harness/Darcs/Test/Patch/Arbitrary/RepoPatch.hs rename to harness/Darcs/Test/Patch/Arbitrary/Mergeable.hs index 78e79cc0..ef326b05 100644 --- a/harness/Darcs/Test/Patch/Arbitrary/RepoPatch.hs +++ b/harness/Darcs/Test/Patch/Arbitrary/Mergeable.hs @@ -1,6 +1,6 @@ {-# LANGUAGE UndecidableInstances, ViewPatterns #-} -- | Test case generator for patch with a Merge instance -module Darcs.Test.Patch.Arbitrary.RepoPatch +module Darcs.Test.Patch.Arbitrary.Mergeable ( withSingle , withPair , withTriple @@ -8,7 +8,7 @@ module Darcs.Test.Patch.Arbitrary.RepoPatch , withSequence , withAllSequenceItems , NotRepoPatchV1(..) - , ArbitraryRepoPatch(..) + , ArbitraryMergeable(..) ) where import Darcs.Prelude @@ -23,7 +23,6 @@ import Darcs.Patch.Witnesses.Sealed import Darcs.Patch.Witnesses.Ordered hiding ( Fork ) import Darcs.Patch.Apply ( Apply(..) ) import Darcs.Patch.FromPrim ( PrimOf ) -import Darcs.Patch.RepoPatch ( RepoPatch ) import Darcs.Patch.V1 ( RepoPatchV1 ) import Data.Constraint @@ -33,11 +32,10 @@ data NotRepoPatchV1 p = NotRepoPatchV1 (forall prim . Dict (p ~ RepoPatchV1 prim -- | Class to simplify type signatures and superclass constraints. class - ( RepoPatch p - , ArbitraryPrim (PrimOf p) + ( ArbitraryPrim (PrimOf p) , ModelOf p ~ ModelOf (PrimOf p) , ApplyState p ~ RepoState (ModelOf p) - ) => ArbitraryRepoPatch p where + ) => ArbitraryMergeable p where notRepoPatchV1 :: Maybe (NotRepoPatchV1 p) diff --git a/harness/Darcs/Test/Patch/Arbitrary/Named.hs b/harness/Darcs/Test/Patch/Arbitrary/Named.hs index afc61e25..8181e0af 100644 --- a/harness/Darcs/Test/Patch/Arbitrary/Named.hs +++ b/harness/Darcs/Test/Patch/Arbitrary/Named.hs @@ -12,6 +12,7 @@ import Darcs.Test.Patch.Arbitrary.Shrink import Darcs.Test.Patch.RepoModel import Darcs.Test.Patch.WithState +import Darcs.Patch.Apply import Darcs.Patch.Commute import Darcs.Patch.Named import Darcs.Patch.Witnesses.Maybe @@ -21,13 +22,14 @@ import Darcs.Patch.Witnesses.Sealed import Control.Applicative ( (<|>) ) import Test.QuickCheck -type instance ModelOf (Named prim) = ModelOf prim +type instance ModelOf (Named p) = ModelOf p -instance ArbitraryState prim => ArbitraryState (Named prim) where +instance (ArbitraryState p, RepoModel (ModelOf p)) => ArbitraryState (Named p) where arbitraryState rm = do info <- arbitrary + deps <- sublistOf (appliedPatchNames rm) Sealed (WithEndState prims rm') <- arbitraryState rm - return $ Sealed $ WithEndState (NamedP info [] prims) rm' + return $ Sealed $ WithEndState (NamedP info deps prims) rm' instance (Commute p, Shrinkable p) => Shrinkable (Named p) where shrinkInternally (NamedP pi deps ps) = @@ -45,8 +47,11 @@ instance PropagateShrink prim p => PropagateShrink prim (Named p) where mps' :> mprim' <- propagateShrink (prim :> ps) return (mapMB_MB (NamedP pi deps) mps' :> mprim') -instance (Commute (OnlyPrim p), PrimBased p) => PrimBased (Named p) where +instance (Commute (OnlyPrim p), PrimBased p, RepoModel (ModelOf (OnlyPrim p))) => PrimBased (Named p) where type OnlyPrim (Named p) = Named (OnlyPrim p) primEffect (NamedP _ _ ps) = primEffect @(FL p) ps liftFromPrim (NamedP pi deps ps) = NamedP pi deps (liftFromPrim ps) + +instance Apply p => RepoApply (Named p) where + patchNames p = [patch2patchinfo p] diff --git a/harness/Darcs/Test/Patch/Arbitrary/PrimFileUUID.hs b/harness/Darcs/Test/Patch/Arbitrary/PrimFileUUID.hs index 0c6a3b08..04f07df7 100644 --- a/harness/Darcs/Test/Patch/Arbitrary/PrimFileUUID.hs +++ b/harness/Darcs/Test/Patch/Arbitrary/PrimFileUUID.hs @@ -55,6 +55,8 @@ instance ShrinkModel Prim where -- no shrinking for now shrinkModelPatch _ = [] +instance RepoApply Prim + ---------------------------------------------------------------------- -- * QuickCheck generators diff --git a/harness/Darcs/Test/Patch/Arbitrary/PrimV1.hs b/harness/Darcs/Test/Patch/Arbitrary/PrimV1.hs index 8c68de0f..b067c96f 100644 --- a/harness/Darcs/Test/Patch/Arbitrary/PrimV1.hs +++ b/harness/Darcs/Test/Patch/Arbitrary/PrimV1.hs @@ -82,6 +82,9 @@ instance Shrinkable Prim.Prim where deriving instance Shrinkable V1.Prim deriving instance Shrinkable V2.Prim +instance RepoApply Prim1 +instance RepoApply Prim2 + ---------------------------------------------------------------------- -- * QuickCheck generators @@ -236,8 +239,11 @@ aModelShrinkFileContent repo = do -- | Generates any type of 'prim' patch, except binary and setpref patches. -aPrim :: forall prim wX . (PrimPatch prim, ApplyState prim ~ RepoState V1Model) - => V1Model wX -> Gen (Sealed (WithEndState V1Model (prim wX))) +aPrim + :: forall prim wX + . (PrimPatch prim, ApplyState prim ~ RepoState V1Model, RepoApply prim) + => V1Model wX + -> Gen (Sealed (WithEndState V1Model (prim wX))) aPrim repo = do mbFile <- maybeOf repoFiles mbEmptyFile <- maybeOf $ filter (isEmpty . snd) repoFiles @@ -306,6 +312,7 @@ aPrimPair :: ( PrimPatch prim , ArbitraryState prim , ApplyState prim ~ RepoState V1Model , ModelOf prim ~ V1Model + , RepoApply prim ) => V1Model wX -> Gen (Sealed (WithEndState V1Model (Pair prim wX))) diff --git a/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV1.hs b/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV1.hs index ffa18d8c..85f713be 100644 --- a/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV1.hs +++ b/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV1.hs @@ -34,7 +34,7 @@ import Darcs.Patch.Witnesses.Sealed ( Sealed(Sealed) ) import Darcs.Test.Patch.Arbitrary.Generic ( MightHaveDuplicate, ArbitraryPrim, PrimBased(..) ) -import Darcs.Test.Patch.Arbitrary.RepoPatch +import Darcs.Test.Patch.Arbitrary.Mergeable import Darcs.Test.Patch.Merge.Checked ( CheckedMerge(..) ) import Darcs.Test.Patch.RepoModel ( RepoState, ModelOf ) import Darcs.Test.Patch.Types.Pair ( Pair(..) ) @@ -47,7 +47,7 @@ type Patch = RepoPatchV1 V1.Prim instance (ArbitraryPrim prim, PrimPatch prim, ApplyState prim ~ RepoState (ModelOf prim)) - => ArbitraryRepoPatch (RepoPatchV1 prim) + => ArbitraryMergeable (RepoPatchV1 prim) where notRepoPatchV1 = Nothing diff --git a/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV2.hs b/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV2.hs index 3b227607..b0a9370d 100644 --- a/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV2.hs +++ b/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV2.hs @@ -12,7 +12,7 @@ import Darcs.Test.Patch.Arbitrary.Generic , MightHaveDuplicate(..) , PrimBased(..) ) -import Darcs.Test.Patch.Arbitrary.RepoPatch +import Darcs.Test.Patch.Arbitrary.Mergeable import Darcs.Test.Patch.Merge.Checked ( CheckedMerge(..) ) import Darcs.Test.Patch.RepoModel ( RepoState, ModelOf ) import Darcs.Test.Patch.WithState ( PropagateShrink ) @@ -30,7 +30,7 @@ instance ( ArbitraryPrim prim , PrimPatch prim , ApplyState prim ~ RepoState (ModelOf prim) ) => - ArbitraryRepoPatch (RepoPatchV2 prim) where + ArbitraryMergeable (RepoPatchV2 prim) where notRepoPatchV1 = Just (NotRepoPatchV1 (\case {})) instance PrimPatch prim => CheckedMerge (RepoPatchV2 prim) where diff --git a/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV3.hs b/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV3.hs index 275a6e75..dc8e28c2 100644 --- a/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV3.hs +++ b/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV3.hs @@ -6,7 +6,7 @@ import Darcs.Prelude import Darcs.Test.Patch.Arbitrary.Generic ( MightHaveDuplicate(..), PrimBased(..), ArbitraryPrim ) import Darcs.Test.Patch.Arbitrary.NamedPrim () -import Darcs.Test.Patch.Arbitrary.RepoPatch +import Darcs.Test.Patch.Arbitrary.Mergeable import Darcs.Test.Patch.Merge.Checked ( CheckedMerge ) import Darcs.Test.Patch.RepoModel ( RepoState, ModelOf ) import Darcs.Test.Patch.WithState ( PropagateShrink ) @@ -26,7 +26,7 @@ type instance ModelOf (RepoPatchV3 prim) = ModelOf prim instance (ArbitraryPrim prim, PrimPatch prim, ApplyState prim ~ RepoState (ModelOf prim)) - => ArbitraryRepoPatch (RepoPatchV3 prim) + => ArbitraryMergeable (RepoPatchV3 prim) where notRepoPatchV1 = Just (NotRepoPatchV1 (\case {})) diff --git a/harness/Darcs/Test/Patch/Examples/Set2.hs b/harness/Darcs/Test/Patch/Examples/Set2.hs new file mode 100644 index 00000000..b0480365 --- /dev/null +++ b/harness/Darcs/Test/Patch/Examples/Set2.hs @@ -0,0 +1,513 @@ +-- Copyright (C) 2007 David Roundy +-- +-- This program is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2, or (at your option) +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program; see the file COPYING. If not, write to +-- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +-- Boston, MA 02110-1301, USA. + +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-orphans #-} +module Darcs.Test.Patch.Examples.Set2 + ( primPermutables + , primPatches + , commutables + , commutablesFL + , repov2Commutables + , repov2Mergeables + , repov2Triples + , repov2NonduplicateTriples + , repov2Patches + , repov2PatchLoopExamples + ) where + +import Darcs.Prelude + +import qualified Data.ByteString.Char8 as BC ( pack ) +import Data.Maybe ( catMaybes ) +import Data.String ( IsString(..) ) +import qualified Data.ByteString as B ( ByteString ) + +import Darcs.Patch ( hunk, invert ) +import Darcs.Patch.Commute ( Commute(..) ) +import Darcs.Patch.FromPrim ( fromAnonymousPrim ) +import Darcs.Patch.Invert ( Invert ) +import Darcs.Patch.Merge ( Merge, merge, mergeFL ) +import Darcs.Patch.Prim ( PrimPatch ) +import Darcs.Patch.V2 ( RepoPatchV2 ) +import qualified Darcs.Patch.V2.Prim as V2 +import Darcs.Patch.Witnesses.Ordered +import Darcs.Patch.Witnesses.Sealed +import Darcs.Patch.Witnesses.Unsafe ( unsafeCoercePEnd, unsafeCoercePStart ) +import Darcs.Util.Path ( AnchoredPath, makeName, unsafeFloatPath ) + +import Darcs.Test.Patch.Arbitrary.Generic ( notDuplicatestriple ) +import Darcs.Test.Patch.Arbitrary.PatchTree + ( Tree(..) + , TreeWithFlattenPos(..) + , canonizeTree + , commutePairFromTWFP + , commutePairFromTree + , commuteTripleFromTree + , getPairs + , getTriples + , mergePairFromCommutePair + ) +import Darcs.Test.Patch.Arbitrary.PrimV1 () +import Darcs.Test.Patch.Arbitrary.RepoPatchV2 () +import Darcs.Test.Patch.Types.Merged ( Merged ) +import Darcs.Test.Patch.V1Model ( Content, V1Model, makeFile, makeRepo ) +import Darcs.Test.Patch.WithState ( WithStartState(..) ) + +instance IsString AnchoredPath where + fromString = unsafeFloatPath + +type Prim2 = V2.Prim + +type Patch = RepoPatchV2 Prim2 + +makeSimpleRepo :: String -> Content -> V1Model wX +makeSimpleRepo filename content = + makeRepo [(either error id $ makeName filename, makeFile content)] + +withStartState :: s wX -> p wX -> Sealed (WithStartState s p) +withStartState s p = seal (WithStartState s p) + +tripleExamples :: [Sealed2 (Patch :> Patch :> Patch)] +tripleExamples = + catMaybes + [ commuteTripleFromTree seal2 $ + withStartState + (makeSimpleRepo "file" []) + (ParTree + (SeqTree + (hunk "file" 1 [] ["g"]) + (SeqTree + (hunk "file" 2 [] ["j"]) + (SeqTree (hunk "file" 1 [] ["s"]) NilTree))) + (SeqTree (hunk "file" 1 [] ["e"]) NilTree)) + , commuteTripleFromTree seal2 $ + withStartState + (makeSimpleRepo "file" ["j"]) + (ParTree + (SeqTree + (hunk "file" 1 [] ["s"]) + (ParTree + (SeqTree (hunk "file" 2 ["j"] []) NilTree) + (SeqTree (hunk "file" 2 ["j"] []) NilTree))) + (SeqTree (hunk "file" 1 ["j"] []) NilTree)) + ] + +mergeExamples :: [Sealed2 (Patch :\/: Patch)] +mergeExamples = map (unseal2 (mergePairFromCommutePair seal2)) commuteExamples + +commuteExamples :: [Sealed2 (Patch :> Patch)] +commuteExamples = + catMaybes + [ commutePairFromTWFP seal2 $ + withStartState (makeSimpleRepo "file" []) + (TWFP 3 + (ParTree + (SeqTree (hunk "file" 1 [] ["h"]) NilTree) + (SeqTree (hunk "file" 1 [] ["b"]) + (SeqTree (hunk "file" 1 [] ["f"]) + (SeqTree (hunk "file" 1 [] ["v"]) + (SeqTree (hunk "file" 2 ["f"] []) NilTree)))))) + , commutePairFromTWFP seal2 $ + withStartState + (makeSimpleRepo "file" ["f","s","d"]) + (TWFP 3 + (ParTree + (SeqTree (hunk "file" 3 ["d"] []) NilTree) + (ParTree + (SeqTree (hunk "file" 1 ["f"] []) NilTree) + (SeqTree (hunk "file" 1 ["f"] []) + (SeqTree (hunk "file" 1 ["s","d"] []) + (SeqTree (hunk "file" 1 [] ["v"]) NilTree)))))) +{- , commutePairFromTWFP seal2 $ + withStartState + (makeSimpleRepo "file" ["f","u", + "s","d"]) + (TWFP 5 + (ParTree + (SeqTree (hunk "file" 5 [] ["x"]) + (SeqTree (hunk "file" 4 ["d"] []) NilTree)) + (ParTree + (SeqTree (hunk "file" 1 ["f","u"] []) NilTree) + (SeqTree (hunk "file" 1 ["f"] []) + (SeqTree (hunk "file" 1 ["u","s","d"] []) + (SeqTree (hunk "file" 1 [] ["a"]) + (SeqTree (hunk "file" 1 ["a"] []) NilTree))))))) +-} + , commutePairFromTree seal2 $ + withStartState (makeSimpleRepo "file" ["n","t","h"]) + (ParTree + (SeqTree (hunk "file" 1 ["n","t","h"] []) + NilTree) + (SeqTree (hunk "file" 3 ["h"] []) + (SeqTree (hunk "file" 1 ["n"] []) + (SeqTree (hunk "file" 1 ["t"] []) NilTree)))) + , commutePairFromTree seal2 $ + withStartState (makeSimpleRepo "file" []) + (ParTree + (SeqTree (hunk "file" 1 [] ["n"]) NilTree) + (SeqTree (hunk "file" 1 [] ["i"]) + (SeqTree (hunk "file" 1 [] ["i"]) NilTree))) + , commutePairFromTree seal2 $ + withStartState (makeSimpleRepo "file" []) + (ParTree + (SeqTree (hunk "file" 1 [] ["c"]) + (ParTree + (SeqTree (hunk "file" 1 ["c"] ["r"]) NilTree) + (SeqTree (hunk "file" 1 [] ["h"]) + (SeqTree (hunk "file" 1 [] ["d"]) NilTree)))) + (SeqTree (hunk "file" 1 [] ["f"]) NilTree)) + , commutePairFromTWFP seal2 $ + withStartState (makeSimpleRepo "file" []) + (TWFP 1 + (ParTree + (ParTree + (SeqTree (hunk "file" 1 [] ["t"]) NilTree) + (SeqTree (hunk "file" 1 [] ["t"]) NilTree)) + (SeqTree (hunk "file" 1 [] ["f"]) NilTree))) + , commutePairFromTWFP seal2 $ + withStartState + (makeSimpleRepo "file" ["f", " r", "c", "v"]) + (TWFP 4 + (ParTree + (SeqTree (hunk "file" 3 ["c","v"] []) + (ParTree + (SeqTree (hunk "file" 2 ["r"] []) + (SeqTree (hunk "fi le" 1 ["f"] []) NilTree)) + (SeqTree (hunk "file" 1 ["f","r"] []) + (SeqTree (hunk "file" 1 [] ["y"]) NilTree)))) + (SeqTree (hunk "file" 4 ["v"] []) NilTree))) + , commutePairFromTree seal2 $ + withStartState (makeSimpleRepo "file" []) + (ParTree + (SeqTree (hunk "file" 1 [] ["z"]) NilTree) + (ParTree + (SeqTree (hunk "file" 1 [] ["f"]) NilTree) + (ParTree + (SeqTree (hunk "file" 1 [] ["r"]) NilTree) + (SeqTree (hunk "file" 1 [] ["d"]) NilTree)))) + , commutePairFromTree seal2 $ + withStartState (makeSimpleRepo "file" ["t","r","h"]) + (ParTree + (ParTree + (SeqTree (hunk "file" 1 ["t","r","h"] []) + NilTree) + (SeqTree (hunk "file" 1 [] ["o"]) NilTree)) + (SeqTree (hunk "file" 1 ["t"] []) + (SeqTree (hunk "file" 2 ["h"] []) NilTree))) + , commutePairFromTWFP seal2 $ + withStartState (makeSimpleRepo "file" []) $ + TWFP 2 + (ParTree + (SeqTree (hunk "file" 1 [] ["h"]) NilTree) + (SeqTree (hunk "file" 1 [] ["y"]) + (SeqTree (hunk "file" 2 [] ["m"]) + (SeqTree (hunk "file" 1 [] ["v"]) NilTree)))) + , commutePairFromTree seal2 $ + withStartState (makeSimpleRepo "file" []) + (ParTree + (SeqTree (hunk "file" 1 [] ["p"]) + (SeqTree (hunk "file" 1 ["p"] []) + (SeqTree (hunk "file" 1 [] ["c"]) NilTree))) + (SeqTree (hunk "file" 1 [] ["z"]) NilTree)) + , commutePairFromTree seal2 $ + withStartState (makeSimpleRepo "file" []) + (ParTree + (SeqTree (hunk "file" 1 [] ["j" ]) + (SeqTree (hunk "file" 1 ["j"] []) NilTree)) + (SeqTree (hunk "file" 1 [] ["v"]) NilTree)) + , commutePairFromTree seal2 $ + withStartState (makeSimpleRepo "file" []) + (ParTree + (SeqTree (hunk "file" 1 [] ["v"]) NilTree) + (SeqTree (hunk "file" 1 [] ["j" ]) + (SeqTree (hunk "file" 1 ["j"] []) NilTree))) + , commutePairFromTree seal2 $ + withStartState (makeSimpleRepo "file" ["x","c"]) + (ParTree + (SeqTree (hunk "file" 1 [] ["h"]) + (ParTree + (SeqTree (hunk "file" 3 ["c"] []) NilTree) + (SeqTree (hunk "file" 2 ["x"] []) + (SeqTree (hunk "file" 1 [] ["j"]) NilTree)))) + (SeqTree (hunk "file" 1 [] ["l"]) NilTree)) + , commutePairFromTree seal2 $ + withStartState (makeSimpleRepo "file" []) + (ParTree + (SeqTree (hunk "file" 1 [] (packStringLetters "s")) NilTree) + (SeqTree (hunk "file" 1 [] (packStringLetters "k")) + (SeqTree (hunk "file" 1 (packStringLetters "k") []) + (SeqTree (hunk "file" 1 [] (packStringLetters "m")) + (SeqTree (hunk "file" 1 (packStringLetters "m") []) NilTree))))) + ] + +packStringLetters :: String -> [B.ByteString] +packStringLetters s = [ BC.pack [c] | c <- s ] + +repov2PatchLoopExamples :: [Sealed (WithStartState V1Model (Tree Prim2))] +repov2PatchLoopExamples = + [Sealed (WithStartState (makeSimpleRepo fx []) + $ canonizeTree + (ParTree + (SeqTree (hunk fx 1 [] (packStringLetters "pkotufogbvdabnmbzajvolwviqebieonxvcvuvigkfgybmqhzuaaurjspd")) + (ParTree + (SeqTree (hunk fx 47 (packStringLetters "qhzu") (packStringLetters "zafybdcokyjskcgnvhkbzpysaafnjjhcstgrczplxsfwagmh")) + (ParTree + (ParTree + NilTree + (ParTree + (ParTree + (ParTree + (SeqTree (hunk fx 15 (packStringLetters "mbzajvolwviqebieonxvcvuvigkfgyb") (packStringLetters "vujnxnhvybvpouyciaabszfmgssezlwwjgnethvrpnfrkubphzvdgymjjoacppqps")) + (ParTree + NilTree + (ParTree + (SeqTree (hunk fx 40 (packStringLetters "ssezlwwjgnethvrpnfrkubphzvdgymjjoacppqpsmzafybdcokyjskcgnvhkbz") (packStringLetters "wnesidpccwoiqiichxaaejdsyrhrusqljlcoro")) + (ParTree + (ParTree + (SeqTree (hunk fx 12 (packStringLetters "abnvujnxnhvybvpouyciaabszfmgwnesidpccwoiqii") (packStringLetters "czfdhqkipdstfjycqaxwnbxrihrufdeyneqiiiafwzlmg")) NilTree) + NilTree) + NilTree)) + (SeqTree (hunk fx 25 [] (packStringLetters "dihgmsotezucqdgxczvcivijootyvhlwymbiueufnvpwpeukmskqllalfe")) NilTree)))) + (SeqTree (hunk fx 56 (packStringLetters "yjskcgnvhkbzpysaafnjjhcstgrczplxsfwagmhaaurjsp") (packStringLetters "xldhrutyhcyaqeezwujiguawfyawjjqlirxshjddvq")) NilTree)) + (SeqTree (hunk fx 20 [] (packStringLetters "ooygwiyogqrqnytixqtmvdxx")) + (SeqTree (hunk fx 26 (packStringLetters "yogqrqnytixqtmvdxxvolwviqebieonxvcvuvigkfgybmzafybdcokyjskcgnvhkbz") (packStringLetters "akhsmlbkdxnvfoikmiatfbpzdrsyykkpoxvvddeaspzxe")) + (SeqTree (hunk fx 39 [] (packStringLetters "ji")) + (ParTree + NilTree + (ParTree + NilTree + (ParTree + (ParTree + NilTree + (SeqTree (hunk fx 26 (packStringLetters "akhsmlbkdxnvfjioikmiatfbpzdrsyykkpoxvvddeaspzxepysaafnjjhcstgrczplxs") (packStringLetters "onjbhddskcj")) + (SeqTree (hunk fx 39 [] (packStringLetters "fyscunxxxjjtyqpfxeznhtwvlphmp")) NilTree))) + (ParTree + NilTree + (SeqTree (hunk fx 44 [] (packStringLetters "xcchzwmzoezxkmkhcmesplnjpqriypshgiqklgdnbmmkldnydiy")) + (ParTree + NilTree + (SeqTree (hunk fx 64 (packStringLetters "plnjpqriypshgiqklgdnbmmkldnydiymiatfbpzdrsyykkpoxvvddeaspzxepysaafn") (packStringLetters "anjlzfdqbjqbcplvqvkhwjtkigp")) NilTree))))))))))) + (ParTree + NilTree + NilTree))) + NilTree)) + NilTree)) + (ParTree + NilTree + (SeqTree (hunk fx 1 [] (packStringLetters "ti")) + (SeqTree (hunk fx 1 (packStringLetters "t") (packStringLetters "ybcop")) + (SeqTree (hunk fx 2 [] (packStringLetters "dvlhgwqlpaeweerqrhnjtfolczbqbzoccnvdsyqiefqitrqneralf")) + (SeqTree (hunk fx 15 [] (packStringLetters "yairbjphwtnaerccdlfewujvjvmjakbc")) + (SeqTree (hunk fx 51 [] (packStringLetters "xayvfuwaiiogginufnhsrmktpmlbvxiakjwllddkiyofyfw")) + (ParTree + NilTree + NilTree)))))))))] + where + fx :: IsString a => a + fx = "F" + +quickhunk :: PrimPatch prim => Int -> String -> String -> prim wX wY +quickhunk l o n = + hunk "test" l (map (\c -> BC.pack [c]) o) (map (\c -> BC.pack [c]) n) + +primPermutables :: [(Prim2 :> Prim2 :> Prim2) wX wY] +primPermutables = + [quickhunk 0 "e" "bo" :> quickhunk 3 "" "x" :> quickhunk 2 "f" "qljo"] + +mergeables :: [(Prim2 :\/: Prim2) wX wY] +mergeables = + [ quickhunk 1 "a" "b" :\/: quickhunk 1 "a" "c" + , quickhunk 1 "a" "b" :\/: quickhunk 3 "z" "c" + , quickhunk 0 "" "a" :\/: quickhunk 1 "" "b" + , quickhunk 0 "a" "" :\/: quickhunk 1 "" "b" + , quickhunk 0 "a" "" :\/: quickhunk 1 "b" "" + , quickhunk 0 "" "a" :\/: quickhunk 1 "b" "" + ] + +mergeablesFL :: [(FL Prim2 :\/: FL Prim2) wX wY] +mergeablesFL = map (\(x :\/: y) -> (x :>: NilFL) :\/: (y :>: NilFL)) mergeables + -- ++ [(quickhunk 1 "a" "b" :>: quickhunk 3 "z" "c" :>: NilFL) + -- :\/: (quickhunk 1 "a" "z" :>: NilFL), + -- (quickhunk 1 "a" "b" :>: quickhunk 1 "b" "c" :>: NilFL) + -- :\/: (quickhunk 1 "a" "z" :>: NilFL)] + +mergeable2commutable :: Invert p => (p :\/: p) wX wY -> (p :> p) wX wY +mergeable2commutable (x :\/: y) = (invert x) :> y + +commutablesFL :: [(FL Prim2 :> FL Prim2) wX wY] +commutablesFL = map mergeable2commutable mergeablesFL + +commutables :: [(Prim2 :> Prim2) wX wY] +commutables = map mergeable2commutable mergeables + +primPatches :: [Sealed2 Prim2] +primPatches = concatMap mergeable2patches mergeables + where + mergeable2patches (x :\/: y) = [Sealed2 x, Sealed2 y] + +repov2Patches :: [Sealed2 Patch] +repov2Patches = concatMap commutable2patches repov2Commutables + where + commutable2patches (Sealed2 (x :> y)) = [Sealed2 x, Sealed2 y] + +typedMerge + :: Merge p => (p :\/: p) wA wB -> (p wA (Merged wA wB), p wB (Merged wA wB)) +typedMerge (p :\/: q) = + case merge (p :\/: q) of + (q' :/\: p') -> (unsafeCoercePEnd q', unsafeCoercePEnd p') + +repov2Triples :: [Sealed2 (Patch :> Patch :> Patch)] +repov2Triples + | oa <- fromAnonymousPrim $ quickhunk 1 "o" "aa" + , oa2 <- fromAnonymousPrim $ quickhunk 1 "o" "aa" + , a2 <- fromAnonymousPrim $ quickhunk 2 "a34" "2xx" + , ob <- fromAnonymousPrim $ quickhunk 1 "o" "bb" + , (ob', oa') <- typedMerge (oa :\/: ob) + , (a2', _) <- typedMerge (ob' :\/: a2) + , (a2'', _) <- typedMerge (oa2 :\/: a2') = + [Sealed2 (ob' :> oa2 :> a2''), Sealed2 (oa' :> oa2 :> a2'')] ++ + tripleExamples ++ getTriples repov2FL + +repov2NonduplicateTriples :: [Sealed2 (Patch :> Patch :> Patch)] +repov2NonduplicateTriples = filter (unseal2 notDuplicatestriple) repov2Triples + +repov2FL :: FL Patch wX wX +repov2FL + | oa <- fromAnonymousPrim $ quickhunk 1 "o" "a" + , ps :/\: _ <- + merge (oa :>: invert oa :>: nilFL :\/: oa :>: invert oa :>: nilFL) = + oa :>: invert oa :>: oa :>: invert oa :>: + unsafeCoercePEnd ps +>+ oa :>: invert oa :>: nilFL + +repov2Commutables :: [Sealed2 (Patch :> Patch)] +repov2Commutables + | oa <- fromAnonymousPrim $ quickhunk 1 "o" "a" + , ob <- fromAnonymousPrim $ quickhunk 1 "o" "b" + , _ :/\: ob' <- mergeFL (ob :\/: oa :>: invert oa :>: nilFL) = + commuteExamples ++ + map (mapSeal2 mergeable2commutable) repov2Mergeables ++ + [Sealed2 (invert oa :> ob')] ++ + getPairs repov2FL + +repov2Mergeables :: [Sealed2 (Patch :\/: Patch)] +repov2Mergeables + | oa <- fromAnonymousPrim $ quickhunk 1 "o" "aa" + , a2 <- fromAnonymousPrim $ quickhunk 2 "a34" "2xx" + , og <- fromAnonymousPrim $ quickhunk 3 "4" "g" + , ob <- fromAnonymousPrim $ quickhunk 1 "o" "bb" + , b2 <- fromAnonymousPrim $ quickhunk 2 "b" "2" + , oc <- fromAnonymousPrim $ quickhunk 1 "o" "cc" + , od <- fromAnonymousPrim $ quickhunk 7 "x" "d" + , oe <- fromAnonymousPrim $ quickhunk 7 "x" "e" + , pf <- fromAnonymousPrim $ quickhunk 7 "x" "f" + , od'' <- fromAnonymousPrim $ quickhunk 8 "x" "d" + , ob' :>: b2' :>: _ :/\: _ <- mergeFL (oa :\/: ob :>: b2 :>: nilFL) + , a2' :/\: _ <- merge (ob' :\/: a2) + , ob'' :/\: _ <- merge (a2 :\/: ob') + , og' :/\: _ <- merge (oa :\/: og) + , og'' :/\: _ <- merge (a2 :\/: og') + , og''' :/\: _ <- merge (ob' :\/: og') + , oc' :/\: _ <- merge (oa :\/: oc) + , oc'' :/\: _ <- merge (a2 :\/: oc) + , oc''' :/\: _ <- merge (ob' :\/: oc') + , oe' :/\: _ <- merge (od :\/: oe) + , of' :/\: _ <- merge (od :\/: pf) = + map + (\(x :\/: y) -> Sealed2 (fromAnonymousPrim x :\/: fromAnonymousPrim y)) + mergeables ++ + repov2IglooMergeables ++ + repov2QuickcheckMergeables ++ + mergeExamples ++ + catMaybes (map pair2m (getPairs repov2FL)) ++ + [ Sealed2 (oa :\/: od) + , Sealed2 (oa :\/: unsafeCoercePStart a2') + , Sealed2 (ob' :\/: od'') + , Sealed2 (oe :\/: od) + , Sealed2 (of' :\/: oe') + , Sealed2 (ob' :\/: oe') + , Sealed2 (oa :\/: oe') + , Sealed2 (ob' :\/: oc') + , Sealed2 (b2' :\/: oc''') + , Sealed2 (ob' :\/: a2) + , Sealed2 (b2' :\/: og''') + , Sealed2 (oc''' :\/: og''') + , Sealed2 (oc'' :\/: og'') + , Sealed2 (ob'' :\/: og'') + , Sealed2 (ob'' :\/: oc'') + , Sealed2 (oc' :\/: od'') + ] + | otherwise = error "impossible" + +repov2IglooMergeables :: [Sealed2 (Patch :\/: Patch)] +repov2IglooMergeables + | a <- fromAnonymousPrim $ quickhunk 1 "1" "A" + , b <- fromAnonymousPrim $ quickhunk 2 "2" "B" + , c <- fromAnonymousPrim $ quickhunk 3 "3" "C" + , x <- fromAnonymousPrim $ quickhunk 1 "1BC" "xbc" + , y <- fromAnonymousPrim $ quickhunk 1 "A2C" "ayc" + , z <- fromAnonymousPrim $ quickhunk 1 "AB3" "abz" + , x' :/\: _ <- merge (a :\/: x) + , y' :/\: _ <- merge (b :\/: y) + , z' :/\: _ <- merge (c :\/: z) = + [ Sealed2 (a :\/: b) + , Sealed2 (b :\/: c) + , Sealed2 (a :\/: c) + , Sealed2 (x :\/: a) + , Sealed2 (y :\/: b) + , Sealed2 (z :\/: c) + , Sealed2 (x' :\/: y') + , Sealed2 (z' :\/: y') + , Sealed2 (x' :\/: z') + , Sealed2 (a :\/: a) + ] + +repov2QuickcheckMergeables :: [Sealed2 (Patch :\/: Patch)] +repov2QuickcheckMergeables + | hb <- fromAnonymousPrim $ quickhunk 0 "" "hb" + , k <- fromAnonymousPrim $ quickhunk 0 "" "k" + , n <- fromAnonymousPrim $ quickhunk 0 "" "n" + , b <- fromAnonymousPrim $ quickhunk 1 "b" "" + , d <- fromAnonymousPrim $ quickhunk 2 "" "d" + , d' :/\: _ <- merge (b :\/: d) + -- , k1 :>: n1 :>: _ :/\: _ <- mergeFL (hb :\/: k :>: n :>: nilFL) + -- , k2 :>: n2 :>: _ :/\: _ <- merge (hb :>: b :>: nilFL :\/: k :>: n :>: nilFL) + , k' :>: n' :>: _ :/\: _ :>: b' :>: _ <- + merge (hb :>: b :>: d' :>: nilFL :\/: k :>: n :>: nilFL) + , i <- fromAnonymousPrim $ quickhunk 0 "" "i" + , x <- fromAnonymousPrim $ quickhunk 0 "" "x" + , xi <- fromAnonymousPrim $ quickhunk 0 "xi" "" + , d3 :/\: _ <- merge (xi :\/: d) + , _ :/\: k3 <- mergeFL (k :\/: i :>: x :>: xi :>: d3 :>: nilFL) = + -- Merging inverted RepoPatchV2 is no longer supported: + -- [Sealed2 (invert k1 :\/: n1), Sealed2 (invert k2 :\/: n2)] ++ + [ Sealed2 (hb :\/: k) + , Sealed2 (b' :\/: b') + , Sealed2 (n' :\/: n') + , Sealed2 (b :\/: d) + , Sealed2 (k' :\/: k') + , Sealed2 (k3 :\/: k3) + ] ++ catMaybes (map pair2m (getPairs (hb :>: b :>: d' :>: k' :>: n' :>: nilFL))) + | otherwise = error "impossible" + +pair2m :: Sealed2 (Patch :> Patch) -> Maybe (Sealed2 (Patch :\/: Patch)) +pair2m (Sealed2 (xx :> y)) = do + y' :> _ <- commute (xx :> y) + return $ Sealed2 (xx :\/: y') + +nilFL :: FL Patch wX wX +nilFL = NilFL diff --git a/harness/Darcs/Test/Patch/Examples/Set2Unwitnessed.hs b/harness/Darcs/Test/Patch/Examples/Set2Unwitnessed.hs deleted file mode 100644 index 01cffe60..00000000 --- a/harness/Darcs/Test/Patch/Examples/Set2Unwitnessed.hs +++ /dev/null @@ -1,503 +0,0 @@ --- Copyright (C) 2007 David Roundy --- --- This program is free software; you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation; either version 2, or (at your option) --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program; see the file COPYING. If not, write to --- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, --- Boston, MA 02110-1301, USA. - -{-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -Wno-orphans #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - -module Darcs.Test.Patch.Examples.Set2Unwitnessed - ( primPermutables, primPatches - , commutables, commutablesFL - , repov2Commutables , repov2Mergeables, repov2Triples - , repov2NonduplicateTriples, repov2Patches, repov2PatchLoopExamples - ) where - -import Darcs.Prelude - -import Data.Maybe ( catMaybes ) -import qualified Data.ByteString.Char8 as BC ( pack ) -import Data.String ( IsString(..) ) - -import Darcs.Patch.Witnesses.Sealed -import Darcs.Patch ( invert, hunk ) -import Darcs.Patch.Commute ( Commute ) -import Darcs.Patch.Invert ( Invert ) -import Darcs.Patch.FromPrim ( fromAnonymousPrim ) -import Darcs.Patch.Prim ( PrimPatch ) -import Darcs.Patch.V2 ( RepoPatchV2 ) --- import Darcs.Test.Patch.Test () -- for instance Eq Patch --- import Darcs.Test.Patch.Examples.Set2Unwitnessed -import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP ) -import qualified Darcs.Test.Patch.Arbitrary.Generic as W ( notDuplicatestriple ) -import Darcs.Test.Patch.Arbitrary.RepoPatchV2 () -import Darcs.Test.Patch.Arbitrary.PrimV1 () ---import Darcs.Util.Printer ( greenText ) ---import Darcs.Util.Printer.Color ( traceDoc ) ---import Darcs.Util.Printer.Color ( errorDoc ) -import Darcs.Util.Printer.Color () -- for instance Show Doc -import Darcs.Test.Patch.WSub - - -import qualified Darcs.Patch.Witnesses.Ordered as W ( (:>), (:\/:) ) -import qualified Data.ByteString as B ( ByteString ) -import Darcs.Test.Patch.V1Model ( V1Model, Content - , makeRepo, makeFile) -import Darcs.Test.Patch.WithState ( WithStartState(..) ) -import Darcs.Util.Path ( AnchoredPath, unsafeFloatPath, makeName ) -import Darcs.Patch.FromPrim ( PrimPatchBase(..), FromPrim ) -import Darcs.Patch.Merge ( Merge ) -import Darcs.Test.Patch.Arbitrary.PatchTree - ( Tree(..) - , TreeWithFlattenPos(..) - , commutePairFromTree, commuteTripleFromTree - , mergePairFromCommutePair, commutePairFromTWFP - , canonizeTree - ) - -instance IsString AnchoredPath where - fromString = unsafeFloatPath - - --- import Debug.Trace - -type Patch = RepoPatchV2 Prim2 - -makeSimpleRepo :: String -> Content -> V1Model wX -makeSimpleRepo filename content = - makeRepo [(either error id $ makeName filename, makeFile content)] - -withStartState :: s wX -> p wX -> Sealed (WithStartState s p) -withStartState s p = seal (WithStartState s p) - -w_tripleExamples :: (FromPrim p, Merge p, PrimPatchBase p) - => [Sealed2 (p W.:> p W.:> p)] -w_tripleExamples = catMaybes [commuteTripleFromTree seal2 $ - withStartState (makeSimpleRepo "file" []) - (ParTree - (SeqTree (hunk "file" 1 [] [BC.pack "g"]) - (SeqTree (hunk "file" 2 [] [BC.pack "j"]) - (SeqTree (hunk "file" 1 [] [BC.pack "s"]) NilTree))) - (SeqTree (hunk "file" 1 [] [BC.pack "e"]) NilTree)) - ,commuteTripleFromTree seal2 $ - withStartState (makeSimpleRepo "file" [BC.pack "j"]) - (ParTree - (SeqTree (hunk "file" 1 [] [BC.pack "s"]) - (ParTree - (SeqTree (hunk "file" 2 [BC.pack "j"] []) NilTree) - (SeqTree (hunk "file" 2 [BC.pack "j"] []) NilTree))) - (SeqTree (hunk "file" 1 [BC.pack "j"] []) NilTree)) - ] - - -w_mergeExamples :: (FromPrim p, Commute p, Merge p, PrimPatchBase p) - => [Sealed2 (p W.:\/: p)] -w_mergeExamples = map (unseal2 (mergePairFromCommutePair seal2)) w_commuteExamples - -w_commuteExamples :: (FromPrim p, Merge p, PrimPatchBase p) => [Sealed2 (p W.:> p)] -w_commuteExamples = catMaybes [ - commutePairFromTWFP seal2 $ - withStartState (makeSimpleRepo "file" []) - (TWFP 3 - (ParTree - (SeqTree (hunk "file" 1 [] [BC.pack "h"]) NilTree) - (SeqTree (hunk "file" 1 [] [BC.pack "b"]) - (SeqTree (hunk "file" 1 [] [BC.pack "f"]) - (SeqTree (hunk "file" 1 [] [BC.pack "v"]) - (SeqTree (hunk "file" 2 [BC.pack "f"] []) NilTree)))))), - commutePairFromTWFP seal2 $ - withStartState - (makeSimpleRepo "file" [BC.pack "f",BC.pack "s",BC.pack "d"]) - (TWFP 3 - (ParTree - (SeqTree (hunk "file" 3 [BC.pack "d"] []) NilTree) - (ParTree - (SeqTree (hunk "file" 1 [BC.pack "f"] []) NilTree) - (SeqTree (hunk "file" 1 [BC.pack "f"] []) - (SeqTree (hunk "file" 1 [BC.pack "s",BC.pack "d"] []) - (SeqTree (hunk "file" 1 [] [BC.pack "v"]) NilTree)))))), -{- commutePairFromTWFP seal2 $ - withStartState - (makeSimpleRepo "file" [BC.pack "f",BC.pack "u", - BC.pack "s",BC.pack "d"]) - (TWFP 5 - (ParTree - (SeqTree (hunk "file" 5 [] [BC.pack "x"]) - (SeqTree (hunk "file" 4 [BC.pack "d"] []) NilTree)) - (ParTree - (SeqTree (hunk "file" 1 [BC.pack "f",BC.pack "u"] []) NilTree) - (SeqTree (hunk "file" 1 [BC.pack "f"] []) - (SeqTree (hunk "file" 1 [BC.pack "u",BC.pack "s",BC.pack "d"] []) - (SeqTree (hunk "file" 1 [] [BC.pack "a"]) - (SeqTree (hunk "file" 1 [BC.pack "a"] []) NilTree))))))),-} - commutePairFromTree seal2 $ - withStartState (makeSimpleRepo "file" [BC.pack "n",BC.pack "t",BC.pack "h"]) - (ParTree - (SeqTree (hunk "file" 1 [BC.pack "n",BC.pack "t",BC.pack "h"] []) - NilTree) - (SeqTree (hunk "file" 3 [BC.pack "h"] []) - (SeqTree (hunk "file" 1 [BC.pack "n"] []) - (SeqTree (hunk "file" 1 [BC.pack "t"] []) NilTree)))), - commutePairFromTree seal2 $ - withStartState (makeSimpleRepo "file" []) - (ParTree - (SeqTree (hunk "file" 1 [] [BC.pack "n"]) NilTree) - (SeqTree (hunk "file" 1 [] [BC.pack "i"]) - (SeqTree (hunk "file" 1 [] [BC.pack "i"]) NilTree))), - commutePairFromTree seal2 $ - withStartState (makeSimpleRepo "file" []) - (ParTree - (SeqTree (hunk "file" 1 [] [BC.pack "c"]) - (ParTree - (SeqTree (hunk "file" 1 [BC.pack "c"] [BC.pack "r"]) NilTree) - (SeqTree (hunk "file" 1 [] [BC.pack "h"]) - (SeqTree (hunk "file" 1 [] [BC.pack "d"]) NilTree)))) - (SeqTree (hunk "file" 1 [] [BC.pack "f"]) NilTree)), - commutePairFromTWFP seal2 $ - withStartState (makeSimpleRepo "file" []) - (TWFP 1 - (ParTree - (ParTree - (SeqTree (hunk "file" 1 [] [BC.pack "t"]) NilTree) - (SeqTree (hunk "file" 1 [] [BC.pack "t"]) NilTree)) - (SeqTree (hunk "file" 1 [] [BC.pack "f"]) NilTree))), - commutePairFromTWFP seal2 $ - withStartState (makeSimpleRepo "file" [BC.pack "f",BC.pack " r", - BC.pack "c",BC.pack "v"]) - (TWFP 4 - (ParTree - (SeqTree (hunk "file" 3 [BC.pack "c",BC.pack "v"] []) - (ParTree - (SeqTree (hunk "file" 2 [BC.pack "r"] []) - (SeqTree (hunk "fi le" 1 [BC.pack "f"] []) NilTree)) - (SeqTree (hunk "file" 1 [BC.pack "f",BC.pack "r"] []) - (SeqTree (hunk "file" 1 [] [BC.pack "y"]) NilTree)))) - (SeqTree (hunk "file" 4 [BC.pack "v"] []) NilTree))), - commutePairFromTree seal2 $ - withStartState (makeSimpleRepo "file" []) - (ParTree - (SeqTree (hunk "file" 1 [] [BC.pack "z"]) NilTree) - (ParTree - (SeqTree (hunk "file" 1 [] [BC.pack "f"]) NilTree) - (ParTree - (SeqTree (hunk "file" 1 [] [BC.pack "r"]) NilTree) - (SeqTree (hunk "file" 1 [] [BC.pack "d"]) NilTree)))) - , commutePairFromTree seal2 $ - withStartState (makeSimpleRepo "file" [BC.pack "t",BC.pack "r",BC.pack "h"]) - (ParTree - (ParTree - (SeqTree (hunk "file" 1 [BC.pack "t",BC.pack "r",BC.pack "h"] []) - NilTree) - (SeqTree (hunk "file" 1 [] [BC.pack "o"]) NilTree)) - (SeqTree (hunk "file" 1 [BC.pack "t"] []) - (SeqTree (hunk "file" 2 [BC.pack "h"] []) NilTree))) - , commutePairFromTWFP seal2 $ - withStartState (makeSimpleRepo "file" []) $ - TWFP 2 - (ParTree - (SeqTree (hunk "file" 1 [] [BC.pack "h"]) NilTree) - (SeqTree (hunk "file" 1 [] [BC.pack "y"]) - (SeqTree (hunk "file" 2 [] [BC.pack "m"]) - (SeqTree (hunk "file" 1 [] [BC.pack "v"]) NilTree)))) - , commutePairFromTree seal2 $ - withStartState (makeSimpleRepo "file" []) - (ParTree - (SeqTree (hunk "file" 1 [] [BC.pack "p"]) - (SeqTree (hunk "file" 1 [BC.pack "p"] []) - (SeqTree (hunk "file" 1 [] [BC.pack "c"]) NilTree))) - (SeqTree (hunk "file" 1 [] [BC.pack "z"]) NilTree)) - , commutePairFromTree seal2 $ - withStartState (makeSimpleRepo "file" []) - (ParTree - (SeqTree (hunk "file" 1 [] [BC.pack "j" ]) - (SeqTree (hunk "file" 1 [BC.pack "j"] []) NilTree)) - (SeqTree (hunk "file" 1 [] [BC.pack "v"]) NilTree)) - , commutePairFromTree seal2 $ - withStartState (makeSimpleRepo "file" []) - (ParTree - (SeqTree (hunk "file" 1 [] [BC.pack "v"]) NilTree) - (SeqTree (hunk "file" 1 [] [BC.pack "j" ]) - (SeqTree (hunk "file" 1 [BC.pack "j"] []) NilTree))) - , commutePairFromTree seal2 $ - withStartState (makeSimpleRepo "file" [BC.pack "x",BC.pack "c"]) - (ParTree - (SeqTree (hunk "file" 1 [] [BC.pack "h"]) - (ParTree - (SeqTree (hunk "file" 3 [BC.pack "c"] []) NilTree) - (SeqTree (hunk "file" 2 [BC.pack "x"] []) - (SeqTree (hunk "file" 1 [] [BC.pack "j"]) NilTree)))) - (SeqTree (hunk "file" 1 [] [BC.pack "l"]) NilTree)) - , commutePairFromTree seal2 $ - withStartState (makeSimpleRepo "file" []) - (ParTree - (SeqTree (hunk "file" 1 [] (packStringLetters "s")) NilTree) - (SeqTree (hunk "file" 1 [] (packStringLetters "k")) - (SeqTree (hunk "file" 1 (packStringLetters "k") []) - (SeqTree (hunk "file" 1 [] (packStringLetters "m")) - (SeqTree (hunk "file" 1 (packStringLetters "m") []) NilTree))))) - ] - -packStringLetters :: String -> [B.ByteString] -packStringLetters = map (BC.pack . (:[])) - -w_repov2PatchLoopExamples :: [Sealed (WithStartState V1Model (Tree Prim2))] -w_repov2PatchLoopExamples = - [Sealed (WithStartState (makeSimpleRepo fx []) - $ canonizeTree - (ParTree - (SeqTree (hunk fx 1 [] (packStringLetters "pkotufogbvdabnmbzajvolwviqebieonxvcvuvigkfgybmqhzuaaurjspd")) - (ParTree - (SeqTree (hunk fx 47 (packStringLetters "qhzu") (packStringLetters "zafybdcokyjskcgnvhkbzpysaafnjjhcstgrczplxsfwagmh")) - (ParTree - (ParTree - NilTree - (ParTree - (ParTree - (ParTree - (SeqTree (hunk fx 15 (packStringLetters "mbzajvolwviqebieonxvcvuvigkfgyb") (packStringLetters "vujnxnhvybvpouyciaabszfmgssezlwwjgnethvrpnfrkubphzvdgymjjoacppqps")) - (ParTree - NilTree - (ParTree - (SeqTree (hunk fx 40 (packStringLetters "ssezlwwjgnethvrpnfrkubphzvdgymjjoacppqpsmzafybdcokyjskcgnvhkbz") (packStringLetters "wnesidpccwoiqiichxaaejdsyrhrusqljlcoro")) - (ParTree - (ParTree - (SeqTree (hunk fx 12 (packStringLetters "abnvujnxnhvybvpouyciaabszfmgwnesidpccwoiqii") (packStringLetters "czfdhqkipdstfjycqaxwnbxrihrufdeyneqiiiafwzlmg")) NilTree) - NilTree) - NilTree)) - (SeqTree (hunk fx 25 [] (packStringLetters "dihgmsotezucqdgxczvcivijootyvhlwymbiueufnvpwpeukmskqllalfe")) NilTree)))) - (SeqTree (hunk fx 56 (packStringLetters "yjskcgnvhkbzpysaafnjjhcstgrczplxsfwagmhaaurjsp") (packStringLetters "xldhrutyhcyaqeezwujiguawfyawjjqlirxshjddvq")) NilTree)) - (SeqTree (hunk fx 20 [] (packStringLetters "ooygwiyogqrqnytixqtmvdxx")) - (SeqTree (hunk fx 26 (packStringLetters "yogqrqnytixqtmvdxxvolwviqebieonxvcvuvigkfgybmzafybdcokyjskcgnvhkbz") (packStringLetters "akhsmlbkdxnvfoikmiatfbpzdrsyykkpoxvvddeaspzxe")) - (SeqTree (hunk fx 39 [] (packStringLetters "ji")) - (ParTree - NilTree - (ParTree - NilTree - (ParTree - (ParTree - NilTree - (SeqTree (hunk fx 26 (packStringLetters "akhsmlbkdxnvfjioikmiatfbpzdrsyykkpoxvvddeaspzxepysaafnjjhcstgrczplxs") (packStringLetters "onjbhddskcj")) - (SeqTree (hunk fx 39 [] (packStringLetters "fyscunxxxjjtyqpfxeznhtwvlphmp")) NilTree))) - (ParTree - NilTree - (SeqTree (hunk fx 44 [] (packStringLetters "xcchzwmzoezxkmkhcmesplnjpqriypshgiqklgdnbmmkldnydiy")) - (ParTree - NilTree - (SeqTree (hunk fx 64 (packStringLetters "plnjpqriypshgiqklgdnbmmkldnydiymiatfbpzdrsyykkpoxvvddeaspzxepysaafn") (packStringLetters "anjlzfdqbjqbcplvqvkhwjtkigp")) NilTree))))))))))) - (ParTree - NilTree - NilTree))) - NilTree)) - NilTree)) - (ParTree - NilTree - (SeqTree (hunk fx 1 [] (packStringLetters "ti")) - (SeqTree (hunk fx 1 (packStringLetters "t") (packStringLetters "ybcop")) - (SeqTree (hunk fx 2 [] (packStringLetters "dvlhgwqlpaeweerqrhnjtfolczbqbzoccnvdsyqiefqitrqneralf")) - (SeqTree (hunk fx 15 [] (packStringLetters "yairbjphwtnaerccdlfewujvjvmjakbc")) - (SeqTree (hunk fx 51 [] (packStringLetters "xayvfuwaiiogginufnhsrmktpmlbvxiakjwllddkiyofyfw")) - (ParTree - NilTree - NilTree)))))))))] - where - fx :: IsString a => a - fx = "F" - -mergeExamples :: [Sealed2 (Patch :\/: Patch)] -mergeExamples = map (mapSeal2 fromW) w_mergeExamples - -repov2PatchLoopExamples :: [Sealed (WithStartState V1Model (Tree Prim2))] -repov2PatchLoopExamples = w_repov2PatchLoopExamples - -commuteExamples :: [Sealed2 (Patch :> Patch)] -commuteExamples = map (mapSeal2 fromW) w_commuteExamples - -tripleExamples :: [Sealed2 (Patch :> Patch :> Patch)] -tripleExamples = map (mapSeal2 fromW) w_tripleExamples - -notDuplicatestriple :: (Patch :> Patch :> Patch) wX wY -> Bool -notDuplicatestriple = W.notDuplicatestriple . toW - -quickhunk :: PrimPatch prim => Int -> String -> String -> prim wX wY -quickhunk l o n = hunk "test" l (map (\c -> BC.pack [c]) o) - (map (\c -> BC.pack [c]) n) - -primPermutables :: [(Prim2 :> Prim2 :> Prim2) wX wY] -primPermutables = - [quickhunk 0 "e" "bo" :> quickhunk 3 "" "x" :> quickhunk 2 "f" "qljo"] - -mergeables :: [(Prim2 :\/: Prim2) wX wY] -mergeables = [quickhunk 1 "a" "b" :\/: quickhunk 1 "a" "c", - quickhunk 1 "a" "b" :\/: quickhunk 3 "z" "c", - quickhunk 0 "" "a" :\/: quickhunk 1 "" "b", - quickhunk 0 "a" "" :\/: quickhunk 1 "" "b", - quickhunk 0 "a" "" :\/: quickhunk 1 "b" "", - quickhunk 0 "" "a" :\/: quickhunk 1 "b" "" - ] - -mergeablesFL :: [(FL Prim2 :\/: FL Prim2) wX wY] -mergeablesFL = map (\ (x:\/:y) -> (x :>: NilFL) :\/: (y :>: NilFL)) mergeables ++ - [] -- [(quickhunk 1 "a" "b" :>: quickhunk 3 "z" "c" :>: NilFL) - -- :\/: (quickhunk 1 "a" "z" :>: NilFL), - -- (quickhunk 1 "a" "b" :>: quickhunk 1 "b" "c" :>: NilFL) - -- :\/: (quickhunk 1 "a" "z" :>: NilFL)] - -mergeable2commutable :: Invert p => (p :\/: p) wX wY -> (p :> p) wX wY -mergeable2commutable (x :\/: y) = unsafeCoerceP (invert x) :> y - -commutablesFL :: [(FL Prim2 :> FL Prim2) wX wY] -commutablesFL = map mergeable2commutable mergeablesFL -commutables :: [(Prim2 :> Prim2) wX wY] -commutables = map mergeable2commutable mergeables - -primPatches :: [Prim2 wX wY] -primPatches = concatMap mergeable2patches mergeables - where mergeable2patches (x:\/:y) = [x,y] - -repov2Patches :: [Patch wX wY] -repov2Patches = concatMap commutable2patches repov2Commutables - where commutable2patches (x:>y) = [x,y] - -repov2Triples :: [(Patch :> Patch :> Patch) wX wY] -repov2Triples = [ob' :> oa2 :> a2'', - oa' :> oa2 :> a2''] - ++ map (unseal2 unsafeCoerceP) tripleExamples - ++ map (unseal2 unsafeCoerceP) (concatMap getTriples repov2FLs) - where oa = fromAnonymousPrim $ quickhunk 1 "o" "aa" - oa2 = oa - a2 = fromAnonymousPrim $ quickhunk 2 "a34" "2xx" - ob = fromAnonymousPrim $ quickhunk 1 "o" "bb" - ob' :/\: oa' = merge (oa :\/: ob) - a2' :/\: _ = merge (ob' :\/: a2) - a2'' :/\: _ = merge (oa2 :\/: a2') - -repov2NonduplicateTriples :: [(Patch :> Patch :> Patch) wX wY] -repov2NonduplicateTriples = filter (notDuplicatestriple) repov2Triples - -repov2FLs :: [FL (Patch) wX wY] -repov2FLs = [oa :>: invert oa :>: oa :>: invert oa :>: ps +>+ oa :>: invert oa :>: NilFL] - where oa = fromAnonymousPrim $ quickhunk 1 "o" "a" - ps :/\: _ = merge (oa :>: invert oa :>: NilFL :\/: oa :>: invert oa :>: NilFL) - -repov2Commutables :: [(Patch :> Patch) wX wY] -repov2Commutables = map (unseal2 unsafeCoerceP) commuteExamples++ - map mergeable2commutable repov2Mergeables++ - [invert oa :> ob'] ++ map (unseal2 unsafeCoerceP) (concatMap getPairs repov2FLs) - where oa = fromAnonymousPrim $ quickhunk 1 "o" "a" - ob = fromAnonymousPrim $ quickhunk 1 "o" "b" - _ :/\: ob' = mergeFL (ob :\/: oa :>: invert oa :>: NilFL) - -repov2Mergeables :: [(Patch :\/: Patch) wX wY] -repov2Mergeables = map (\ (x :\/: y) -> fromAnonymousPrim x :\/: fromAnonymousPrim y) mergeables - ++ repov2IglooMergeables - ++ repov2QuickcheckMergeables - ++ map (unseal2 unsafeCoerceP) mergeExamples - ++ catMaybes (map pair2m (concatMap getPairs repov2FLs)) - ++ [(oa :\/: od), - (oa :\/: a2'), - (ob' :\/: od''), - (oe :\/: od), - (of' :\/: oe'), - (ob' :\/: oe'), - (oa :\/: oe'), - (ob' :\/: oc'), - (b2' :\/: oc'''), - (ob' :\/: a2), - (b2' :\/: og'''), - (oc''' :\/: og'''), - (oc'' :\/: og''), - (ob'' :\/: og''), - (ob'' :\/: oc''), - (oc' :\/: od'')] - where oa = fromAnonymousPrim $ quickhunk 1 "o" "aa" - a2 = fromAnonymousPrim $ quickhunk 2 "a34" "2xx" - og = fromAnonymousPrim $ quickhunk 3 "4" "g" - ob = fromAnonymousPrim $ quickhunk 1 "o" "bb" - b2 = fromAnonymousPrim $ quickhunk 2 "b" "2" - oc = fromAnonymousPrim $ quickhunk 1 "o" "cc" - od = fromAnonymousPrim $ quickhunk 7 "x" "d" - oe = fromAnonymousPrim $ quickhunk 7 "x" "e" - pf = fromAnonymousPrim $ quickhunk 7 "x" "f" - od'' = fromAnonymousPrim $ quickhunk 8 "x" "d" - ob' :>: b2' :>: NilFL :/\: _ = mergeFL (oa :\/: ob :>: b2 :>: NilFL) - a2' :/\: _ = merge (ob' :\/: a2) - ob'' :/\: _ = merge (a2 :\/: ob') - og' :/\: _ = merge (oa :\/: og) - og'' :/\: _ = merge (a2 :\/: og') - og''' :/\: _ = merge (ob' :\/: og') - oc' :/\: _ = merge (oa :\/: oc) - oc'' :/\: _ = merge (a2 :\/: oc) - oc''' :/\: _ = merge (ob' :\/: oc') - oe' :/\: _ = merge (od :\/: oe) - of' :/\: _ = merge (od :\/: pf) - pair2m :: Sealed2 (Patch :> Patch) - -> Maybe ((Patch :\/: Patch) wX wY) - pair2m (Sealed2 (xx :> y)) = do y' :> _ <- commute (xx :> y) - return $ unsafeCoerceP (xx :\/: y') - -repov2IglooMergeables :: [(Patch :\/: Patch) wX wY] -repov2IglooMergeables = [(a :\/: b), - (b :\/: c), - (a :\/: c), - (x :\/: a), - (y :\/: b), - (z :\/: c), - (x' :\/: y'), - (z' :\/: y'), - (x' :\/: z'), - (a :\/: a)] - where a = fromAnonymousPrim $ quickhunk 1 "1" "A" - b = fromAnonymousPrim $ quickhunk 2 "2" "B" - c = fromAnonymousPrim $ quickhunk 3 "3" "C" - x = fromAnonymousPrim $ quickhunk 1 "1BC" "xbc" - y = fromAnonymousPrim $ quickhunk 1 "A2C" "ayc" - z = fromAnonymousPrim $ quickhunk 1 "AB3" "abz" - x' :/\: _ = merge (a :\/: x) - y' :/\: _ = merge (b :\/: y) - z' :/\: _ = merge (c :\/: z) - -repov2QuickcheckMergeables :: [(Patch :\/: Patch) wX wY] -repov2QuickcheckMergeables = [-- invert k1 :\/: n1 - --, invert k2 :\/: n2 - hb :\/: k - , b' :\/: b' - , n' :\/: n' - , b :\/: d - , k' :\/: k' - , k3 :\/: k3 - ] ++ catMaybes (map pair2m pairs) - where hb = fromAnonymousPrim $ quickhunk 0 "" "hb" - k = fromAnonymousPrim $ quickhunk 0 "" "k" - n = fromAnonymousPrim $ quickhunk 0 "" "n" - b = fromAnonymousPrim $ quickhunk 1 "b" "" - d = fromAnonymousPrim $ quickhunk 2 "" "d" - d':/\:_ = merge (b :\/: d) - --k1 :>: n1 :>: NilFL :/\: _ = mergeFL (hb :\/: k :>: n :>: NilFL) - --k2 :>: n2 :>: NilFL :/\: _ = - -- merge (hb :>: b :>: NilFL :\/: k :>: n :>: NilFL) - k' :>: n' :>: NilFL :/\: _ :>: b' :>: _ = merge (hb :>: b :>: d' :>: NilFL :\/: k :>: n :>: NilFL) - pairs = getPairs (hb :>: b :>: d' :>: k' :>: n' :>: NilFL) - pair2m :: Sealed2 (Patch :> Patch) - -> Maybe ((Patch :\/: Patch) wX wY) - pair2m (Sealed2 (xx :> y)) = do y' :> _ <- commute (xx :> y) - return $ unsafeCoerceP (xx :\/: y') - - i = fromAnonymousPrim $ quickhunk 0 "" "i" - x = fromAnonymousPrim $ quickhunk 0 "" "x" - xi = fromAnonymousPrim $ quickhunk 0 "xi" "" - d3 :/\: _ = merge (xi :\/: d) - _ :/\: k3 = mergeFL (k :\/: i :>: x :>: xi :>: d3 :>: NilFL) - diff --git a/harness/Darcs/Test/Patch/Examples/Unwind.hs b/harness/Darcs/Test/Patch/Examples/Unwind.hs index 30db88de..cd5bfa73 100644 --- a/harness/Darcs/Test/Patch/Examples/Unwind.hs +++ b/harness/Darcs/Test/Patch/Examples/Unwind.hs @@ -30,7 +30,7 @@ import Darcs.Test.HashedStorage ( unsafeMakeName ) import Darcs.Test.Patch.Arbitrary.Generic import Darcs.Test.Patch.Arbitrary.Named () import Darcs.Test.Patch.Arbitrary.PrimV1 () -import Darcs.Test.Patch.Arbitrary.RepoPatch +import Darcs.Test.Patch.Arbitrary.Mergeable import Darcs.Test.Patch.RepoModel import Darcs.Test.Patch.Types.MergeableSequence ( MergeableSequence(..) ) @@ -48,7 +48,7 @@ import Data.String examples :: forall p - . (ArbitraryRepoPatch p, ArbitraryPrim (OnlyPrim p)) + . (ArbitraryMergeable p, ArbitraryPrim (OnlyPrim p)) => [Sealed2 (WithStartState2 (MergeableSequence (Named p)))] examples = case (hasPrimConstruct @(OnlyPrim p), usesV1Model @(PrimOf p), notRepoPatchV1 @p) of diff --git a/harness/Darcs/Test/Patch/FileUUIDModel.hs b/harness/Darcs/Test/Patch/FileUUIDModel.hs index d03df444..e0a606d5 100644 --- a/harness/Darcs/Test/Patch/FileUUIDModel.hs +++ b/harness/Darcs/Test/Patch/FileUUIDModel.hs @@ -25,6 +25,7 @@ import Darcs.Test.Util.QuickCheck ( alpha, uniques, bSized ) import Darcs.Test.Patch.RepoModel import Darcs.Patch.Apply( applyToState ) +import Darcs.Patch.Info ( PatchInfo ) import Darcs.Patch.Prim.FileUUID.Core( UUID(..), Object(..) ) import Darcs.Patch.Prim.FileUUID.Apply( ObjectMap(..) ) import Darcs.Patch.Witnesses.Sealed ( Sealed, seal ) @@ -43,7 +44,10 @@ import Test.QuickCheck ---------------------------------------------------------------------- -- * Model definition -newtype FileUUIDModel wX = FileUUIDModel { _repoMap :: ObjectMap Fail } +data FileUUIDModel wX = FileUUIDModel + { _repoMap :: ObjectMap Fail + , _repoPatches :: [PatchInfo] + } ---------------------------------------- -- Instances @@ -86,10 +90,10 @@ rootId = UUID "ROOT" -- | The root directory of a repository. root :: FileUUIDModel wX -> (UUID, Object Fail) -root (FileUUIDModel repo) = (rootId, fromJust $ unFail $ getObject repo rootId) +root (FileUUIDModel repo _) = (rootId, fromJust $ unFail $ getObject repo rootId) repoObjects :: FileUUIDModel wX -> [(UUID, Object Fail)] -repoObjects (FileUUIDModel repo) = +repoObjects (FileUUIDModel repo _) = [(uuid, obj uuid) | uuid <- unFail $ listObjects repo] where obj uuid = fromJust $ unFail $ getObject repo uuid @@ -188,7 +192,7 @@ aRepo maxFiles maxDirs = do let (dirids, ids') = splitAt dirsNo ids fileids = take filesNo ids' objectmap <- aDir (rootId : dirids) fileids - return $ FileUUIDModel $ objectMap $ M.fromList objectmap + return $ FileUUIDModel (objectMap $ M.fromList objectmap) [] -- | Generate small repositories. -- Small repositories help generating (potentially) conflicting patches. @@ -197,7 +201,9 @@ instance RepoModel FileUUIDModel where aSmallRepo = do filesNo <- frequency [(3, return 1), (1, return 2)] dirsNo <- frequency [(3, return 1), (1, return 0)] aRepo filesNo dirsNo - repoApply (FileUUIDModel state) patch = FileUUIDModel <$> applyToState patch state + appliedPatchNames (FileUUIDModel _ patches) = patches + repoApply (FileUUIDModel state patches) patch = + FileUUIDModel <$> applyToState patch state <*> pure (patches ++ patchNames patch) showModel = show eqModel r1 r2 = nonEmptyRepoObjects r1 == nonEmptyRepoObjects r2 diff --git a/harness/Darcs/Test/Patch/Properties.hs b/harness/Darcs/Test/Patch/Properties.hs index 6892f265..b15dc0a7 100644 --- a/harness/Darcs/Test/Patch/Properties.hs +++ b/harness/Darcs/Test/Patch/Properties.hs @@ -18,12 +18,14 @@ -- UndecidableInstances was added because GHC 8.6 needed it -- even though GHC 8.2 didn't {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Darcs.Test.Patch.Properties ( unit_V1P1 , unit_V2P1 , qc_V1P1 , qc_V2 , qc_V3 + , qc_Named_V3 , qc_prim , qc_named_prim ) where @@ -63,14 +65,16 @@ import Darcs.Patch.V3 ( RepoPatchV3 ) import Darcs.Patch.Commute ( Commute(..) ) import Darcs.Patch.Invert ( Invert ) import Darcs.Patch.Show ( ShowPatchBasic ) -import Darcs.Patch.Apply( Apply, ApplyState ) +import Darcs.Patch.Apply( ApplyState ) import Darcs.Patch.Merge ( Merge ) +import Darcs.Patch.Named ( Named ) +import qualified Darcs.Patch.RepoPatch as RP import Darcs.Test.Patch.Arbitrary.Generic import Darcs.Test.Patch.Arbitrary.Named () import Darcs.Test.Patch.Arbitrary.PatchTree import Darcs.Test.Patch.Arbitrary.PrimFileUUID() -import Darcs.Test.Patch.Arbitrary.RepoPatch +import Darcs.Test.Patch.Arbitrary.Mergeable import Darcs.Test.Patch.Arbitrary.RepoPatchV1 () import Darcs.Test.Patch.Arbitrary.RepoPatchV2 () import Darcs.Test.Patch.Arbitrary.RepoPatchV3 () @@ -85,69 +89,72 @@ import Darcs.Test.Patch.WithState , ArbitraryWS(..) ) -import qualified Darcs.Test.Patch.Examples.Set1 as Ex -import qualified Darcs.Test.Patch.Examples.Set2Unwitnessed as ExU +import qualified Darcs.Test.Patch.Examples.Set1 as Ex1 +import qualified Darcs.Test.Patch.Examples.Set2 as Ex2 import Darcs.Test.Patch.Properties.Check( Check(..) ) import Darcs.Test.Patch.Properties.Generic ( PatchProperty, MergeProperty, SequenceProperty ) import qualified Darcs.Test.Patch.Properties.Generic as PropG -import qualified Darcs.Test.Patch.Properties.RepoPatch as PropR +import qualified Darcs.Test.Patch.Properties.Mergeable as PropM import qualified Darcs.Test.Patch.Properties.RepoPatchV3 as PropR3 -import qualified Darcs.Test.Patch.Properties.GenericUnwitnessed as PropU import qualified Darcs.Test.Patch.Properties.V1Set1 as Prop1 import qualified Darcs.Test.Patch.Properties.V1Set2 as Prop2 import Darcs.Test.Patch.Types.Triple (Triple(..)) -import qualified Darcs.Test.Patch.WSub as WSub type Prim2 = V2.Prim +instance PrimPatch prim => RepoApply (NamedPrim prim) +instance PrimPatch prim => RepoApply (RepoPatchV1 prim) +instance PrimPatch prim => RepoApply (RepoPatchV2 prim) +instance PrimPatch prim => RepoApply (RepoPatchV3 prim) + unit_V1P1:: [Test] unit_V1P1 = - [ 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" PropG.mergeEitherWayValid Ex.mergePairs - , testCases "merge properties: merge swap" PropG.mergeEitherWay Ex.mergePairs - , testCases "primitive patch IO functions" (Prop1.tShowRead unsafeCompare) Ex.primitiveTestPatches - , testCases "IO functions (test patches)" (Prop1.tShowRead unsafeCompare) Ex.testPatches - , testCases "IO functions (named test patches)" (Prop1.tShowRead unsafeCompare) Ex.testPatchesNamed - , testCases "primitive commute/recommute" (PropG.recommute commute) Ex.primitiveCommutePairs + [ testCases "known commutes" Prop1.checkCommute Ex1.knownCommutes + , testCases "known non-commutes" Prop1.checkCantCommute Ex1.knownCantCommutes + , testCases "known merges" Prop1.checkMerge Ex1.knownMerges + , testCases "known merges (equiv)" Prop1.checkMergeEquiv Ex1.knownMergeEquivs + , testCases "known canons" Prop1.checkCanon Ex1.knownCanons + , testCases "merge swaps" Prop1.checkMergeSwap Ex1.mergePairs2 + , testCases "the patch validation works" Prop1.tTestCheck Ex1.validPatches + , testCases "commute/recommute" (PropG.recommute commute) Ex1.commutePairs + , testCases "merge properties: merge either way valid" PropG.mergeEitherWayValid Ex1.mergePairs + , testCases "merge properties: merge swap" PropG.mergeEitherWay Ex1.mergePairs + , testCases "primitive patch IO functions" (Prop1.tShowRead unsafeCompare) Ex1.primitiveTestPatches + , testCases "IO functions (test patches)" (Prop1.tShowRead unsafeCompare) Ex1.testPatches + , testCases "IO functions (named test patches)" (Prop1.tShowRead unsafeCompare) Ex1.testPatchesNamed + , testCases "primitive commute/recommute" (PropG.recommute commute) Ex1.primitiveCommutePairs ] unit_V2P1 :: [Test] unit_V2P1 = - [ testCases "coalesce commute" (PropU.coalesceCommute WSub.coalesce) ExU.primPermutables - , testCases "prim recommute" (PropU.recommute WSub.commute) ExU.commutables - , testCases "square commute law" (PropU.squareCommuteLaw WSub.commute) ExU.commutables - , testCases "prim inverses commute" (PropU.commuteInverses WSub.commute) ExU.commutables - , testCases "FL prim recommute" (PropU.recommute WSub.commute) ExU.commutablesFL - , testCases "FL square commute law" (PropU.squareCommuteLaw WSub.commute) ExU.commutablesFL - , testCases "FL prim inverses commute" (PropU.commuteInverses WSub.commute) $ ExU.commutablesFL - , testCases "fails" (PropU.commuteFails WSub.commute) ([] :: [(Prim2 WSub.:> Prim2) wX wY]) - , testCases "read and show work on Prim" PropU.showRead ExU.primPatches - , testCases "read and show work on RepoPatchV2" PropU.showRead ExU.repov2Patches - , testCases "example flattenings work" (PropR.propConsistentTreeFlattenings fromPrim2) ExU.repov2PatchLoopExamples - , testCases "V2 merge input consistent" (PropU.mergeArgumentsConsistent isConsistent) ExU.repov2Mergeables - , testCases "V2 merge input is forward" (PropU.mergeArgumentsConsistent isForward) ExU.repov2Mergeables - , testCases "V2 merge output is forward" (PropU.mergeConsistent isForward) ExU.repov2Mergeables - , testCases "V2 merge output consistent" (PropU.mergeConsistent isConsistent) ExU.repov2Mergeables - , testCases "V2 merge either way" PropU.mergeEitherWay ExU.repov2Mergeables - , testCases "V2 merge and commute" PropU.mergeCommute ExU.repov2Mergeables - - , testCases "V2 recommute" (PropU.recommute WSub.commute) ExU.repov2Commutables - , testCases "V2 inverses commute" (PropU.commuteInverses WSub.commute) ExU.repov2Commutables - , testCases "V2 permutivity" (PropU.permutivity WSub.commute) ExU.repov2NonduplicateTriples + [ testCases "coalesce commute" (PropG.coalesceCommute (fmap maybeToFL . coalesce)) Ex2.primPermutables + , testCases "prim recommute" (PropG.recommute commute . Pair) Ex2.commutables + , testCases "square commute law" (PropG.squareCommuteLaw commute . Pair) Ex2.commutables + , testCases "prim inverses commute" (PropG.commuteInverses commute . Pair) Ex2.commutables + , testCases "FL prim recommute" (PropG.recommute commute . Pair) Ex2.commutablesFL + , testCases "FL square commute law" (PropG.squareCommuteLaw commute . Pair) Ex2.commutablesFL + , testCases "FL prim inverses commute" (PropG.commuteInverses commute . Pair) $ Ex2.commutablesFL + , sealedCases "read and show work on Prim" PropG.showRead Ex2.primPatches + , sealedCases "read and show work on RepoPatchV2" PropG.showRead Ex2.repov2Patches + , testCases "example flattenings work" (PropM.propConsistentTreeFlattenings fromPrim2) Ex2.repov2PatchLoopExamples + , sealedCases "V2 merge input consistent" (PropG.mergeArgumentsConsistent isConsistent) Ex2.repov2Mergeables + , sealedCases "V2 merge input is forward" (PropG.mergeArgumentsConsistent isForward) Ex2.repov2Mergeables + , sealedCases "V2 merge output is forward" (PropG.mergeConsistent isForward) Ex2.repov2Mergeables + , sealedCases "V2 merge output consistent" (PropG.mergeConsistent isConsistent) Ex2.repov2Mergeables + , sealedCases "V2 merge either way" PropG.mergeEitherWay Ex2.repov2Mergeables + , sealedCases "V2 merge and commute" PropG.mergeCommute Ex2.repov2Mergeables + , sealedCases "V2 recommute" (PropG.recommute commute . Pair) Ex2.repov2Commutables + , sealedCases "V2 inverses commute" (PropG.commuteInverses commute . Pair) Ex2.repov2Commutables + , sealedCases "V2 permutivity" (PropG.permutivity commute) Ex2.repov2NonduplicateTriples ] where - fromPrim2 :: PropR.FromPrimT RepoPatchV2 Prim2 + fromPrim2 :: PropM.FromPrimT RepoPatchV2 Prim2 fromPrim2 = fromAnonymousPrim + sealedCases :: String -> (forall wX wY. p wX wY -> TestResult) -> [Sealed2 p] -> Test + sealedCases name prop = testCases name (unseal2 prop) arbitraryThing :: TestGenerator thing (Sealed2 thing) arbitraryThing = TestGenerator (\f p -> Just (unseal2 f p)) @@ -157,11 +164,11 @@ arbitraryWSThing = TestGenerator (\f wsp -> Just (unseal2 (f . wsPatch) wsp)) qc_prim :: forall prim. ( TestablePrim prim - , Show2 prim , Show1 (ModelOf prim) , MightBeEmptyHunk prim , MightHaveDuplicate prim , ArbitraryWS prim + , RepoApply prim ) => [Test] qc_prim = [testProperty "prim pair coverage" (unseal2 (PropG.propPrimPairCoverage @prim . wsPatch))] ++ @@ -195,7 +202,7 @@ qc_prim = qc_named_prim :: forall prim. ( TestablePrim prim - , Show2 prim + , PrimPatch prim , Show1 (ModelOf (NamedPrim prim)) , MightBeEmptyHunk prim ) => [Test] @@ -209,7 +216,7 @@ qc_named_prim = qc_V1P1 :: [Test] qc_V1P1 = - repoPatchProperties @(RepoPatchV1 V1.Prim) ++ + mergeablePatchProperties @(RepoPatchV1 V1.Prim) ++ [ testProperty "commuting by patch and its inverse is ok" (Prop2.propCommuteInverse . mapSeal2 (getPair . wsPatch)) , testProperty "a patch followed by its inverse is identity" (Prop2.propPatchAndInverseIsIdentity . mapSeal2 (getPair . wsPatch)) , testProperty "'simple smart merge'" Prop2.propSimpleSmartMergeGoodEnough @@ -236,13 +243,14 @@ qc_V2 :: forall prim wXx wYy. , PropagateShrink prim prim , ArbitraryPrim prim , RepoState (ModelOf prim) ~ ApplyState prim + , RepoApply prim ) => prim wXx wYy -> [Test] qc_V2 _ = [ testProperty "with quickcheck that patches are consistent" (withSingle consistent) ] - ++ repoPatchProperties @(RepoPatchV2 prim) + ++ mergeablePatchProperties @(RepoPatchV2 prim) ++ concat [ merge_properties @(RepoPatchV2 prim) "tree" (TestGenerator mergePairFromTree) , merge_properties @(RepoPatchV2 prim) "twfp" (TestGenerator mergePairFromTWFP) @@ -262,6 +270,7 @@ qc_V3 :: forall prim wXx wYy. , PropagateShrink prim prim , ArbitraryPrim prim , RepoState (ModelOf prim) ~ ApplyState prim + , RepoApply prim ) => prim wXx wYy -> [Test] @@ -269,55 +278,83 @@ qc_V3 _ = [ testProperty "repo invariants" (withSequence (PropR3.prop_repoInvariants :: SequenceProperty (RepoPatchV3 prim))) ] - ++ repoPatchProperties @(RepoPatchV3 prim) - ++ difficultRepoPatchProperties @(RepoPatchV3 prim) - -repoPatchProperties :: forall p. - ( ArbitraryRepoPatch p - , Show2 p - , Show1 (ModelOf p) - , CheckedMerge p - , ShrinkModel (PrimOf p) - , PrimBased p - ) - => [Test] -repoPatchProperties = + ++ mergeablePatchProperties @(RepoPatchV3 prim) + ++ difficultPatchProperties @(RepoPatchV3 prim) + ++ evenMoreDifficultPatchProperties @(RepoPatchV3 prim) + +instance (ArbitraryPrim prim, ApplyState prim ~ RepoState (ModelOf prim)) => + ArbitraryMergeable (Named (RepoPatchV3 prim)) where + notRepoPatchV1 = Just (NotRepoPatchV1 (\case {})) + +instance MightHaveDuplicate p => MightHaveDuplicate (Named p) + +qc_Named_V3 + :: forall prim wX wY + . ( PrimPatch prim + , Show1 (ModelOf prim) + , ShrinkModel prim + , PropagateShrink prim prim + , ArbitraryPrim prim + , RepoState (ModelOf prim) ~ ApplyState prim + , RepoApply prim + ) + => prim wX wY + -> [Test] +qc_Named_V3 _ = + mergeablePatchProperties @(Named (RepoPatchV3 prim)) ++ + difficultPatchProperties @(Named (RepoPatchV3 prim)) + +-- | Similar to 'RepoPatch' but with constraints reduced to what is needed for +-- generation and property testing of mergeable patches, so that we have +-- instances for @'Named' p@ for all 'RepoPatch' types @p@. +type MergeablePatch p = + ( ApplyState (PrimOf p) ~ ApplyState p + , CheckedMerge p + , PrimPatch (PrimOf p) + , RP.Conflict p + , RP.PatchListFormat p + , RP.ReadPatch p + , Show2 p + , ShowPatchBasic p + ) + +mergeablePatchProperties + :: forall p + . ( ArbitraryMergeable p + , MergeablePatch p + , Show1 (ModelOf p) + , ShrinkModel (PrimOf p) + , PrimBased p + , RepoApply p + , RepoApply (PrimOf p) + ) + => [Test] +mergeablePatchProperties = [ testProperty "readPatch/showPatch" (withSingle (PropG.showRead :: PatchProperty p)) , testProperty "readPatch/showPatch (RL)" (withSequence (PropG.showRead :: SequenceProperty p)) -{- we no longer support inversion for RepoPatches - , testProperty "invert involution" - (withSingle (PropG.invertInvolution :: PatchProperty p)) - , testProperty "inverse composition" - (withPair (PropG.inverseComposition :: PairProperty p)) --} , testProperty "resolutions don't conflict" - (withSequence (PropR.propResolutionsDontConflict :: SequenceProperty p)) + (withSequence (PropM.propResolutionsDontConflict :: SequenceProperty p)) ] -- | These properties regularly fail for RepoPatchV2 with the standard test -- case generator when we crank up the number of tests (to e.g. 10000). -difficultRepoPatchProperties :: forall p. - ( ArbitraryRepoPatch p - , ShrinkModel (PrimOf p) - , Show2 p - , CheckedMerge p - , MightHaveDuplicate p - , Show1 (ModelOf p) - , PrimBased p - ) - => [Test] -difficultRepoPatchProperties = +difficultPatchProperties + :: forall p + . ( ArbitraryMergeable p + , MergeablePatch p + , ShrinkModel (PrimOf p) + , MightHaveDuplicate p + , Show1 (ModelOf p) + , PrimBased p + , RepoApply p + , RepoApply (PrimOf p) + ) + => [Test] +difficultPatchProperties = [ testProperty "reorderings are consistent" - (PropR.propConsistentReorderings @p) -{- we no longer support inversion for RepoPatches - , testProperty "inverses commute" - (withPair (PropG.commuteInverses com)) - , testConditional "nontrivial inverses commute" - (withPair nontrivialCommute) - (withPair (PropG.commuteInverses com)) --} + (PropM.propConsistentReorderings @p) , testProperty "recommute" (withPair (PropG.recommute com)) , testConditional "nontrivial recommute" @@ -331,22 +368,33 @@ difficultRepoPatchProperties = (withTriple (PropG.permutivity com)) , testProperty "merge either way" (withFork (PropG.mergeEitherWay :: MergeProperty p)) -{- this test relies on inversion and is thereore only valid for prims - , testProperty "merge either way valid" - (withFork (PropG.mergeEitherWayValid :: MergeProperty p)) --} , testConditional "nontrivial merge either way" (fromMaybe False . withFork nontrivialMerge) (withFork (PropG.mergeEitherWay :: MergeProperty p)) , testProperty "merge commute" (withFork (PropG.mergeCommute :: MergeProperty p)) - , testProperty "resolutions are invariant under reorderings" - (withSequence (PropR.propResolutionsOrderIndependent :: SequenceProperty p)) ] where com :: (p :> p) wA wB -> Maybe ((p :> p) wA wB) com = commute +-- | Properties that fail with Named patches even with RepoPatchV3 underneath. +evenMoreDifficultPatchProperties + :: forall p + . ( ArbitraryMergeable p + , MergeablePatch p + , ShrinkModel (PrimOf p) + , Show1 (ModelOf p) + , PrimBased p + , RepoApply p + , RepoApply (PrimOf p) + ) + => [Test] +evenMoreDifficultPatchProperties = + [ testProperty "resolutions are invariant under reorderings" + (withSequence (PropM.propResolutionsOrderIndependent :: SequenceProperty p)) + ] + pair_properties :: forall p gen . ( Show gen, Arbitrary gen, MightHaveDuplicate p , Commute p, Invert p, ShowPatchBasic p, Eq2 p @@ -403,9 +451,10 @@ patch_properties genname gen = patch_repo_properties :: forall p gen . ( Show gen, Arbitrary gen - , Invert p, Apply p, ShowPatchBasic p + , Invert p, ShowPatchBasic p , RepoModel (ModelOf p) , RepoState (ModelOf p) ~ ApplyState p + , RepoApply p ) => PropList (WithState p) gen patch_repo_properties genname gen = @@ -448,11 +497,11 @@ pair_repo_properties ( Show gen , Arbitrary gen , Commute p - , Apply p , ShowPatchBasic p , MightBeEmptyHunk p , RepoModel (ModelOf p) , RepoState (ModelOf p) ~ ApplyState p + , RepoApply p ) => PropList (WithState (Pair p)) gen pair_repo_properties genname gen = @@ -461,4 +510,3 @@ pair_repo_properties genname gen = , TestCondition (const True) , TestCheck (PropG.effectPreserving commute)) ] - diff --git a/harness/Darcs/Test/Patch/Properties/Generic.hs b/harness/Darcs/Test/Patch/Properties/Generic.hs index 8834c4cb..9f36889b 100644 --- a/harness/Darcs/Test/Patch/Properties/Generic.hs +++ b/harness/Darcs/Test/Patch/Properties/Generic.hs @@ -73,11 +73,12 @@ import Darcs.Patch.Read ( ReadPatch ) import Darcs.Patch.Show ( ShowPatchBasic, displayPatch, showPatch, ShowPatchFor(ForStorage) ) import Darcs.Patch () -import Darcs.Patch.Apply ( Apply, ApplyState ) +import Darcs.Patch.Apply ( ApplyState ) import Darcs.Patch.Commute ( Commute, commute, commuteFL ) import Darcs.Patch.CommuteFn ( CommuteFn ) import Darcs.Patch.Merge ( Merge(merge) ) import Darcs.Patch.Read ( readPatch ) +import Darcs.Test.Patch.RepoModel ( RepoApply ) import Darcs.Patch.Invert ( Invert(..) ) import Darcs.Patch.Witnesses.Eq ( Eq2(..), EqCheck(..) ) import Darcs.Patch.Witnesses.Ordered @@ -132,10 +133,10 @@ inverseComposition (Pair (a :> b)) = invertRollback :: ( ApplyState p ~ RepoState model , Invert p - , Apply p , ShowPatchBasic p , RepoModel model , model ~ ModelOf p + , RepoApply p ) => WithState p wA wB -> TestResult @@ -230,12 +231,12 @@ commuteInverses c (Pair (x :> y)) = -- | effect preserving AB <--> B'A' then effect(AB) = effect(B'A') effectPreserving - :: ( Apply p - , MightBeEmptyHunk p + :: ( MightBeEmptyHunk p , RepoModel model , model ~ ModelOf p , ApplyState p ~ RepoState model , ShowPatchBasic p + , RepoApply p ) => CommuteFn p p -> WithState (Pair p) wA wB @@ -508,9 +509,10 @@ mergeCommute (x :\/: y) = -- | coalesce effect preserving coalesceEffectPreserving - :: TestablePrim prim - => (forall wX wY . (prim :> prim) wX wY -> Maybe (FL prim wX wY)) - -> WithState (Pair prim) wA wB -> TestResult + :: (TestablePrim prim, RepoApply prim) + => (forall wX wY . (prim :> prim) wX wY -> Maybe (FL prim wX wY)) + -> WithState (Pair prim) wA wB + -> TestResult coalesceEffectPreserving j (WithState r (Pair (a :> b)) r') = case j (a :> b) of Nothing -> rejected diff --git a/harness/Darcs/Test/Patch/Properties/GenericUnwitnessed.hs b/harness/Darcs/Test/Patch/Properties/GenericUnwitnessed.hs deleted file mode 100644 index ed277712..00000000 --- a/harness/Darcs/Test/Patch/Properties/GenericUnwitnessed.hs +++ /dev/null @@ -1,90 +0,0 @@ -module Darcs.Test.Patch.Properties.GenericUnwitnessed where - -import Darcs.Prelude - -import qualified Darcs.Test.Patch.Properties.Generic as W - ( permutivity - , mergeConsistent, mergeArgumentsConsistent, mergeEitherWay - , mergeCommute, squareCommuteLaw, coalesceCommute, commuteInverses - , recommute - , showRead ) -import Darcs.Test.Patch.Arbitrary.Generic ( MightHaveDuplicate ) -import Darcs.Test.Patch.Arbitrary.PrimV1 () - -import Darcs.Test.Patch.Types.Pair ( Pair(..) ) -import Darcs.Test.Patch.WSub -import Darcs.Test.Util.TestResult - -import Darcs.Patch.Commute ( Commute ) -import Darcs.Patch.Invert ( Invert ) -import Darcs.Patch.Read ( ReadPatch ) -import Darcs.Patch.Show ( ShowPatchBasic, displayPatch ) -import Darcs.Patch.Witnesses.Show -import Darcs.Patch.Witnesses.Eq -import Darcs.Patch.Merge ( Merge ) -import Darcs.Util.Printer ( Doc, redText, ($$) ) - - -permutivity :: (ShowPatchBasic wp, Eq2 wp, WSub wp p) - => (forall wX wY . (p :> p) wX wY -> Maybe ((p :> p) wX wY)) - -> (p :> p :> p) wA wB -> TestResult -permutivity f = W.permutivity (fmap toW . f . fromW) . toW - -mergeEitherWay :: (ShowPatchBasic wp, Eq2 wp, Merge wp, WSub wp p) => (p :\/: p) wX wY -> TestResult -mergeEitherWay = W.mergeEitherWay . toW - -commuteInverses :: (Invert wp, ShowPatchBasic wp, Eq2 wp, WSub wp p) - => (forall wX wY . (p :> p) wX wY -> Maybe ((p :> p) wX wY)) - -> (p :> p) wA wB -> TestResult -commuteInverses f = W.commuteInverses (fmap toW . f . fromW) . Pair . toW - -recommute :: (ShowPatchBasic wp, MightHaveDuplicate wp, Eq2 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) . Pair . toW - -mergeCommute :: ( MightHaveDuplicate wp - , ShowPatchBasic wp - , Eq2 wp - , Commute wp - , Merge wp - , WSub wp p - ) - => (p :\/: p) wX wY - -> TestResult -mergeCommute = W.mergeCommute . toW - -mergeConsistent :: (Merge wp, ShowPatchBasic wp, WSub wp p) => - (forall wX wY . p wX wY -> Maybe Doc) - -> (p :\/: p) wA wB -> TestResult -mergeConsistent f = W.mergeConsistent (f . fromW) . toW - -mergeArgumentsConsistent :: (ShowPatchBasic wp, WSub wp p) => - (forall wX wY . p wX wY -> Maybe Doc) - -> (p :\/: p) wA wB -> TestResult -mergeArgumentsConsistent f = W.mergeArgumentsConsistent (f . fromW) . toW - -showRead :: (ShowPatchBasic p, ReadPatch p, Eq2 p, Show2 p) => p wX wY -> TestResult -showRead = W.showRead - -squareCommuteLaw :: (Invert wp, ShowPatchBasic wp, Eq2 wp, WSub wp p) => - (forall wX wY . (p :> p) wX wY -> Maybe ((p :> p) wX wY)) - -> (p :> p) wA wB -> TestResult -squareCommuteLaw f = W.squareCommuteLaw (fmap toW . f . fromW) . Pair . toW - - -coalesceCommute :: (forall wX wY . (Prim2 :> Prim2) wX wY -> Maybe (FL Prim2 wX wY)) - -> (Prim2 :> Prim2 :> Prim2) wA wB -> TestResult -coalesceCommute f = W.coalesceCommute (fmap toW . f . fromW) . toW - -commuteFails :: ShowPatchBasic p - => ((p :> p) wX wY -> Maybe ((p :> p) wX wY)) - -> (p :> p) wX wY - -> TestResult -commuteFails c (x :> y) = case c (x :> y) of - Nothing -> succeeded - Just (y' :> x') -> - failed $ redText "x" $$ displayPatch x $$ - redText ":> y" $$ displayPatch y $$ - redText "y'" $$ displayPatch y' $$ - redText ":> x'" $$ displayPatch x' diff --git a/harness/Darcs/Test/Patch/Properties/RepoPatch.hs b/harness/Darcs/Test/Patch/Properties/Mergeable.hs similarity index 79% rename from harness/Darcs/Test/Patch/Properties/RepoPatch.hs rename to harness/Darcs/Test/Patch/Properties/Mergeable.hs index d0e1cccc..cc8bd548 100644 --- a/harness/Darcs/Test/Patch/Properties/RepoPatch.hs +++ b/harness/Darcs/Test/Patch/Properties/Mergeable.hs @@ -1,4 +1,4 @@ -module Darcs.Test.Patch.Properties.RepoPatch +module Darcs.Test.Patch.Properties.Mergeable ( propConsistentTreeFlattenings , propConsistentReorderings , propResolutionsDontConflict @@ -18,20 +18,21 @@ import Darcs.Test.Patch.Arbitrary.PatchTree import Darcs.Test.Patch.Merge.Checked ( CheckedMerge ) import Darcs.Test.Patch.Types.MergeableSequence ( MergeableSequence, mergeableSequenceToRL ) import Darcs.Test.Patch.WithState -import Darcs.Test.Patch.RepoModel ( RepoModel, repoApply, showModel, eqModel, RepoState - , Fail, maybeFail, ModelOf ) +import Darcs.Test.Patch.RepoModel + ( Fail, ModelOf, RepoApply, RepoModel, RepoState + , eqModel, maybeFail, repoApply, showModel + ) import Darcs.Test.Util.TestResult ( TestResult, failed, rejected, succeeded ) import Darcs.Util.Printer ( text, redText, ($$), vsep ) -import Darcs.Patch.Conflict ( Conflict(..), ConflictDetails(..), Unravelled ) -import Darcs.Patch.Apply ( Apply(..) ) -import Darcs.Patch.Merge ( Merge, mergeList ) +import Darcs.Patch.Conflict ( ConflictDetails(..), Unravelled ) +import Darcs.Patch.Merge ( CleanMerge, mergeList ) import Darcs.Patch.Permutations ( permutationsRL, (=\~/=) ) -import Darcs.Patch.RepoPatch ( Commute, RepoPatch ) +import Darcs.Patch.RepoPatch import Darcs.Patch.Show ( displayPatch ) -import Darcs.Patch.Witnesses.Eq ( Eq2, isIsEq ) +import Darcs.Patch.Witnesses.Eq ( isIsEq ) import Darcs.Patch.Witnesses.Ordered ( RL(..) ) import Darcs.Patch.Witnesses.Sealed ( Sealed(..), unseal, Sealed2(..) ) import Darcs.Patch.Witnesses.Show ( Show2 ) @@ -56,13 +57,14 @@ propConsistentTreeFlattenings :: forall rp prim model. , RepoState model ~ ApplyState prim , ApplyState (rp prim) ~ ApplyState prim , Merge (rp prim) - , Apply (rp prim) - , Show2 (rp prim) ) + , Show2 (rp prim) + , RepoApply (rp prim) + ) => FromPrimT rp prim -> Sealed (WithStartState model (Tree prim)) -> TestResult -propConsistentTreeFlattenings fromPrim (Sealed (WithStartState start t)) = - case flattenTree (mapTree fromPrim t) of +propConsistentTreeFlattenings fromPrim' (Sealed (WithStartState start t)) = + case flattenTree (mapTree fromPrim' t) of Sealed (G2 flat') -> -- Limit the number of tree flattenings to something sane, as -- the length of the original list can grow exponentially. @@ -75,14 +77,15 @@ propConsistentTreeFlattenings fromPrim (Sealed (WithStartState start t)) = -- | This property states that all reorderings of a sequence of patches, -- when applied to the same state, give the same result state. -propConsistentReorderings :: ( RepoPatch p - , RepoModel (ModelOf p) - , RepoState (ModelOf p) ~ ApplyState p - , CheckedMerge p - , PrimBased p - ) - => Sealed2 (WithStartState2 (MergeableSequence p)) - -> TestResult +propConsistentReorderings + :: ( RepoModel (ModelOf p) + , RepoState (ModelOf p) ~ ApplyState p + , CheckedMerge p + , PrimBased p + , RepoApply p + ) + => Sealed2 (WithStartState2 (MergeableSequence p)) + -> TestResult propConsistentReorderings (Sealed2 (WithStartState2 start ms)) = case mapM (repoApply start) $ permutationsRL ps of Left e -> failed $ redText "could not apply all reorderings:" $$ text (show e) @@ -104,7 +107,19 @@ propConsistentReorderings (Sealed2 (WithStartState2 start ms)) = -- | This property states that the standard conflict resolutions for a -- sequence of patches are independent of any reordering of the sequence. -propResolutionsOrderIndependent :: RepoPatch p => RL p wX wY -> TestResult +propResolutionsOrderIndependent + :: ( Commute p + , Conflict p + , ShowPatchBasic p + , PatchListFormat p + , PatchListFormat (PrimOf p) + , ShowPatchBasic (PrimOf p) + , Eq2 (PrimOf p) + , Show2 (PrimOf p) + , Commute (PrimOf p) + ) + => RL p wX wY + -> TestResult propResolutionsOrderIndependent ps = check $ map withConflictParts pss where @@ -143,7 +158,16 @@ listEqBy _ _ _ = False -- | This property states that the standard conflict resolutions for a -- sequence of patches do not themselves conflict with each other. -propResolutionsDontConflict :: RepoPatch p => RL p wX wY -> TestResult +propResolutionsDontConflict + :: ( Conflict p + , PatchListFormat p + , ShowPatchBasic p + , CleanMerge (PrimOf p) + , PatchListFormat (PrimOf p) + , ShowPatchBasic (PrimOf p) + ) + => RL p wX wY + -> TestResult propResolutionsDontConflict patches = case mergeList $ catMaybes $ map conflictMangled $ resolveConflicts NilRL patches of Right _ -> succeeded diff --git a/harness/Darcs/Test/Patch/RepoModel.hs b/harness/Darcs/Test/Patch/RepoModel.hs index e2607a16..1842bc8c 100644 --- a/harness/Darcs/Test/Patch/RepoModel.hs +++ b/harness/Darcs/Test/Patch/RepoModel.hs @@ -5,7 +5,8 @@ import Darcs.Prelude import Control.Exception ( SomeException ) import Darcs.Patch.Apply ( Apply, ApplyState ) -import Darcs.Patch.Witnesses.Ordered ( FL, RL ) +import Darcs.Patch.Info ( PatchInfo ) +import Darcs.Patch.Witnesses.Ordered ( FL, RL, mapFL, mapRL ) import Test.QuickCheck ( Gen ) @@ -17,12 +18,27 @@ unFail = either (error.show) id maybeFail :: Fail a -> Maybe a maybeFail = either (const Nothing) Just +-- | Class of patch types that can be applied to a model +class Apply p => RepoApply p where + -- | This method exists so that we can keep track of the names of patches + -- that have been applied to the model. This allows us to generate 'Named' + -- patches with meaningful explicit dependencies. + patchNames :: p wX wY -> [PatchInfo] + patchNames _ = [] + +instance RepoApply p => RepoApply (FL p) where + patchNames = concat . mapFL patchNames + +instance RepoApply p => RepoApply (RL p) where + patchNames = concat . mapRL patchNames + class RepoModel model where type RepoState model :: (* -> *) -> * showModel :: model x -> String eqModel :: model x -> model x -> Bool aSmallRepo :: Gen (model x) - repoApply :: (Apply p, ApplyState p ~ RepoState model) => model x -> p x y -> Fail (model y) + appliedPatchNames :: model x -> [PatchInfo] + repoApply :: (RepoApply p, ApplyState p ~ RepoState model) => model x -> p x y -> Fail (model y) type family ModelOf (p :: * -> * -> *) :: * -> * diff --git a/harness/Darcs/Test/Patch/Types/MergeableSequence.hs b/harness/Darcs/Test/Patch/Types/MergeableSequence.hs index d3f55fc7..add689e2 100644 --- a/harness/Darcs/Test/Patch/Types/MergeableSequence.hs +++ b/harness/Darcs/Test/Patch/Types/MergeableSequence.hs @@ -21,7 +21,7 @@ import Darcs.Patch.Witnesses.Maybe import Darcs.Patch.Witnesses.Sealed import Darcs.Patch.Witnesses.Unsafe import Darcs.Patch.Witnesses.Ordered -import Darcs.Patch.Apply ( Apply, ApplyState ) +import Darcs.Patch.Apply ( ApplyState ) import Darcs.Patch.Effect ( Effect(..) ) import Darcs.Patch.Invert ( Invert(..) ) import Darcs.Patch.FromPrim ( PrimPatchBase, PrimOf ) @@ -205,7 +205,7 @@ arbitraryMergeableSequence . ( RepoModel model , CheckedMerge p , PrimBased p - , Apply p, ApplyState p ~ RepoState model + , RepoApply p, ApplyState p ~ RepoState model ) => (forall wA . model wA -> Gen (Sealed (WithEndState model (OnlyPrim p wA)))) -> model wX @@ -237,7 +237,7 @@ arbitraryMergeableSequence arbitrarySingle = go instance ( RepoModel model - , Apply p, ApplyState p ~ RepoState model + , RepoApply p, ApplyState p ~ RepoState model , model ~ ModelOf (OnlyPrim p) , model ~ ModelOf p , CheckedMerge p diff --git a/harness/Darcs/Test/Patch/Unwind.hs b/harness/Darcs/Test/Patch/Unwind.hs index 53cc824a..28d458a8 100644 --- a/harness/Darcs/Test/Patch/Unwind.hs +++ b/harness/Darcs/Test/Patch/Unwind.hs @@ -5,13 +5,13 @@ module Darcs.Test.Patch.Unwind import Darcs.Prelude import Darcs.Patch -import Darcs.Patch.Commute +import Darcs.Patch.RepoPatch import Darcs.Patch.Unwind import Darcs.Patch.Witnesses.Ordered import Darcs.Patch.Witnesses.Show import Darcs.Test.Patch.Arbitrary.Generic -import Darcs.Test.Patch.Arbitrary.RepoPatch +import Darcs.Test.Patch.Arbitrary.Mergeable import Darcs.Test.Patch.Examples.Unwind import Darcs.Test.Patch.Merge.Checked import Darcs.Test.Patch.Properties.Generic @@ -43,10 +43,19 @@ numberedTestCases text runTest = zipWith numbered [1..] testSuite :: forall p - . ( ArbitraryRepoPatch p, PrimBased p, ArbitraryPrim (OnlyPrim p) + . ( ArbitraryMergeable p + , Apply p + , ApplyState (PrimOf p) ~ RepoState (ModelOf p) + , Unwind p + , PrimPatchBase p + , PrimBased p + , ArbitraryPrim (OnlyPrim p) , ShrinkModel (PrimOf p) - , Show1 (ModelOf (PrimOf p)), Show2 p - , CheckedMerge p, Commute (OnlyPrim p) + , Show1 (ModelOf (PrimOf p)) + , Show2 p + , CheckedMerge p + , Commute (OnlyPrim p) + , RepoApply (PrimOf p) ) => [Test] testSuite = diff --git a/harness/Darcs/Test/Patch/V1Model.hs b/harness/Darcs/Test/Patch/V1Model.hs index 2a9eb5e1..53d4d9fd 100644 --- a/harness/Darcs/Test/Patch/V1Model.hs +++ b/harness/Darcs/Test/Patch/V1Model.hs @@ -26,6 +26,7 @@ import Darcs.Test.Util.QuickCheck ( alpha, uniques, bSized ) import Darcs.Test.Patch.RepoModel import Darcs.Patch.Apply( applyToTree ) +import Darcs.Patch.Info ( PatchInfo ) import Darcs.Patch.Witnesses.Sealed ( Sealed, seal ) import Darcs.Patch.Witnesses.Show @@ -51,9 +52,10 @@ import Test.QuickCheck -- | A repository is an abstraction build in top of a 'Tree'. -- NB: Repository preferences are not supported yet. -newtype V1Model wX = V1Model { - repoTree :: Tree Fail - } +data V1Model wX = V1Model + { repoTree :: Tree Fail + , repoPatches :: [PatchInfo] + } -- | Repository items may be text files or directories. -- NB: Binary files are not supported yet. @@ -103,10 +105,10 @@ lbs2content = map lbs2bs . BLC.lines -- * Constructors makeRepo :: [(Name, RepoItem)] -> V1Model wX -makeRepo = V1Model . T.makeTree . map (second treeItem) +makeRepo = flip V1Model [] . T.makeTree . map (second treeItem) emptyRepo :: V1Model wX -emptyRepo = V1Model T.emptyTree +emptyRepo = V1Model T.emptyTree [] makeFile :: Content -> File makeFile = RepoItem . T.File . T.makeBlob . content2lbs @@ -156,12 +158,12 @@ root :: V1Model wX -> Dir root = RepoItem . T.SubTree . repoTree find :: V1Model wX -> AnchoredPath -> Maybe RepoItem -find (V1Model tree) path = RepoItem <$> T.find tree path +find (V1Model tree _) path = RepoItem <$> T.find tree path -- | List repository items. -- NB: It does not include the root directory. list :: V1Model wX -> [(AnchoredPath, RepoItem)] -list (V1Model tree) = map (second RepoItem) $ T.list tree +list (V1Model tree _) = map (second RepoItem) $ T.list tree ---------------------------------------------------------------------- -- ** Filtering @@ -178,7 +180,7 @@ filterDirs = filter (isDir . snd) diffRepos :: V1Model wX -> V1Model wY -> (V1Model wU, V1Model wV) diffRepos repo1 repo2 = let (diff1,diff2) = unFail $ T.diffTrees hashedTree1 hashedTree2 - in (V1Model diff1, V1Model diff2) + in (V1Model diff1 [], V1Model diff2 []) where hashedTree1, hashedTree2 :: Tree Fail hashedTree1 = unFail $ darcsUpdateHashes $ repoTree repo1 @@ -267,10 +269,11 @@ instance RepoModel V1Model where aSmallRepo = do filesNo <- frequency [(3, return 1), (1, return 2)] dirsNo <- frequency [(3, return 1), (1, return 0)] aRepo filesNo dirsNo - repoApply (V1Model tree) patch = V1Model <$> applyToTree patch tree + appliedPatchNames (V1Model _ patches) = patches + repoApply (V1Model tree patches) patch = + V1Model <$> applyToTree patch tree <*> pure (patches ++ patchNames patch) eqModel repo1 repo2 = let (diff1,diff2) = diffRepos repo1 repo2 in nullRepo diff1 && nullRepo diff2 - instance Arbitrary (Sealed V1Model) where arbitrary = seal <$> aSmallRepo diff --git a/harness/Darcs/Test/Patch/WSub.hs b/harness/Darcs/Test/Patch/WSub.hs deleted file mode 100644 index fe54757e..00000000 --- a/harness/Darcs/Test/Patch/WSub.hs +++ /dev/null @@ -1,139 +0,0 @@ -{-# LANGUAGE FunctionalDependencies, UndecidableInstances #-} -module Darcs.Test.Patch.WSub where - -{- -The Examples.Set2Unwitnessed module builds a lot of test cases by pattern matching -on the results of merge/commute in where clauses. This would -be very painful to switch to using witnesses properly, because -we'd have to make them use case in series. - -So instead we give up on witnesses for this module, but instead -of preprocessor hacks which make incompatible code with the rest -of darcs, we build a fresh set of witnesses constructors (FL etc) -which aren't actually GADTs or existentials. So the pattern matching -works as before, but we need to translate back and forth a lot. - -We call the normal darcs constructors the 'W' variants. --} - -import Darcs.Prelude - -import qualified Darcs.Test.Patch.Arbitrary.PatchTree as W - ( getPairs, getTriples ) - -import qualified Darcs.Patch as W ( commute ) -import qualified Darcs.Patch.Merge as W ( merge, mergeFL ) -import qualified Darcs.Patch.Prim as W ( coalesce ) - -import qualified Darcs.Patch.Witnesses.Ordered as W -import Darcs.Patch.Witnesses.Sealed -import Darcs.Patch.Witnesses.Eq -import Darcs.Patch.Witnesses.Maybe -import Darcs.Patch.Witnesses.Show -import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP, unsafeCoercePStart, unsafeCoercePEnd ) - -import Darcs.Patch.Merge ( Merge ) -import Darcs.Patch.V2 ( RepoPatchV2 ) -import qualified Darcs.Patch.V2.Prim as V2 -import Darcs.Patch.Commute ( Commute ) -import Darcs.Patch.Invert ( Invert(..) ) - -type Prim2 = V2.Prim - - -infixr 5 :>: -infixr 5 +>+ -infixr 1 :> -infix 1 :/\: -infix 1 :\/: - -data FL p wX wY where - NilFL :: FL p wX wY - (:>:) :: p wX wY -> FL p wX wY -> FL p wX wY - -(+>+) :: FL p wX wY -> FL p wX wY -> FL p wX wY -NilFL +>+ ps = ps -(p :>: ps) +>+ qs = p :>: (ps +>+ qs) - -data (p :> q) wX wY where - (:>) :: p wX wY -> q wX wY -> (p :> q) wX wY - -data (p :\/: q) wX wY where - (:\/:) :: p wX wY -> q wX wY -> (p :\/: q) wX wY - -data (p :/\: q) wX wY where - (:/\:) :: p wX wY -> q wX wY -> (p :/\: q) wX wY - -class WSub wp p | p -> wp, wp -> p where - fromW :: wp wX wY -> p wX wY - toW :: p wX wY -> wp wX wY - -instance (WSub wp1 p1, WSub wp2 p2) => WSub (wp1 W.:\/: wp2) (p1 :\/: p2) where - fromW (x W.:\/: y) = unsafeCoerceP (fromW x) :\/: unsafeCoerceP (fromW y) - toW (x :\/: y) = unsafeCoerceP (toW x) W.:\/: unsafeCoerceP (toW y) - -instance (WSub wp1 p1, WSub wp2 p2) => WSub (wp1 W.:/\: wp2) (p1 :/\: p2) where - fromW (x W.:/\: y) = unsafeCoerceP (fromW x) :/\: unsafeCoerceP (fromW y) - toW (x :/\: y) = unsafeCoerceP (toW x) W.:/\: unsafeCoerceP (toW y) - -instance (WSub wp1 p1, WSub wp2 p2) => WSub (wp1 W.:> wp2) (p1 :> p2) where - fromW (x W.:> y) = unsafeCoercePEnd (fromW x) :> unsafeCoercePStart (fromW y) - toW (x :> y) = unsafeCoercePEnd (toW x) W.:> unsafeCoercePStart (toW y) - -instance WSub wp p => WSub (W.FL wp) (FL p) where - fromW W.NilFL = unsafeCoerceP NilFL - fromW (x W.:>: xs) = unsafeCoercePEnd (fromW x) :>: unsafeCoercePStart (fromW xs) - - toW NilFL = unsafeCoerceP W.NilFL - toW (x :>: xs) = unsafeCoercePEnd (toW x) W.:>: unsafeCoercePStart (toW xs) - -instance WSub (RepoPatchV2 prim) (RepoPatchV2 prim) where - fromW = id - toW = id - -instance WSub Prim2 Prim2 where - fromW = id - toW = id - -instance (WSub wp p, WSub wq q, Show2 wp, Show2 wq) => Show ((p :> q) wX wY) where - show = show . toW - -instance (WSub wp p, WSub wq q, Show2 wp, Show2 wq) => Show2 (p :> q) - -instance (WSub wp p, WSub wq q, Show2 wp, Show2 wq) => Show ((p :\/: q) wX wY) where - show = show . toW - -instance (WSub wp p, WSub wq q, Show2 wp, Show2 wq) => Show2 (p :\/: q) - -instance (WSub wp p, Show2 wp) => Show (FL p wX wY) where - show = show . toW - -instance (WSub wp p, Show2 wp) => Show2 (FL p) - -instance (WSub wp p, Commute wp, Eq2 wp) => Eq2 (FL p) where - unsafeCompare x y = unsafeCompare (toW x) (toW y) - -instance (WSub wp p, Invert wp) => Invert (FL p) where - invert = fromW . invert . toW - -instance (WSub wp p, Commute wp) => Commute (FL p) where - commute (xs W.:> ys) = do ys' W.:> xs' <- W.commute (toW xs W.:> toW ys) - return (fromW ys' W.:> fromW xs') - -mergeFL :: (WSub wp p, Merge wp) => (p :\/: FL p) wX wY -> (FL p :/\: p) wX wY -mergeFL = fromW . W.mergeFL . toW - -merge :: (WSub wp p, Merge wp) => (p :\/: p) wX wY -> (p :/\: p) wX wY -merge = fromW . W.merge . toW - -commute :: (WSub wp p, Commute wp) => (p :> p) wX wY -> Maybe ((p :> p) wX wY) -commute = fmap fromW . W.commute . toW - -getPairs :: FL (RepoPatchV2 Prim2) wX wY -> [Sealed2 (RepoPatchV2 Prim2 :> RepoPatchV2 Prim2)] -getPairs = map (mapSeal2 fromW) . W.getPairs . toW - -getTriples :: FL (RepoPatchV2 Prim2) wX wY -> [Sealed2 (RepoPatchV2 Prim2 :> RepoPatchV2 Prim2 :> RepoPatchV2 Prim2)] -getTriples = map (mapSeal2 fromW) . W.getTriples . toW - -coalesce :: (Prim2 :> Prim2) wX wY -> Maybe (FL Prim2 wX wY) -coalesce = fmap (fromW . maybeToFL) . W.coalesce . toW diff --git a/harness/Darcs/Test/Patch/WithState.hs b/harness/Darcs/Test/Patch/WithState.hs index ea814a1d..aef9913a 100644 --- a/harness/Darcs/Test/Patch/WithState.hs +++ b/harness/Darcs/Test/Patch/WithState.hs @@ -221,8 +221,14 @@ checkOK = maybe [] (\x -> [x]) . maybeFail shrinkModel :: forall s prim wX - . (Apply prim, ApplyState prim ~ RepoState s, ModelOf prim ~ s, RepoModel s, ShrinkModel prim) - => s wX -> [Sealed (WithEndState s (prim wX))] + . ( ApplyState prim ~ RepoState s + , ModelOf prim ~ s + , RepoModel s + , ShrinkModel prim + , RepoApply prim + ) + => s wX + -> [Sealed (WithEndState s (prim wX))] shrinkModel s = do Sealed prim <- shrinkModelPatch s endState <- checkOK $ repoApply s prim @@ -266,11 +272,12 @@ propagateShrinkMaybe (Just2 prim :> p) = propagateShrink (prim :> p) -- patch type of the test case. shrinkState :: forall s prim p - . ( Invert prim, Apply prim, RepoModel s + . ( Invert prim, RepoModel s , ShrinkModel prim, PropagateShrink prim p , ApplyState prim ~ RepoState s , ModelOf p ~ s , ModelOf prim ~ s + , RepoApply prim ) => Sealed2 (WithStartState2 p) -> [Sealed2 (WithStartState2 p)] @@ -281,8 +288,9 @@ shrinkState (Sealed2 (WithStartState2 s p)) = do shrinkAtStartState :: ( Shrinkable p, RepoModel (ModelOf p), Effect p - , prim ~ PrimOf p, Invert prim, Apply prim + , prim ~ PrimOf p, Invert prim , ApplyState prim ~ RepoState (ModelOf p) + , RepoApply prim ) => WithStartState2 p wX wY -> [FlippedSeal (WithStartState2 p) wY] @@ -297,8 +305,9 @@ instance , s ~ ModelOf p , s ~ ModelOf prim , Effect p - , Apply prim, ApplyState prim ~ RepoState s + , ApplyState prim ~ RepoState s , prim ~ PrimOf p, Invert prim, ShrinkModel prim, PropagateShrink prim p + , RepoApply prim ) => ArbitraryS2 (WithStartState2 p) where arbitraryS2 = do diff --git a/release/distributed-context b/release/distributed-context index 0fc3a2fb..c09f6469 100644 --- a/release/distributed-context +++ b/release/distributed-context @@ -1 +1 @@ -Just "\nContext:\n\n\n[add docs to configureHttpConnectionManager\nBen Franksen **20240519110146\n Ignore-this: ec69432373410c479f90ddda39b98a25a754db4d9e14055197cb47cfde85596faf2026e34f8fb11a\n] \n\n[add missing constraints data-default-class\nBen Franksen **20240519102829\n Ignore-this: 9d3f5afdeea6274f2532c2aa7fa407461bcddb3516a47a9fccb069500275e587d5cc252f41f6b96b\n] \n\n[Fix missing import in D.R.PatchIndex\nGanesh Sittampalam **20240513100533\n Ignore-this: bea59b7dfbd7e591a57f4bfcc7983003f79db4b4fe41f6072d904e9947a38d5936e75c9cdec0df86\n \n GHC 9.10 complains about it, not sure why earlier\n versions don't.\n] \n\n[ci: run tests with latest supported ghc version\nBen Franksen **20240517115615\n Ignore-this: 574d1033079aa6d6f5f42739ff36e353baf9b5503134f9b0cff839a02a64e101a778781f401661dc\n] \n\n[adapt supported ghc versions in README.md\nBen Franksen **20240517113218\n Ignore-this: c4e2e475e9c439bf0b240fd5dfffc6f57b43b94ecb57329e2686286b47f214a562150f0b336fce27\n] \n\n[ci: add ghc-9.8.2 to build matrix\nBen Franksen **20240517113141\n Ignore-this: a3103d91ec762a45b0e5b8a2a4f317d4358c58c0a94420f43784c623050af0381cdb9dc65a87bbc7\n] \n\n[resolve issue2715: hub.darcs.net does not support \"Extended Main Secret\"\nBen Franksen **20240515142402\n Ignore-this: 60c6b240cd1563fe7b3fc83845610e2c4d2ec00a6d5a4ada2e53e9fff4ff1022780a3dfa64d31a3e\n \n We use a new addition to crypton-connection in order to change the default\n setting back to old (tls < 2.0) default. For ghc < 8.8 crypton-connection\n is not available, so instead we constrain tls as before.\n] \n\n[support time 1.14\nGanesh Sittampalam **20240513000056\n Ignore-this: 929d96355713e762a5e77549597b6bd816992f93af1ef7125cdcf9caa396f6f5d82b2a8d71ff51e8\n \n This currently needs --allow-newer to use\n] \n\n[support QuickCheck 2.15\nGanesh Sittampalam **20240513000037\n Ignore-this: f078dc88530d2fdc51610fcadca12d0b355ae5c6594e76643f1592ccd329b5a8c817374f0522e0cc\n \n This currently needs --allow-newer to use\n] \n\n[support network 3.2\nGanesh Sittampalam **20240512234608\n Ignore-this: e50507030aecbb0cb90d369f331765cde093c746c257d6a301ea0d06ba91353b8d7aff9369e52bd3\n] \n\n[Resolve conflict in version bump from 2.18 branch\nGanesh Sittampalam **20240324221309\n Ignore-this: d035acfcb3339c22e37a8b4bc8f662258886e1f5ad786cd87d08edf9624cb3888606bf38d8177d26\n] \n\n[TAG 2.18.2\nGanesh Sittampalam **20240324205714\n Ignore-this: d03c480e509ce62eacaf0f1ad40f0cb7821163cac313d5ee4c977e7f77f9ec020b9e61214ddafe49\n] \n\n[bump version to 2.18.2\nGanesh Sittampalam **20240324205701\n Ignore-this: dd7bfdf697e6bc700288ee4a9406ed5d76e7ee049bc13a483c9ca3321903620c775e6fc133a12608\n] \n\n[CHANGELOG for 2.18.2\nGanesh Sittampalam **20240324205626\n Ignore-this: a7ea5d6b7ff3712201eb93651cdbf8653872da99839f527a6a6aa4a6f685b0707e867484ba805a57\n] \n\n[ci: upgrade actions/cache, fix cache/save warnings\nBen Franksen **20240510155801\n Ignore-this: 1b2f726a24693810ec0fe995af9a0be968ca86728cc26758ca9582516968397ca1d3b4be1c478a8b\n] \n\n[resolve issue2718: avoid using conflictedPaths to detect whether we have conflicts\nBen Franksen **20240510130208\n Ignore-this: 6aeca7588b2418053dd27039d0f2bcbecbee965e2e8a270f24f89b427fe787f9d811ef1eaf1a61bb\n \n This adds an explicit test named haveConflicts, which looks at the \"sum\" of\n the mangled and unmangled conflicts. This is cleaner because in principle\n (albeit not in practice) there could be conflicts that do not involve any\n file paths. Consequently, the warning message for conflicts is now separate\n from the listing of the affected paths.\n] \n\n[two optimizations in remove command\nBen Franksen **20240510071822\n Ignore-this: b4d3049af67f9824469de5692e6337f5dd0586e921b973632e74c9d180287f8d30460777119bc81f\n \n Frst, avoid duplicate call to readPristineAndPending by passing the pristine\n tree to makeRemovePatch. Also, use a path filter before expanding the tree,\n to avoid expansion of irrelevant parts of the tree.\n] \n\n[ci: remove ghc-8.2.2 from build matrix\nBen Franksen **20240509190406\n Ignore-this: f0a8e2f11701fc743212fda56d6106d5364cefead256b63d06d363e787b409a74318611cf1ce06da\n \n Building the dependencies now fails on macos-13 with ghc-8.2.2. We already\n excluded it for the other systems due to various build problems, so can as\n well remove it entirely.\n] \n\n[resolve issue2714: cannot remove recursively\nBen Franksen **20240506183723\n Ignore-this: fcab2e01d6fe9dc16facda2a569eeb4454c3c1208cdcd31bb9c630334290de1de6dba8d5611666d9\n] \n\n[put back the set-default hint\nGanesh Sittampalam **20240309154509\n Ignore-this: 7f52711f8776994dcb902a5d23741d6c6af6f3113c1ec30a2691348235d16cd81689a21eff8d334d\n \n This rolls back patch 8c1131290443248d423cabe0b5566f840e6cb3b3\n] \n\n[Add a --ghcflags/-g option to the test suite\nGanesh Sittampalam **20240309145422\n Ignore-this: aba41611871b0ee986beee2e1bd6fb9af6690bf7315737fdb1c166222685ee8be703003d492eb010\n \n This allows arbitrary GHC flags to be passed on to the ghc\n invocations used to build helper exes in various test scripts.\n \n For example this allows -dynamic to be passed on systems with\n shared libraries.\n \n Based on a patch by Vekhir \n] \n\n[Darcs.UI.External: fix warnings about head\nGanesh Sittampalam **20240225215257\n Ignore-this: 35ed1b4cd0f4c1af70133228547dac7fce5067a1482cbe6810c515f82389d70cb1f2bed0a7a32fc9\n] \n\n[Darcs.UI.Commands.ShowAuthors: fix warnings about head\nGanesh Sittampalam **20240225215214\n Ignore-this: ee64bb835284ac05403ea170915e8ed2191de27042e69edea61f5743bd752ea14e44082f54d90f9a\n] \n\n[use headErr/tailErr from safe for several head/tails\nGanesh Sittampalam **20240225215204\n Ignore-this: bb7a9c0ef437f841d13a7eb2a0a24abcf5ee4d26a2856feac2966a4f89a52a5b20560bea920fbc42\n \n They aren't trivial to fix in a concise way, and safe\n is generally a useful package to have around anyway.\n] \n\n[Darcs.Test.Patch.FileUUIDModel: fix warning about head/tail\nGanesh Sittampalam **20240225215135\n Ignore-this: 740956f48bd3127b4f77c0c7350b8d229e0fd7be3bda48932a61341169cc976d6e7ed3dedc7cad11\n] \n\n[Darcs.UI.Commands.Record: fix warning about head\nGanesh Sittampalam **20240225205552\n Ignore-this: e288796d05da69107f281ccd311e1980cfc7d71aaab72b3c2ab2619c0f1ceaff76a497ae37705689\n] \n\n[Darcs.UI.Commands.Convert.Import: fix warning about head\nGanesh Sittampalam **20240225205524\n Ignore-this: a8c51b94ff04c6bed7959f43c3d518d6171048755646fd1146a7996ac6d5c5013db900b51ff29504\n] \n\n[Darcs.UI.Commands.Convert.Export: fix warnings about tail\nGanesh Sittampalam **20240225204214\n Ignore-this: a49d956016082487081f71fcace360f65cb92ad17e10e195651821d6e009b70b9d01b49a2b0c8708\n] \n\n[add some tests for Darcs.UI.Commands.Convert.Export.patchAuthor\nGanesh Sittampalam **20240225204119\n Ignore-this: 4a3a731c86732c64a27b9e9719950e01a94ef320b37259113c693e75080283806a23835c423e40b9\n] \n\n[darcs.hs: fix warnings about head/tail\nGanesh Sittampalam **20240225201516\n Ignore-this: 8f6fec34b8e77474a3b1ee5e252fb08fe8439c57a4a0ad35df64c06fe15df18f83c82855d8435e15\n] \n\n[Darcs.Patch.Info: fix warning about head\nGanesh Sittampalam **20240225195147\n Ignore-this: f50bcf1a170c6c8941c688021e20d1eee24e59b2afe7a5f01488c9c4f2cb92d58aed586f146a0a98\n] \n\n[Darcs.Util.Diff.Patience: fix warning about head\nGanesh Sittampalam **20240225194009\n Ignore-this: ccfaccc22725d81839f5caf605742eb7f3ef916572fdd7a53bcc7f7fa837ef9d71729e7c71d4503\n] \n\n[Darcs.Patch.Annotate: fix warning about head\nGanesh Sittampalam **20240225182503\n Ignore-this: 4c48b8aadee71311e2a01f5b53a678e07f53339d98e843ebc01ebd381163fe0a9d7f3721c2c5dc58\n] \n\n[bump version to 2.19.1\nGanesh Sittampalam **20240225175930\n Ignore-this: b8e8df00de306f7de2363d1805c152be15cc5b5ab99a57be8f9db19bb8552d0d25a196eeb2dc20c4\n] \n\n[TAG 2.18.1\nGanesh Sittampalam **20240225173219\n Ignore-this: dc3a92eafcab9d4fa9f53b1811d4c99d330615a8c202bff1b77f44d551d21684eee81e96c69be62b\n] \n" \ No newline at end of file +Just "\nContext:\n\n[Drop accidental NOINLINE\nGanesh Sittampalam **20230701201627\n Ignore-this: 59b88ff9aacfc40ab4b6cb500b8e1af7\n \n It was unintentionally included in\n patch c30a57ae84c02fe0fd86093d25945ce1f8ef0ac2\n * fix all symlink problems, including Windows\n] \n\n[revisit askAboutDepends after review of 0f939713\nBen Franksen **20230626153736\n Ignore-this: cd7c482638b29600dfaf0ff21344cd36c6e090aca7090afae6aaf2b048874eff6ee54c4debcb4dee\n \n This again changes AskAboutDepends to contain only an RL of the candidates\n to select from. The extra complication in the amend command to re-construct\n a suitable PatchSet is now gone: we have the required patch sequence readily\n available, since it is the same as what remains after selecting the patch to\n amend. Also added haddocks for askAboutDepends, including a TODO item about\n a rather annoying limitation.\n] \n\n[add tests for --ask-deps to issue2293-laziness.sh\nBen Franksen **20230626123547\n Ignore-this: bd925e46adbad396792a190275a70ae1cc9344b4ae6de096cd97132a6257ed523e95fba9cd12b656\n \n These additional tests ensure that we never try to offer any patches covered\n by the latest tag.\n] \n\n[make the laws for class Ident more precise\nBen Franksen **20230626083328\n Ignore-this: 76d7d14e040941ba0e2b6c773ceb5c84f2f7e8f51b0784e51509746bb573a149342a850be7bee186\n] \n\n[cache: explain why we use catchall when hard-linking is optional\nBen Franksen **20230625202037\n Ignore-this: ce64b48677f342fc673d00ff3840950324ddaa7f71d41ae991e33051738ba96eade920623ce3dc98\n] \n\n[ci: update available runners\nBen Franksen **20230623110255\n Ignore-this: 7ec0adb1e37b2220291079a55877164ae133040abacd79f0edb088aa66098fffcc26bb30b481f7cb\n] \n\n[ci: use cabal-3.10 to fix build errors on windows-2019\nBen Franksen **20230623203324\n Ignore-this: 5f2c4707e2fd94b4e7dad8d555217b8f2f8f7af12660f13bfda5266a9b52f1e9a22977b4683cbd12\n] \n\n[ci: use latest releases of ghc-9.2 and ghc-9.4\nBen Franksen **20230623110010\n Ignore-this: 6d0dec81be59fe8012f482e449a38d71993925c6a6151b46da07773cc4a401d604947637f3cc4a35\n] \n\n[use red color to make message about dropped dependencies stand out more\nBen Franksen **20230619182017\n Ignore-this: 9437cc675956e89a79d36530daf574653da4c53aaa542a113c010e9684310aa6cfbb33eb8bdfaca9\n \n This is semantically similar to messages about conflicts which also use red\n text. Actually this *is* a conflict, it's just that outside of rebase darcs\n is strict about dependencies, so this sort of conflict cannot happen.\n] \n\n[rebase: show dropped dependencies in both verbose and summary mode\nBen Franksen **20230619114810\n Ignore-this: d60b7be86a606b5834fca4bcfcb15260e674b9c8c9634d1fec0fb9a795cdf65239ed921dee8db1de\n \n This patch also makes the summary output for explicit dependencies (both\n dropped and regular) less verbose by compressing it into a single line.\n] \n\n[fixup comments\nGanesh Sittampalam **20230624213514\n Ignore-this: ba13480dc6d5f9e6a5209fe0ca9469e5\n] \n\n[put back the Darcs.Witnesses.Eq import\nGanesh Sittampalam **20230624205809\n Ignore-this: d8b9c6f924bae187a7308ad77fd6867e\n] \n\n[limit the scope of the unsafeCoerceP in rebase unsuspend\nGanesh Sittampalam **20230624205419\n Ignore-this: 81b3fa2a8fa12130b16693282b5910e0\n \n This is a followup to this patch:\n \n patch 926216a7c734b0e7fd8d0e6be324370ded4b86c4\n * refactor rebase suspend\n] \n\n[change (and fix) conflict markup for RepoPatchV3\nBen Franksen **20221230083840\n Ignore-this: 74d2670d80133cfc753452cdbf67ac87e8dcd232d243a5e1db1693ffac0aa564b6b8186c3912b7cb\n \n The main semantic change is that we don't merge the maximal non-conflicting\n sets of the conflict graph. Instead, we display each of the conflicting\n alternatives exactly as they arise in the project's history. While merging\n of non-conflicting alternatives is theoretically valid and typically results\n in fewer alternatives, it makes manual conflict resolution more difficult.\n The comments explain the rationale in more detail.\n \n The previously failing test for propResolutionsOrderIndependent now pass.\n This is due to a few subtle fixes in the algorithm. The details are\n explained in the docs for findComponents.\n \n On the implementation side, we no longer calculate from scratch which\n alternatives conflict with each other, since the conflictor representation\n already contains that information; we just have to accumulate it properly\n during the traversal.\n \n Raising the lower bound on the containers dependency has been done so we can\n use 'Data.Set.disjoint'.\n] \n\n[minor code layout changes in V3.Core\nBen Franksen **20230618162101\n Ignore-this: eeab3dccd29131bc77fb03593b926b222a56ca800067885d6fcab956a72eb4edc7830499af42cbaf\n] \n\n[add proofs of impossibility for all error cases in V3.Core\nBen Franksen **20230608220735\n Ignore-this: d169f908b97d5c93e307ada852f09fa5ef447c256391d09a0b6c5abafac747cf509722db69ffdef6\n] \n\n[fix two typos in comments in RepoPatchV3\nBen Franksen **20230611180242\n Ignore-this: a66f8874c70f1f96c71308e562a4809705f0edc9807de6424911a0882e151f0d48c3dc149a04894\n] \n\n[applyToTentativePristine: replace verbose message with progress reporting\nBen Franksen **20221215155316\n Ignore-this: 3d7d80e286394936e58ab30e9a10fbe84c587a305a98bd3eab107fa7e8cae03ea649cf7bc665533c\n \n This removes the verbosity parameter to that function and everywhere it gets\n passed around just because we call that function somewhere down the line.\n Instead we add progress reporting also when adding patches, symmetrical to\n what we already did when removing patches.\n] \n\n[eliminate the ugly and low-level applyToTentativePristineCwd\nBen Franksen **20221203142138\n Ignore-this: 6c54be2b03a495498d944fa0dc06a14410916dad68bda30ed8793504ed5997b92cb39bc860957ee5\n] \n\n[remove the ugly ApplyDir type in favour of Invertible wrapper\nBen Franksen **20221203122324\n Ignore-this: 46704420ddc4e8278c8f2312f865f549d5edaf2f60f5dbba7c62575c5f3cd0fbbe2a19c3274db08d\n \n This is much cleaner and allows us to give a more precise type signature for\n applyToTentativePristine. This also makes tentativelyRemovePatches_ the\n primitive and defines tentativelyAddPatch_ as a simple wrapper; this is more\n symmetric to tentativelyRemovePatches_ and also more efficient.\n] \n\n[clean up D.R.Clone.copyRepoOldFashioned\nBen Franksen **20221203115453\n Ignore-this: 10055080322e1939951eb6e9479ca468aed037b6d882af07c9f319e6cffe0e29ae8ebd98974de8dd\n] \n\n[always store hashed files in compressed form\nBen Franksen **20221127185606\n Ignore-this: ca6055f843163be0d1dcaa0d024a5979176de7ede737e115f7ea9278eda85faebe45bf2b2467d5c2\n \n This removes the --[un-]compress option from most commands. The only\n remaining command that supports it is `push` since there it is used to\n control whether the bundle is sent in compressed or uncompressed from.\n Sending uncompressed is needed for compatibility with older (pre 2.5) remote\n darcs versions. The `optimize uncompress` subcommand is still available, as\n an uncompressed repository may be nice to have for debugging. Note that we\n are still able to detect and read uncompressed hashed files.\n \n Rationale: This removes an unnecessary complication (passing around an\n argument of type Compression wherever we may want to write a hashed file).\n It is also better to have only one binary format for hashed files.\n] \n\n[repair: do not clean pristine dir\nBen Franksen **20220627130209\n Ignore-this: 354d06e85e68ddca15d9e6ebf2d5f50fcfdf8060677fe196865da6824a9460fc62b9065e99e6ba6d\n \n I found that it can be quite useful that darcs never does any cleaning\n automatically (except for convert export where it actually makes sense),\n since this allows to restore things that would otherwise be completely lost\n e.g. after an erroneous obliterate.\n] \n\n[cleanup cleanPristineDir and move from D.R.Pristine to D.R.Traverse\nBen Franksen **20221129002528\n Ignore-this: 69eeedf89a3ba7645b8de297cd9def7dd79e7a4482773ba81d5157e98d495b78f1e01546fefa24ef\n] \n\n[remove no longer needed export of diffHashLists\nBen Franksen **20221126003540\n Ignore-this: 24181ea38a057397153e5a2f3be8e41385973e3162c50baedf5206388356b2d77ca8dd1acbc82192\n] \n\n[add Darcs.Repository.Transaction\nBen Franksen **20221127121114\n Ignore-this: b5cd2930da775b342588def0318cc799acd2acda7769e5131150330ec001791028fac8208536abbf\n \n This is to avoid import cycles when adding functionality to new modules\n under Darcs.Repository, since this usually requires that we add things to\n revertRepositoryChanges and finalizeRepositoryChanges.\n] \n\n[improve the interface of D.R.Inventory\nBen Franksen **20210327070913\n Ignore-this: f1e6bc0e935a2663dcd3790eb00dc5eed35951309b9f3cbd996d9fdd3424cdd8e585d69626a8a450\n \n This combines the internal functions readInventoryPrivate and\n readPatchesFromInventoryEntries into readOneInventory, for use by\n upgradeOldStyleRebase.\n] \n\n[increase limit for environment variable size and warn if it is exceeded\nBen Franksen **20230606094908\n Ignore-this: 42812c603851546a940b5d6758035e63aa1820433af915c7d0250b21235f84528c795723d6c75b28\n \n I recently hit the previous limit of 10k with a bundle of moderate size\n (about 25 patches) and the internet says on modern systems the limits are\n much higher than 100k. Also, when the posthook for reviewed complained about\n the missing DARCS_PATCHES_XML I first thought it was a bug in darcs, before\n realizing that this is a feature. Thus the warning.\n] \n\n[rebase: offer to revert conflicting unrecorded changes\nBen Franksen **20230228175744\n Ignore-this: ea493dffe6af64c1e3b778b1b9fc849f5fa24777c1c7d3f61c24b69184451c723245e651fc24be2b\n \n This is the same change as for obliterate. It affects all subcommands that\n potentially suspend patches: suspend, apply, and pull.\n] \n\n[WIP disable tests/network/log in the CI\nBen Franksen **20230216183212\n Ignore-this: 6271b8497b259ed7729f07d21a0a5b6d4180a4c6d90a24ca897610536a66621d6dc0f3b1ecde7bc5\n \n This test regularly runs into failures that seem to be caused by darcs.net\n when it receives to many requests in parallel. I haven't figured out what\n exactly is going on, this is just a temporary stop-gap measure.\n] \n\n[rebase edit: now with undo/redo\nBen Franksen **20220702201447\n Ignore-this: 32986d99666965101c544e8337d08ac2d8233effab6249af27668b2f6fed9ff102e3a9ef4fce5fb7\n] \n\n[new command: rebase edit\nBen Franksen **20220630213810\n Ignore-this: 53ec3819fdac3b54f6d716a3c005e1cb24c2a576ec3256233ef5e1662c8635a21eb2edb583058aa4\n \n It allows interactive editing of suspended patches. We navigate through the\n suspended patches and offer the actions: (o)bliterate (dissolve into fixups,\n like rebase obliterate), (s)quash (with previous suspended patch), (i)nject\n (like rebase inject), (e)edit name and long comment, together with the usual\n viewing commands, as well as (q)uit, and (d)one.\n \n In contrast to other interactive commands, this one performs the requested\n actions immediately (in memory), instead of first selecting patches and then\n doing the action for all of them in a batch. This allows us to circumvent\n limitations arising from dependencies, since patch selection requires that\n selected patches can be commuted to either end of the input sequence. This\n means 'rebase edit' also serves as an improved version of both 'rebase\n obliterate' and 'rebase inject'.\n] \n\n[remove unnecessary re-ordering in partitionConflictingFL\nBen Franksen **20230613134449\n Ignore-this: 26dd00fd4bb2940dcec98205d840bf65e913e466080ea47456c5c4261f11b6fdad5566fbadb5453a\n \n This fixes an annoying behavior of rebase pull/apply: the suspended patches\n are now in the same (relative) order as before the operation.\n] \n\n[improve display of \"conflicted\" RebaseChange\nBen Franksen **20221225062929\n Ignore-this: c4fe9edec6cda2fef48b94484a2c20eddaae5546d16c79e857d07c42beabfc871836df1c3e5d0185\n \n The previous, simpler method displayed them as a \"large\" conflict of the\n whole patch with the inverse of the fixups. It is now more fine-grained,\n showing conflicts inline per prim. This works by choosing RepoPatchV3 to\n wrap prims and then display the result of a forceCommute with the residual\n fixups. Special care needs to be taken to filter out leading inverse pairs\n that forceCommute temporarily injects into the patch (a hack that was needed\n to make it work with RepoPatchV3).\n] \n\n[RepoPatchV3: improved display of conflictors\nBen Franksen **20221224062945\n Ignore-this: 7763c3fb9f94d11277d871d32847348e4dd6a46d8c3db209fbf505ab14a20600eaa8cf73a48c6a79\n \n It now displays the effect, followed by the (in-effective) conflicting\n alternatives in a way that is similar to conflict markup (though minus\n display of the base). This is easier to parse for humans and more\n informative than a dump of the internal structure of a conflictor.\n \n Unfortunately it is not so easy to do this for RepoPatchV1 or V2.\n] \n\n[remove withContext/unified option except for non-interactive whatsnew\nBen Franksen **20211116133205\n Ignore-this: 4a55b26ceba7b9964c46ac88b4db93924a7c222e77468b4b0d768b932c14a83caba49338e3d5f348\n \n The way this was integrated with the interactive patch selection never\n worked correctly because we did not track the changes to the state and\n instead used the same state for each patch, regardless of whether the patch\n in question even makes sense in that context. Fixing this would require a\n major refactor of interactive selection in order to keep track of the state\n for the patch in focus. In particular, the PatchChoices data type would have\n to be either abandoned or re-written to store patches together with their\n start state (which perhaps could be made lazy enough to keep the current\n performance profile).\n] \n\n[whatsnew: remove display of context lines in interactive mode\nBen Franksen **20211116114055\n Ignore-this: 72ff902d7b17956ed0652ad8dd0f00a259bac8d530b41136d324728a4fcfa6700ed887662ab49886\n \n As with other commands, context lines cannot be correctly displayed in\n interactive mode because we don't (currently) track which changes have been\n applied.\n] \n\n[generalize contextual printing of patches\nBen Franksen **20211116115136\n Ignore-this: 8ea764b1a0a96bd38eee8cbbcef26e2147ac5d52c35d33a64da22c5a2356ec397b4903ba71dddf66\n \n By using runApplyMonad, it no longer requires ApplyState p ~ Tree.\n] \n\n[obliterate: offer to revert conflicting unrecorded changes (if any)\nBen Franksen **20220630094037\n Ignore-this: 72110cbbd4a0ece01a89d6f9e42b242534193ae2aef334ac6057d234c34706cdc3812f3516c92258\n \n The new behavior is limited to interactive mode: instead of failing if the\n effect of the patches to be obliterated don't commute past unrecorded\n changes, we display (only) the conflicting unrecorded changes and ask the\n user if they want to revert them. If they refuse, the operation is\n cancelled.\n] \n\n[cleanup code layout in src/Darcs/UI/Commands/Unrecord.hs\nBen Franksen **20220629061445\n Ignore-this: a26dbc2ab7df5fb6ff4e105cd9ede920d932b12dc0d57787346f52616f74e441f8fd8e196ee59f94\n] \n\n[use doesPathExist from System.Directory instead of Darcs.Util.Path.\nBen Franksen **20220629061405\n Ignore-this: f99a2a3cfdb0ba87718a2dde1c58585d60d6033a89f53248b9c252b8f3f1b100d66c28cd061c7974\n] \n\n[add constraint tls < 1.7\nBen Franksen **20230606080715\n Ignore-this: 8722107dd8a332a631f72003619e523f9a5a0a3cf7c8d0eb25b61b6dcb273b8afec78f089915eef7\n \n This fixes build problems for ghc version from 8.8 up to 9.4.\n] \n\n[fix propConsistentReorderings and propResolutionsOrderIndependent\nBen Franksen **20230603193120\n Ignore-this: 37a2aab9e08738e229552070ec592838e5afb88fdc4d35b2f94a0c09aa0f40e9f9a39d80d567ae04\n \n After fixing permutationsRL it became obvious that propConsistentReorderings\n is completely wrong: it succeeded when it should have failed and vice versa.\n To guard against regressions, we now call error if permutationsRL returns an\n empty list and reject the test case if it is a singleton.\n \n In propResolutionsOrderIndependent we now compare the resolutions before\n mangling. This more general and also more reliable, since mangling can fail\n if not all prims involved in the resolution are hunks. Note that we must use\n order-independent equality for the alternatives.\n] \n\n[fix a (serious) bug in permutationsRL\nBen Franksen **20230603180845\n Ignore-this: 3d6da2e8469d681a15bdd4a3c1826ca7b585f228d8e15d95832ead78c5634ba941fca1360172b28c\n \n It always returned an empty list. Thankfully it wasn't used in darcs proper.\n However, two RepoPatch tests are affected (propResolutionsOrderIndependent,\n propResolutionsDontConflict) with the result that they never tested anything!\n] \n\n[resolve issue2704: flush stdout before invoking external diff\nBen Franksen **20230602092807\n Ignore-this: f16f4ee674a3d5478856b75de7238180a18a0395cf3c453b5857eff78af154d9e721615da02575e6\n] \n\n[improvements to contrib/update_roundup.pl\nBen Franksen **20230601095208\n Ignore-this: 77c41cb1b3ce108687fc733ead93d1678895a1155fc5c98187fbfb2f01212c6f1ad8e9b8f2e80477\n \n - add hash and author\n - remove \"Ignore-this:\" lines from comment\n - indent the comment and separate from name by an empty line\n] \n\n[tighten Maybe Hash to Hash in Darcs.Util.Index.updateItem\nBen Franksen **20230326104708\n Ignore-this: 8dc355af495afe04ea96d382ce9cd938520500c8e597667b7733f136cad88eda054f2ca6a595ae13\n] \n\n[fix misleading docs for updateIndexFrom\nBen Franksen **20230326115335\n Ignore-this: caf6c824417d0008e94674e2bde614462d305f4e8e880b06380b36afa535aff98794d6e9bb110b9\n] \n\n[remove the hashtree parameter for the index\nBen Franksen **20230326105658\n Ignore-this: 80a0d78f0ac5a521da0cf040ffefdbdb125526137f49ceda68531bc8cdf67bb5d24c61d0d8b85dc0\n \n This made sense when hashed-storage was a separate package but as fully\n integrated a part of darcs there is no reason to use anything other than\n darcsTreeHash.\n] \n\n[diff command: support --look-for-moves and --look-for-adds options\nBen Franksen **20230310114116\n Ignore-this: 941a0dc668d46bc0ca4a0841fe6ee69059a54e0d1ea8d83549b507faa4cbc15dedf3c2bdd8717a09\n \n This is useful when using `darcs diff` with unrecorded changes.\n (Note that --look-for-replaces makes no sense for diff.)\n] \n\n[remove \":\" from progress message in record command\nBen Franksen **20230326075952\n Ignore-this: 5f5162a59e227caa5c1f8046fc6db5298ffbc99786faa3ab59d0f35f51e84e2bc8006b0709fede10\n] \n\n[remove a temporary work-around when running 'less' as a pager.\nBen Franksen **20230310113217\n Ignore-this: 4d9f5abfb7f5011d302c276f81512cb577e6d7799cd39bb8d46ee4cd1d92f0c6f91e339ac2e9ad70\n \n We require process >= 1.2.3.0 nowadays and indeed use delegate_ctlc in\n pipeDocInternal.\n] \n\n[Darcs.UI.Completion: fix docs, anchoredPath \"\" -> realPath\nBen Franksen **20230308093151\n Ignore-this: f77d3e185652ff6b0527253fa16e9666d327384a3cac4cbab52a201eb1889b971c5bd424bd29bd41\n] \n\n[rename procedure setScriptsExecutable -> setAllScriptsExecutable\nBen Franksen **20230305115803\n Ignore-this: 391fd8617953dda9041df6a369ff9980be22e0a81753543f472db19c157e8207f759a1db67204d3b\n \n This is to make it easier to distinguish it from the option with that name.\n] \n\n[add short option -n synonymous for --dry-run\nBen Franksen **20230225092014\n Ignore-this: 4e7011c9e95649bbbfab1d88a4d36ec4410cc6e58ec42f968d5f24cba9b5985a26842eab3c303204\n \n We follow a well-established convention with this.\n] \n\n[mention --from-hash and --to-hash in the output of `darcs help patterns`\nGian Piero Carrubba **20221216183536\n Ignore-this: ed4c7670b415df11d084c28094079b0ff1429ee49ca0ea8684c0c921bf521498dda453dbde7e2229\n] \n\n[clarify help for --hash, --from-hash and --to-hash options\nGian Piero Carrubba **20221216174702\n Ignore-this: 43ad49495ef4cbc5e08cd6d2e82650a4c575c8a8aedbc80c7bfd6160a28ba943d3ba775d11e90065\n] \n\n[resolve issue2702: invalid regex is treated like a bug in darcs\nBen Franksen **20230525092443\n Ignore-this: 1c7fd9e71e59f6f0ff677c9c5f357f53c5ced57945c1788bfa8528b9e8b99bf2620f7c6ad98575ad\n \n The only tricky part here is that before ghc-8.8/base-4.13.0 regex-tdfa\n calls the 'fail' from class Monad, not the one from class MonadFail.\n] \n\n[resolve issue2701: clone ssh repo with Ctrl-C\nBen Franksen **20230402130530\n Ignore-this: 7da4075bf0d8e051d9fd1f09cf1b29bb01ed1daaf195426eac60507c91d31187131eaae56c29e185\n \n This solves the problem by terminating all child processes that run a remote\n 'darcs transfer-mode' and recording that in the sshConnections MVar. The\n next copySSH will then start a new child.\n] \n\n[harness: do not set suites=\"snu\" when --full is passed\nBen Franksen **20230414065428\n Ignore-this: 59448ff3d3f304bd2b78bb8b702b687a0df2d1fb1f22ea456f14fac10685889fffecdf53d0fcba25\n \n This allows to run --full i.e. all variations while still selecting only\n a subsets of the test suites to run. Note that \"snu\" is the default set of\n test suites anyway, so if you with just the --full switch the behavior is\n the same as before.\n] \n\n[use StrictIdentity as the Pure apply monad\nBen Franksen **20230401154446\n Ignore-this: e68e9c72aa7dac941d5d54b7c584b06364c005cf560796d454d3b935dddf37bb506446b1259cbba8\n \n This is so that we can satisfy the laws for MonadThrow.\n] \n\n[group matching constructors of DarcsFlag together\nBen Franksen **20230331223250\n Ignore-this: 6ad9c5118f8c8ebf9c5b2bea526c4eff9f58efe232ce319849a84322e694855b3a7f9479f9b8afb5\n] \n\n[resolve issue2074: cancelling an operation is not failure\nBen Franksen **20230328172114\n Ignore-this: d78ce3917c07314b3efe7fb0554332109a126db95308eaf9c6c5237b11c2a7e4ab80bf5627465330\n \n See for instance D.R.Merge where we do the same.\n] \n\n[accept issue2074: cancelling an operation is not failure\nBen Franksen **20230328172430\n Ignore-this: cecc3707d861e507069e392eff6fe185067133158f91d38d76c93febc226216e90703ca022ae6fa7\n] \n\n[progress reporting: fix for non-native Windows terminals and simplify\nBen Franksen **20230312095516\n Ignore-this: 2321744f7b222310dd3b9c6198054eca81ca7cec6f1c479584a68c28e9caa908bf8ff6dcd3b327b6\n \n The fix is to not rely on hIsTerminalDevice which does not work correctly on\n Windows with non-native terminals, such as MinTTY used in MSYS and Cygwin\n environments. Instead decide based on the result of the 'size' procedure\n from terminal-size. Also, don't print any progress messages if that returns\n Nothing, instead of falling back to putStrLn.\n \n The simplification is to print progress messages to stdout rather than\n stderr and to never add timestamps. Rationale: timestamps are for debugging\n and useless in progress reports; whereas progress messages are an indication\n to regular users using an interactive shell.\n \n Note that if stdout is redirected then it is no longer a terminal device and\n therefore progress messages are automatically turned off, which incidentally\n fixes issue1822. This is important when you run darcs commands from a cron\n job: in that case you do NOT want to redirect stderr, so that the system\n sends you an email when something goes wrong.\n] \n\n[make --timings more useful\nBen Franksen **20230312085711\n Ignore-this: 154d2d148b4007bfb77b9b9bb26f511e0fe242c9bc016a666df5de4a981e97e47cbc8b87d6209571\n \n It now prints timestamps relative to program start (more precisely: when\n setTimingsMode is called) in a suitable format (mm:ss.microseconds).\n] \n\n[turn some methods of ValidHash into plain functions\nBen Franksen **20230326211527\n Ignore-this: a6129043084618529de137ed2e118bd6fc65fb7b5e366b879323336cd7178c639b29301aefbc412b\n] \n\n[add proper parsing for (possibly size-prefixed) hashes\nBen Franksen **20221217091934\n Ignore-this: 5d62ccd1ae36600ea916a862d84edd73839e996311904d3c44190e2dc26320a2cd52f2cc0aea3b57\n] \n\n[bugfix and cleanup for maximum size in hashes\nBen Franksen **20230326222612\n Ignore-this: bc5507774ed502ea9c62e15c93e4866a5016d048ea21ee15996ad1b4974dfbb8d8599881f3a846f1\n \n The previous size limit was too small by a factor of 10. To avoid such\n stupid mistakes, we now calculate the limit from the number of digits and\n use a constant for both.\n] \n\n[ci: fix caching of cabal store\nBen Franksen **20230324190002\n Ignore-this: 5ab17bcf8758556117a5e444fc3a3c6581ec577ad627070a99e45b8be383e0300298fb93f0886817\n \n For caching to work effectively, the key used to save and restore the cabal\n store must have the property that the key changes whenever any of the\n dependencies change. This is now guaranteed by doing an extra `cabal freeze`\n step and then hashing the resulting cabal.project.freeze.\n] \n\n[add test case for empty inventories\nBen Franksen **20230323011918\n Ignore-this: 2bf69e2f21d084b6627838e3fcff0b54361209aaea911250242b107edf2692f3c9f0563424b14986\n] \n\n[add docs for unsafeStart/EndTransaction\nBen Franksen **20230322234110\n Ignore-this: b7688e3eee2fd05c5e8cd515e62126a6c4ba28839f420c188b3f105539765f1533ac4b02f2879204\n] \n\n[document isValidLocalPath checks in D.R.Rebase\nBen Franksen **20230322223350\n Ignore-this: e80211e549970d2ea07ced4750ead1222a75077d8fb1fe0fb13744b0267296eb5db05f25fec0a714\n] \n\n[improve documentation of findConflicting\nBen Franksen **20230322224608\n Ignore-this: 1f539a193dbdf8f1a714aaab3f223b2b4e3ed5f01b23b346e4c6a4c6f6b1048d8e478f1011e35a41\n] \n\n[generalize type signature for rebaseResolution\nBen Franksen **20230322223440\n Ignore-this: 43d099c39780120e6ae8f7e75caa2b4921ca5dd3195391eda2d629fc300f98abf20ee4ea9f663363\n \n It no longer requires (Commute p) and thus cannot use the instance Conflict\n (Named p), making the type reflect what we claim in the docs.\n] \n\n[rollback \"lock/unlock inside revert/finalizeRepositoryChanges\"\nBen Franksen **20230320205151\n Ignore-this: d031775bc1beb6ff117e6de779b6c98a09dc15c433285936fca14ab2f5ba831b60eeb91855f7243f\n \n The motivation for that patch was to ensure that the repo is always locked\n inside a transaction. However, the price for that is considerable: bracket\n is much cleaner than atexit and plays better with use of darcs as a library.\n] \n\n[fix docs for the wR type parameter to Repository\nBen Franksen **20230320203024\n Ignore-this: 6139abfd20a365a2adfd00c50117a8d58a4da1dadb8665d0104f8d0ece4410b224e39c43624bb437\n] \n\n[remove UpdatePending parameter from revert/finalize\nBen Franksen **20230228080109\n Ignore-this: e1cddbf4959a66ae6f085343189d7a3640c6f35405c9abcfaeba30b5b67da3a6bfc6834e3b4689\n \n The complication added by this extra parameter is not justified, given that\n - we have to remember to pass the same value for both calls,\n - passing NoUpdatePending merely avoids one file copy and one rename, and\n - was done only in a few places where to knew that pending is not touched.\n] \n\n[rebase: take applyToWorking out of doSuspend\nBen Franksen **20230226214317\n Ignore-this: 259e39ce2cf6327f1607958af6eef7edc51bb821b76e93e3b96c200449ed641becc42554ddc4b137\n \n This makes rebase suspend a bit safer, since we can now finalize and update\n working inside a single 'withSignalsBlocked' block.\n] \n\n[resolve issue2700: rebase pull spurious conflicts with unrecorded\nBen Franksen **20230226214031\n Ignore-this: 55e70eba92d71c8184d4be3b1a60342f61ee3b372a66873a511a0679d2b5932518f5e03dd7422a4a\n \n The culprit here was\n \n patch b9117bbe58bad86463ed390c75aba9a2539a2c30\n Author: Ben Franksen \n Date: Tue Mar 2 11:48:56 CET 2021\n * get rid of \"nasty hack\" in applyPatchesForRebaseCmd\n \n Finalizing a transaction also updates the index, which has an influence on\n the result of unrecordedChanges (which is called by tentativelyMergePatches)\n because the index is used to filter the working tree (unless --ignore-times\n is in effect). We eliminated a finalize/revert pair, which means we must\n call 'updateIndex' manually here. We normally don't change the working tree\n from inside a transaction, so this is a somewhat special situation.\n] \n\n[require terminal-size >= 0.3.4 which has hSize on Windows, too\nBen Franksen **20230314075908\n Ignore-this: 67e24c62d6110d5d4316e904e0124eec806bb19ce831df160dab31d944ed5917915616a414267071\n] \n\n[relax upper bounds on Win32 dependency\nBen Franksen **20230308212147\n Ignore-this: 1476c1e1429fede4578e3631dbef610913001ab8e7e79da683e323d37755e28dddc7be12a0de532d\n] \n\n[resolve issue2699: obliterate and rebase suspend fail to adapt pending\nBen Franksen **20230226200041\n Ignore-this: 93fc8671fb2d4280c70a2f7adafe061c26996f083b463cb178080a91ad5b4c3903c54050d83da875\n \n This is a rollback of\n \n patch 4f9ac2caf52b420538798dddc15f4211c1fdcaa8\n Author: Ben Franksen \n Date: Tue Mar 2 14:13:40 CET 2021\n * obliterate, rebase suspend: pass NoUpdatePending to\n tentativelyRemovePatches\n \n though adapted to the changes made in\n \n patch 8237940978023934f829ef3d5d449007b867d55f\n Author: Ben Franksen \n Date: Tue Mar 2 16:06:25 CET 2021\n * remove the unsafe tentativelyAddToPending, replace with addToPending\n \n When we remove patches from the repo and the working tree (as done in\n obliterate and rebase suspend), we must also adapt the pending patch. The\n way this was (and is now again) done is by first prepending the effect of\n the removed patches to pending (by passing YesUpdatePending to\n tentativelyRemovePatches). Afterwards we append the inverse of the result of\n commuting this effect with all unrecorded changes at the end of the working\n state. The net effect of these two operations on the working tree is Nil,\n but their effect on the pending patch is not, since the effect of the\n removed patches gets commuted through pending when pending is sifted.\n \n This is a very roundabout way to adapt pending. It would be simpler to just\n commute pending through the effect of the removed patches and directly store\n the result.\n] \n\n[ci: build docs only with latest ghc version\nBen Franksen **20230316073327\n Ignore-this: 9bac744c1e19a7cb255e9a947ea3b5d4bde928698c7434aa255e885be8ea0a1a3fccac4261f2c3bd\n \n This is mostly to avoid errors when building the docs for a deprecated\n indirect dependency (system-fileio) when using ghc-9.0 and ghc-9.2. The\n patch also improves dependency caching when we build the docs.\n] \n\n[ci: exclude windows-2019 (and explain why)\nBen Franksen **20230316155027\n Ignore-this: 6fdb5d2b7208d7e3c1a665a029587137c2d1d2c98c6b6b18a398a5a33c341f301c5b89fd64ebddf\n \n Note that this means we cannot support darcs on windows-2019 at all.\n] \n\n[ci: remove caching of dist-newstyle\nBen Franksen **20230316083027\n Ignore-this: ac6eb5224da2f47c1ff064a1a2e91e729e2b47f8578e7bfa3f481900a8d022712426e802df78b92b\n \n I have lately had situations where after changed dependencies in darcs.cabal\n I got segmentation faults that disappeared only after a cabal clean and\n rebuild. Besides, it never worked anyway: the cabal build step always\n recompiled everything, regardless of whether we have a cache hit or not.\n] \n\n[ci: make cabal version explicit to avoid breakage\nBen Franksen **20230316073835\n Ignore-this: e3eafc6b1641a6523ef418ba3a1634b9ebf4134f48f6f33cc82e5ad7338d87c6d61b53480901a706\n] \n\n[ci: split cabal store caching into separate steps\nBen Franksen **20230316080937\n Ignore-this: 18b9da084e6a10f667c85c77784c9a5720e89f1e4f5700b06e5069de288cfd55ecf169789ba09950\n \n This feature is new in actions/cache@v3 and allows us to cache the\n dependencies even if later steps (like building, haddock, or tests) fail.\n] \n\n[ci: run tests for ghc-8.4.4, not ghc-8.2.2\nBen Franksen **20230316073106\n Ignore-this: 6c159d9021ba7665cc3bf6c57ad667fe3d614629548699cbbaec3f17b0ac5ab725c2e44f9afd78c\n \n Because we cannot install ghc-8.2.2 on the latest ubuntu.\n] \n\n[ci: use latest releases of ghc-9.2 and ghc-9.4\nBen Franksen **20230316072811\n Ignore-this: b0c4cc7d4f5fde8c1596cb5a9a1a8124e5c7a90d61f6f0e1fda58d1117e1f667d2c9332214e32c72\n] \n\n[bugfix in TreeMonad rename\nBen Franksen **20230305110223\n Ignore-this: 20f3330e89b552b4398ae832d181cd2cabe7477db7485bba48ee2a762804463fe1526b1246890e6e\n \n The two failure conditions did not match the exceptions thrown, they were\n swapped. This goes back to:\n \n patch bc1aa9cfc3057bf9d43aad4e0b77b47e18600037\n Author: Ben Franksen \n Date: Sun Mar 14 23:00:59 CET 2021\n * better error handling when applying patches\n] \n\n[add class Annotate to constraint synonym PrimPatch\nBen Franksen **20221225051628\n Ignore-this: bd434090ac78c07caca575056047f56d4dcf21b52afcbf386477b4a3968977b6ca755e08ac19dcf4\n \n Separating out Darcs.Patch.Annotate.Class was necessary to break an import\n cycle.\n] \n\n[remove unnecessary imports of D.P.Annotate ()\nBen Franksen **20221225062712\n Ignore-this: 8524eea285723d358a892a014386fb77a0f9be6ecffae50b69ebc815c6ab9fa25928eb26d91b6dd4\n \n The Annotate class only has instances for prim patches.\n] \n\n[add and use a few generic Gap utilities\nBen Franksen **20210919065532\n Ignore-this: 2824f34b7e56da35a6ee4c9da5f32cad623ce0f9e04e1a79de9b7d2f9079df7e424940bca41743cd\n \n This also re-implements freeLeftToFL as unFreeLeft . joinGapsFL and then\n inlines it at its two call sites.\n] \n\n[improve progress reporting when merging patches\nBen Franksen **20220818113026\n Ignore-this: 359021c9bbc5885d45ba5febf70feedf79d3499d9913f0b9baa12c640cca96f9b30661d12a9678d1\n \n All parts of merging that are potentially slow are now covered and can be\n clearly recognized.\n] \n\n[improve and simplify progress reporting\nBen Franksen **20221212175051\n Ignore-this: abd59ad3cfb3d008e8f0f7793cd3595aad2fa2b44d6ed4984795d0aafb9deda828a44bf38559a568\n \n It would previously drop whole items from the output line if it gets too\n long (>80 chars). This is bad because it often means you don't see any\n \"progress\" at all, just the key phrase (possibly for a long time, suggesting\n darcs is stuck when it is not). We now always print the long version and cut\n off chars exceeding the actual terminal width. To determine that we now\n depend on the terminal-size package.\n] \n\n[add progress reporting to writeDarcsHashed\nBen Franksen **20221208132230\n Ignore-this: e8af79e05c10ea0eed5109d699311ed5cf2e362734c37f3ad74ec50aa53e6a1a3ab0b96c4b5e6b6f\n] \n\n[add withProgress and withSizedProgress to Darcs.Util.Progress\nBen Franksen **20221212185406\n Ignore-this: 311db1d5dfe9195b428c6b4f95df571b5efdb50bf20c286589144ba8b184e01e97994980009f6b3c\n] \n\n[simplify the TreeMonad configuration\nBen Franksen **20211028103536\n Ignore-this: e894c70a8f44a830686ac6371371fc33108e4fea78fc15bb274f7a9768b8d8c625596ac0c75cfc79\n \n This remove the hashItem configuration procedure for TreeMonad. Instead,\n dumpItem is now supposed to also update the item's hash and expand stubs.\n This reduces repeated recursive tree traversals and avoids partial\n functions. Furthermore, dumpItem now runs in the base monad.\n] \n\n[fix docs for Darcs.Util.Tree.Monad.flushItem\nBen Franksen **20220807111041\n Ignore-this: 45320aff94aecb2d9112a0f27ce8ce79e914e9e8574ad22d72c67359bb3905ef1adf0dcbb682a918\n] \n\n[clarify how TreeMonad gets parameterized\nBen Franksen **20211028073024\n Ignore-this: d93b7da869d97906b2f818410baaa7419901456e05f57f85e73ff6c682f6c7835eaf7adb740d8349\n \n This adds two type synonyms HashItem and DumpItem, renames the corresponding\n members of TreeEnv, and improves the module documentation.\n] \n\n[avoid asking the last question when nothing was selected\nBen Franksen **20230221182450\n Ignore-this: 797e4f6c796da3adef1e077a4f46dc50ff24986b7d1358f8d4a47bf93ba736e58f1f4ec016989045\n] \n\n[properly format docs for instance Conflict (Named p)\nBen Franksen **20230101082758\n Ignore-this: d87a9eedf495bb3b6b83a1230c647cf6f93394c164688cbf81ce0e240599d39f8eea92f52a516df7\n] \n\n[add docs to HashedDir data type\nBen Franksen **20221207234134\n Ignore-this: 5245ae42fdeb4ad2b47184b8c919a3bcd18fa9508073d4f571ac4ebc2d538a19f001b6dc01b5e65d\n] \n\n[pull command: repodirs -> repourls\nBen Franksen **20221207234103\n Ignore-this: 86e044be0ccb2eeb0b5e2fd6efc3e604881386c76db89a0f49754a8b560b4558fb2ba78d5c16d16b\n] \n\n[fix wording of dry-run message (changes -> patches)\nBen Franksen **20221128205234\n Ignore-this: fdd9312c5cc1bb9885bee946f47354356813ce8856692ec548473f07deb05bd2a90880b5bb9c2849\n] \n\n[re-export some items from Darcs.Patch.PatchInfoAnd in Darcs.Patch\nBen Franksen **20221127113911\n Ignore-this: 1ecfc02b41b02e94d6a849aad88829d84e2571b51331e90be458a8fc7f7b2b75195eb6fd9e9025f5\n] \n\n[haddocks for maybeIdentifyRepository\nBen Franksen **20221127033516\n Ignore-this: 467d5f70983795168998c1212f3b98b7b1993e114c620048984ed7c1950d4e1541ed08ffd36964ac\n] \n\n[fix error messages in tryTokReplace and forceTokReplace\nBen Franksen **20220807154044\n Ignore-this: 70ebb5edb13def06e8ba71d0cd7b525838bac0c327e470b4a6debe878b226b03f403259b23b2cc4c\n] \n\n[Darcs.Util.Printer: document userchunk\nBen Franksen **20220807123441\n Ignore-this: 4fafc437733c254e8a17534319a559c5ad9a012da1ce8bed09b2343aebd886bb5504851524fc83ec\n] \n\n[record: fix placement of a debug messages\nBen Franksen **20220719073751\n Ignore-this: 2e566ad6f8ef0357715dca6ac9b814fd1a63ee2ce079fae95063c9d53f2b3256f91741c53e9144df\n] \n\n[document 'mangleOrFail' in Darcs.Patch.Conflict\nBen Franksen **20220718081713\n Ignore-this: 19c4bc70323a8f871e6c8a255e0bcfc6e2b2af71c933b504f580a6b0f916bd9b667eb2bb4d6aefa9\n] \n\n[add todo item to rebase unsuspend\nBen Franksen **20220701095939\n Ignore-this: 770a42cfca29f4d1bfd99c16b6ef35e20f83706dfd3c6a309af7c0376dea1bb069115d630562ca6a\n] \n\n[document parameters of a tricky function in D.P.Named\nBen Franksen **20220623214007\n Ignore-this: c874da296e9412ff4e9a853bed9c3d313b9b69b1514a0541b9afc855449de9a976d98da00b7e0d4e\n] \n\n[update README.md\nBen Franksen **20220613210705\n Ignore-this: 596eaf9be3d8cc749bff56f718a8bd03e6a9a9e4f4806ea21c40a28da31756e6bae33d7a8b231843\n] \n\n[fix outdated doc comment for type TreeMonad\nBen Franksen **20210919072202\n Ignore-this: 63f7259e88b8b47c9446d2f65fdc3cd67ce169374ad7f0a5dffaf715c7d56d94555861fe5133670\n] \n\n[remove unused function dropInverses\nBen Franksen **20220620094402\n Ignore-this: 1044f9cc1dca30f2f41ab73e295b33618b67d1fd10df6583c441537728ee5e1c636456954806471\n] \n\n[add haddocks for +<+ and +>+\nBen Franksen **20211116170907\n Ignore-this: 44a0e9a7676ef824647be26edbf5e5de56c1582d9968274d4e878e511f03f5bd82edc824d81598ad\n] \n\n[minor fix in docs for :\\/: and :\\/:\nBen Franksen **20211116170847\n Ignore-this: e4fba94eab34b052cfcad54e9343120345ce124a2fef874d9ff79a298951fd9171176e4827c84b74\n] \n\n[simplify Darcs.Util.ByteString.unlinesPS\nBen Franksen **20211114112913\n Ignore-this: c735f534cb86a6363f9148799eacace66440f6fffad7dd83c7b17bcde416016e16731f0bc4ac91a\n] \n\n[remove an obsolete TODO comment\nBen Franksen **20211028173622\n Ignore-this: 63df0a0f851d0ad894653f4a332220397e65928ac51b488da4594a1899898da14baaae56e5a6db9b\n] \n\n[D.R.ApplyPatches: ap2fp -> realPath\nBen Franksen **20211028055506\n Ignore-this: 16b1604a3a73c3d929fc65a172a8993957193cdcaf49135f3faab4f181756f5791dfb9a96ab2efd8\n] \n\n[harness: minor cleanups in D.T.P.FileUUIDModel\nBen Franksen **20210920161746\n Ignore-this: 13402d9a0b3a98c772d9ac1554b9c0406299c9087cf307e08713a0dc5e7c89ecf82dfa352a3d9238\n] \n\n[harness: remove unneeded export or even definition of nullRepo\nBen Franksen **20210920161612\n Ignore-this: 68b1305f3956b683b35dc7e4b895a9f61c82577e75aa5db38f47506b353c805ba0441986c1b27809\n] \n\n[call error if we encounter an empty hunk in checkPatch\nBen Franksen **20210920153235\n Ignore-this: 574546245d28de40566a94625f370b43e4e67efe4415e1c2fcc080687ac37b4a81dddbd1722d84af\n] \n\n[fix some outdated haddocks in D.T.P.Check\nBen Franksen **20210920153115\n Ignore-this: 613930d45bbe9f39e6447de7817df19b6643c4f84e748993a69cb790620df858b6857a7c5579fa9b\n] \n\n[fix haddocks for matchFirstPatchset\nBen Franksen **20210923072728\n Ignore-this: d5186bdd901317625cbfece23ab8283712311dc2d2b371ac63d2551a34332fc323e9f51415e9ffdc\n] \n\n[layout cleanup in instance Gap FreeLeft/FreeRight\nBen Franksen **20210919071955\n Ignore-this: 8412d52bd66ca44f685bb31b9061e24e17a8326404fa1f26f0b015cd403cdd369edb236ca5952553\n] \n\n[rename toFL -> freeLeftToFL\nBen Franksen **20210918065852\n Ignore-this: 927245824855c8e895953a6fd84d53081ae24d3162a466499841b07b8943b0bdff21c7badf16c128\n] \n\n[remove unused snocRLSealed\nBen Franksen **20210917142740\n Ignore-this: e690e55a5fac39aec515e45481ddf779c8e53526fddca90e227dd974e5139dc962a6798ac93f89c1\n] \n\n[Darcs.Patch.PatchInfoAnd: add a missing space\nBen Franksen **20210718141825\n Ignore-this: 5eb8f9fa1365cc667c4daa6154028c030874afdaa2c1afe27961c11a436c7a001d72096f6e07f03c\n] \n\n[Darcs.Patch.Matcher: remove use of conscientiously\nBen Franksen **20210623113047\n Ignore-this: 11dccee3b7a1c7523715c85256f2343a056cdebe5e97b3393b2f3240fe1c5bc4684222f7075ed6ad\n \n Also no longer export it as all other uses are inside the defining module.\n] \n\n[fix wrongly named variables in readTaggedInventory\nBen Franksen **20210327071230\n Ignore-this: aef6c014b1c461098ad14bf3862c833a539bff251a34a0b51cb567cc8638de1051653b6baa258ebe\n] \n\n[rename readPatchesUsingSpecificInventory to readPatchesFromInventoryFile\nBen Franksen **20210625070509\n Ignore-this: 489b0cfe3dadd60f16914e22a805eda49ef553e6fc44fea06f826902af2d4a80c91cfd3b2560f887\n] \n\n[fix whitespace in haddocks for tentativelyMergePatches_\nBen Franksen **20210705000303\n Ignore-this: ed3ebf59a645fec61fd780c8da246c9fccb59f82e51bf197e16ce31abc5e99f5ed8111e86e4ee6af\n] \n\n[simplify definition of Darcs.Util.Tree.filter\nBen Franksen **20210421114806\n Ignore-this: 8275c52f3642fe947e6e3140bdf818e7742f2c290e05abc0730c63b3389461a05dc01c5aeb2616d9\n] \n\n[improve doc comment for D.U.Path.parents\nBen Franksen **20210610114804\n Ignore-this: 224d8265f15847261f6abd1d74ce0a30d8bd811d696a95da9fc6e4005efe8f6b142927c98507ba7c\n] \n\n[fix haddocks for hopefullyM\nBen Franksen **20220618195716\n Ignore-this: a2ae9a277f618b015709cf3fc126802afba09b52545588d43f8c5004a57fbcb94a10fff8206098f0\n] \n\n[send command: use question mark operator for options\nBen Franksen **20230216102119\n Ignore-this: 81df30cde7f019e6cdacf46774041e4027725367b4f6ed2b7ef16461a93fc850b8fc25cd9a661aab\n] \n\n[resolve issue2697: amend --unrecord should move unrecorded changes to pending\nBen Franksen **20230220192754\n Ignore-this: d14d4aed2e0051598be707007417878881529ec0fcf382f6725a61a696eeabab8b4e5ebd365bf2a3\n] \n\n[remove redundant -A tester options in two test scripts\nBen Franksen **20221218225550\n Ignore-this: d72df80eb85740907be66785607f5c43b10f012da9c37c629ecb309f3f8009a144b54829095a7d67\n] \n\n[test one thing more in tests/issue154_pull_dir_not_empty.sh\nBen Franksen **20221206202319\n Ignore-this: 79ab323d2cb82e3f59481da92b79602c14badc5b38e650fc266a5bc1320017c7c76701e1f62a97d9\n] \n\n[two minor test script fixes\nBen Franksen **20221206201709\n Ignore-this: 58596212c9898e24b0008207060ffdfd9ce081e1780bd2ea6344d0d6b332a505eea4edcff82a0335\n] \n\n[make test scripts more robust against additional stderr output\nBen Franksen **20220828144953\n Ignore-this: f220516ae85f7efc51182ac46cbdb9253f282f0ab43f4f4f75c15121ca50ae8be9aed9b2b591d40d\n \n This came up when I played with progress reporting and noticed that a\n harmless change there led to test failures. In several test scripts we had\n unnecessary redirections from stderr to stdout, which can simply be removed.\n In other cases we need to be more specific about what is not supposed to be\n in the stderr output instead of requiring it to be empty.\n] \n\n[fix in tests/lib: disable tracing inside the 'not' function\nBen Franksen **20220828104118\n Ignore-this: b519c04c015ff0e09e467af26392c0170b72ae937fb881d44e5b212e6a55a18f6eb61fb552a1ac33\n \n Otherwise things like 'not darcs add foo 2>err' will have the tracing of the\n 'darcs add foo' command in err, but we only want the stderr output of the\n darcs command itself.\n] \n\n[fix in tests/look_for_moves.sh: don't include stderr in expected output\nBen Franksen **20220827160126\n Ignore-this: 50d3c6f38bc71892d49ffd34aa48c1ea7bf0ac8cc9f18b39112f8d8ad1e1e4920281706d50c00037\n] \n\n[simplifications and fixes in two test scripts\nBen Franksen **20220719154207\n Ignore-this: 49beaf862e249e1b185061691633aa47ce90ce1c1a16f82b219c9a3bfabd80bb79cb311803e1a9cc\n] \n\n[fix tests/failing-record-scaling.sh\nBen Franksen **20220707064142\n Ignore-this: ab40493f18c2df31c594aa384ab0db0fe9c12ef766876a4b2bbafecd37c465e0e220cf58eeaebab1\n \n The GHC runtime nowadays only uses openat. Note however that the test is\n bogus as written, see the comment I added.\n] \n\n[tests/apply.sh: remove misleading header comment\nBen Franksen **20220623200405\n Ignore-this: 534ef627e01c7a1815a3af60cf20d05fa5e57db882753e3a1c3099e6969ce3962d149168a4f4869a\n] \n\n[modernize tests/replace.sh\nBen Franksen **20210918205427\n Ignore-this: 582cf8bd4789832296f28c8f28bb870bc27d01c060144078afeffd5764b651f573d37534de19b34f\n] \n\n[tests/resolve-conflicts-explicitly.sh: add missing shebang line\nBen Franksen **20210713101134\n Ignore-this: ede4838de073434238bfd942504d8d1d733fa7042b46db8ebfa100d4b27a533f02b19d117ffd0542\n] \n\n[allow test for issue2090 to be run manually\nBen Franksen **20201110110536\n Ignore-this: 3caac8a21a9d760c76216506ef5fa369b29789452ccbcd34b0cdbd4689752029330c66836d4fc0b2\n \n The previous regex accidentally matched unrelated lines in the debug output\n due to \"transfer-mode\" appearing the (absolute) repo path.\n] \n\n[add another (de)coalescing test\nBen Franksen **20220807191709\n Ignore-this: 89baba08d196ecf644c8168837ef8b5be2e54db4ca4ce003ecb09466cc2bbff208c93026264a07b6\n] \n\n[use Maybe2 in the result type of coalesce\nBen Franksen **20220724121505\n Ignore-this: 83a1cf26e63795cb1f4aeef02d2a1fd46a7dcaf8100aa988f4b97b1da29eebcbd458aa2f2019b374\n] \n\n[drastically simplify updatePending, remove decoalescing\nBen Franksen **20220723202303\n Ignore-this: e3faadf7d942d8467138308bcaa3022eabd3c62973d2ff096f0df30e6b04528f36640420177999a4\n \n This replaces the previous algorithm to subtract recorded changes from\n pending with a much simpler one that achieves the same results. The whole\n decoalescing functionality is no longer needed and has been removed.\n] \n\n[explain optimization case in updatePending and add a test for it\nBen Franksen **20220721080329\n Ignore-this: 9b5882b5a237364c3410fdfd40cf2608cb490b187765dbbdc0ef91d8f4feba9ebdf63845a3e6dc93\n] \n\n[simplify and inline tentativelyRemoveFromPending\nBen Franksen **20220724091821\n Ignore-this: c53682914da72fa45477b532fb4d80e3ac53d2eef69921ac330e881b9c710954af8bfbd1cd55de32\n \n The only place where we used this function is when we automatically updated\n pending after adding a patch to the repository with UpdatePending set to\n YesUpdatePending. The complicated updatePending procedure is not needed in\n this case, since we don't use it for record and amend, so we can simply\n prepend the inverse of the effect of the added patch, similar to what we do\n when removing a patch from the repo.\n] \n\n[cleanup prim sifting as proposed in a TODO comment\nBen Franksen **20220712083546\n Ignore-this: 784dfeb19ac5d72d09b258ac6478f6b9bf89e26d7c973f34fe2222def8f686c735e7dd6c87ed3c70\n \n This adds primIsSiftable as a method to class PrimSift, turns siftForPending\n into a generic function and moves it back to Darcs.Repository.Pending. The\n Prim.V1 instance is now trivial and moved to Darcs.Patch.Prim.V1.Core,\n eliminating module Darcs.Patch.Prim.V1.Sift.\n] \n\n[fix a corner case when we remove recorded changes from pending\nBen Franksen **20220720193133\n Ignore-this: 8185fdfac3a022c2ac66b32c2f8f1ea38ce7a849a0cc0cbf5ff024c8c407b82baa720230870d33b4\n \n We previously cancelled residual changes in pending with inverse changes\n detected from the working tree. This is wrong, as it can e.g. negate an\n explicit 'darcs add' by the user as a side effect of recording some\n unrelated change. See the test script for an example scenario.\n] \n\n[move header comment from D.P.Prim.V1.Coalesce to D.P.Prim.Coalesce\nBen Franksen **20220821101818\n Ignore-this: dec47b89f130efe725345e7904eeb2db2449a6e32d8e35a7fb4168a95259b8e8cbc72af862b70f6f\n] \n\n[cleanup: disentangle PrimCoalesce\nBen Franksen **20220712064206\n Ignore-this: 3919d3d15457c21b333f491c08adbf3fe05eafece0595665c951e54f2e069ee2cd4e01ca9d49e2db\n \n This adds isIdentity and comparePrims as methods to class PrimCoalesce,\n turns method coalesce into a generic function, and moves all the generic\n functionality that does not depend on Prim.V1 to the new module\n Darcs.Patch.Prim.Coalesce. Default implementations for sortCoalesceFL and\n tryToShrink are provided, too, and Commute, Eq2, and Invert are now super\n class constraints for PrimCoalesce.\n] \n\n[remove lots of redundant constraints\nBen Franksen **20211026075024\n Ignore-this: 5559ac9cc1176b180922c69b8c996202197e559a1923368af317635bf8fe31d1f27d17f6c556863f\n] \n\n[further extend test for issue2072-coalesce-move\nBen Franksen **20220723170328\n Ignore-this: 6f441c31317f77d192375baf9d5ca21da06371b99c4589b2d60d9281675543d69ed58824f8fd183f\n \n It adds a similar test case where we record only one of the coalesced\n changes and check that the pending part of other half is unmodified.\n] \n\n[fix: replace sortCoalesceFL with canonizeFL in unrecordedChanges\nBen Franksen **20220721081908\n Ignore-this: c5ea95294ed491c9dc1dbeace903f5cd6bdf858473039bb3c1743e1d86a3e6c48c6e9c6d4a4fbae6\n \n If we only coalesce, then a hunk in pending together with some change\n detected via the working tree may result in a non-canonical hunk, which we\n don't want to present to the user for e.g. whatsnew. For record and amend we\n have to make this change in the command implementation, since they do not\n use unrecordedChanges. For completeness, I also made the same change in the\n implementation of convert import: even though the hunks originally come from\n a treeDiff, we cannot be sure that coalescing won't produce non-canonical\n hunks.\n] \n\n[yet another test for decoalescing\nBen Franksen **20220721072008\n Ignore-this: 7a2448acbbffce073c997244f5a489b7784da566f5a6c5bdc3e360bf56ec92c3d1583c6b958bc4f5\n] \n\n[add two more test cases to tests/decoalesce-move.sh\nBen Franksen **20220719152512\n Ignore-this: 81b8c44e63d436f4141d34a74e01c10a4497a076dc86ac2681de201c4847d789d0fe5b19bbe0237e\n] \n\n[extend tests/issue2072-coalesce-move.sh\nBen Franksen **20220719154559\n Ignore-this: 9e6c8a280edd33c35ed450e145fbe34fc6e45f5a1b66ffd8452ac8bf1cdaae54148d85accd99e039\n] \n\n[refactor ApplyMonad methods\nBen Franksen **20211116164009\n Ignore-this: f0633cb392bc66d85d8b7434ff2bb65069c7ce680fe49054c47d6929093b357f19df598f335705c2\n \n The main goal was to get rid of the overly complicated way in which the (now\n removed) methods liftApply, nestedApply, and getApplyState were used in\n Darcs.Patch.Viewing.showContextSeries. These methods are replaced by a\n single method readFilePS that directly reads a file's content from the\n state. To achieve a uniform interface for all possible ApplyStates, we\n abstract over the concrete type that is used to look up a file object from\n an ApplyState, using the type function ObjectIdOf; for Tree this is\n AnchoredPath, while for ObjectMap it is UUID. We also need to generalize\n formatFileName to a method formatObjectId to be used when displaying a patch\n with context lines.\n \n Please note that this changes the behavior of showContextPatch which is now\n supposed to apply the patch in the ApplyMonad given by the context. This is\n unproblematic for now, as all calls to showContextPatch are wrapped in a\n call to virtualTreeIO.\n] \n\n[add module docs to Darcs.Patch.Named\nBen Franksen **20220622140408\n Ignore-this: dd216dfae97bab7df87a090f57f8143134de4e0382094f400c8857ee3e645ac7a0f0772c320d39ea\n] \n\n[test for issue1325 no longer fails\nBen Franksen **20230217030419\n Ignore-this: 4494680a75a0184641763551ababfda4afaac8e459b1228c49bf1245d8de9891de42bfceb80258c5\n \n Apparently this was fixed by\n \n patch 4caf10dd7d378f34d9249518dd02158f6a78346b\n Author: Ben Franksen \n Date: Sat Aug 3 01:38:01 CEST 2019\n * refactor and extend tryToShrink and sortCoalesceFL\n] \n\n[add SeveralTag constructor to DarcsFlag for consistency\nBen Franksen **20230218183345\n Ignore-this: 47294d5af02b6ddc2a464c95cc37c3a3defb754d6f90fd4f6783265435a62b0d00dbeb2f26db1adf\n] \n\n[remove unused constructor TagName of DarcsFlag\nBen Franksen **20230218184217\n Ignore-this: 82c12851052c84f5d161b20e7d0b4767ce584840c4195d1a603e196672cd66b45e868b85db4ea176\n] \n\n[convert export: marks file String -> AbsolutePath\nBen Franksen **20230218081951\n Ignore-this: 56c958cd97ef7aa9fbd6f4cf800b224556b34634815a5f8ccb5cffc18febd4b06fb8229c35d50409\n \n This allows the use of relative paths on the command line when specifying\n --read-marks or --write-marks.\n] \n\n[allow cloning to a remote ssh target using ssh:// URI and/or trailing slashes\nGian Piero Carrubba **20230207173407\n Ignore-this: dbf4f831ad62f26f24db4437878aa6d908106f4ea2a6d8e071fe0ca00fd51eca44ef06875b05119d\n] \n\n[t/clone.sh: add some basic clone tests\nGian Piero Carrubba **20230207171715\n Ignore-this: d3d8c73e4f648efb8fe81e8677bc6a7a60d68e818a808f2ebe81ce9cb55bf19b43ff8d097c55386b\n] \n\n[t/network/ssh.sh: clone to a remote target using ssh:// URI and trailing slash\nGian Piero Carrubba **20230207171545\n Ignore-this: 4d54611e27e675cde18beb4afede50dfb207c076dfe111409cbfeebba4f1a0537a9911654fd89c52\n] \n\n[t/network/httplib: allow running the http tests as unprivileged user\nGian Piero Carrubba **20221219203956\n Ignore-this: f097da916442e4c7dc5662dd043817765303ff3114f048baecc20a5fc8860301b4ab0c6488d5d3ff\n when lighttpd is installed in (/usr)/sbin\n] \n\n[./t/network/sshlib: allow running the ssh tests\nGian Piero Carrubba **20221219113358\n Ignore-this: 674848f16546d98a5680d8b7dbd33b64f0308578b097b80aaf9263b559b7fc4af9655cce8c9382c6\n when CanonicalizeHostname is set in user's ssh configuration\n] \n\n[tests: support systems where bash is not installed in /bin (e.g.: BSDs)\nGian Piero Carrubba **20221219112641\n Ignore-this: 52807f7122318fa1b74999719e59612e012d9061a98881ec20a2e613d625a4e457e09ea6f50b2c7b\n] \n\n[tests: the canonical path for env is /usr/bin/env\nGian Piero Carrubba **20221219112546\n Ignore-this: 715ecfc7befdf253699587ab6dac6b6cabb676be034fce0c262e8510bc85d0979c512f02222086a6\n] \n\n[t/network/ssh.sh: don't require the default user shell\nGian Piero Carrubba **20221219105435\n Ignore-this: 7775ece8dd1fc3bd7a57690ef1e5da83b7e377721976dbf893fa36edc865d0669ca3fe6b7cff9282\n to be POSIX/bourne-compatible\n] \n\n[do not use a pager when $DARCS_PAGER // $PAGER is set to the empty string\nGian Piero Carrubba **20221216103807\n Ignore-this: cc5e7cce986b64620d0bfd30ab2e339a5ffefcdb74046f3d6e18335ec759480c3a96d45277975f7c\n] \n\n[clean up getRecordedUpToMatch and the commands that use it\nBen Franksen **20210306120104\n Ignore-this: 98887f4d9c62a71ae04795aa300e557c88dae8a66095c5f5d3bd50844da585fecca1f582e1b527\n \n The procedure now returns a tree and has been renamed to\n getPristineUpToMatch. The commands that use it (dist, show files, show\n contents) now work directly with the resulting tree, rather than a freshly\n created temporary working directory. This is a lot simpler and more\n efficient. Incidentally, it allows to easily support match options for\n --zip.\n \n However, the predist command expects to be run inside a working tree. So we\n write out the tree to a temporary directory before the predist and read it\n back in afterwards. The extra cost of this is payed only if a predist\n command has been set (using setpref predist).\n] \n\n[optimize cache: remove traversal of darcs repos and clean the cache properly\nBen Franksen **20221125214356\n Ignore-this: ba433045f5ba36917e3f9cbbb3983c5af1d427fa3c4fbb55d8afff53e938c5cd8f53d618164c8183\n \n Previously you could pass repositories as arguments (and if you didn't, it\n would search your whole HOME for darcs repos) and then it would do the\n equivalent of `darcs clean` on them, too. This functionality is is out of\n scope for darcs and can be emulated with a simple shell command e.g.\n \n > find -type d -name _darcs -execdir darcs optimize clean \\;\n \n What remains is to clean the global cache. There is a much better solution\n for this and it is already implemented in Darcs.Util.Cache.cleanCaches:\n simply remove all files in the cache that have a hard-link count < 2. This\n is what the command now does (for all three types of hashed dirs).\n] \n\n[use System.Directory.withCurrentDirectory instead of Darcs.Util.File.\nBen Franksen **20220627171805\n Ignore-this: 84dd7202138c4f2b0589e68d8267a1f62f05f5cb2acf88e437d64710c6aa9f222c32e7deb026433\n \n This does not catch exceptions and has no special treatment of \"\". Catching\n expceptions such as \"does not exist\" in such a generic way is bad, so this\n is not just simpler but also more informative to the end user. The special\n treatment of \"\" seems to be no longer needed.\n] \n\n[optimize (un)compress: also handle pristine\nBen Franksen **20221124225443\n Ignore-this: 481fca72bc838c275a91e86c9e3fb53cb5cf166ae8a19d668b20bc95ce9e0945354165bf9936b6c6\n] \n\n[optimize reorder: add --deep/--shallow option\nBen Franksen **20210625173600\n Ignore-this: f619263e7027065595caa48e8ebe0d6d2567f593f75cd6a93f379daeda88abe63003fcfe8e03e586\n \n With --shallow (the default) the behavior is as before: we make the latest\n tag clean and create a Tagged section for it (which will become an inventory\n when saved to disk). Note that this may make the latest clean tag dirty. It\n may also increase the size of the head inventory and therefore fail to be an\n optimization, since the latest tag may cover less patches than an earlier\n clean tag.\n \n With --deep, we traverse all patches in order, trying to make every tag\n clean as long as that doesn't make any previous clean tag dirty, and create\n Tagged sections (and thus inventories) for all of them. Since this never\n makes a clean tag dirty, the size of the head inventory is guaranteed to be\n smaller or equal to the original one. This operation is idempotent.\n] \n\n[ci: update the available runners (OS versions)\nBen Franksen **20221122084545\n Ignore-this: 29af552bca9e40168af2667ae86f1a577d2e183ce5a2bd4da97aaeebd423fa47760bce5e6114b54c\n \n As before, all but the latest versions are commented out.\n] \n\n[improve error reporting when remote _darcs/format doesn't exist\nBen Franksen **20221122181725\n Ignore-this: 1d07a2066640c00ad7494ebb6a9300eb08edef82505379d8493f3c45ba75af2d8188ec8a75f80326\n \n The subtlety here is that if we cannot fetch _darcs/format, we then try to\n fetch _darcs/inventory, and if that succeeds we conclude that we have a\n darcs-1 repo. However, if that fails, too, then we reported the exception\n for _darcs/inventory and not the one for _darcs/format, which is completely\n useless to find out what the problem is, unless the repo you want to access\n is actually an ancient darcs-1 repo with no format file. So instead, we now\n report both exceptions.\n] \n\n[tests/network/log.sh: create a read-only dir instead of using root dir\nBen Franksen **20221122084011\n Ignore-this: 9f10c6835a44d40cf7c4171a05e61f604c9fe084f8cf1c64bf4900d4cfd98614d3751d183beb0c3d\n] \n\n[ci: reformat version matrix, improve cache hit rate\nBen Franksen **20221122074817\n Ignore-this: 8f6b72be6d7c47b9af2537a563cbeb611458471ca7c7de7c699a7647b48b35d108a19fc5a10c39da\n] \n\n[support ghc-9.4\nBen Franksen **20221121150047\n Ignore-this: eb8753641a37ae2479092dbd58c09576a49e956bd3a52ed2fb2e9ac260dc6620535b9250a006338e\n] \n\n[ci: checkout and cache actions v2 -> v3\nBen Franksen **20221119202558\n Ignore-this: a56891debbfa7476868a149cb7d419dde4fb5924e11c9651b325998c08daad5ab0e12b4b8a92d4c6\n] \n\n[bugfix for darcs repair\nBen Franksen **20221119163033\n Ignore-this: 168a46e8df947826882a310555837d0bdce4e68a5e36151f77d4f97d02b0f0e1d51291d1192f2efa\n \n This fixes a bug introduced in\n \n patch 026c01ec6881bc9421be294371b0e02c5fe5cb39\n Author: Ben Franksen \n Date: Sat Jun 18 23:36:03 CEST 2022\n * darcs repair: preserve inventory structure\n \n The problem was that darcs repair effectively failed to do any repairs.\n While the patch in question was repaired, and also the inventory directly\n referencing that patch, we failed to propagate the changed inventory hash to\n later inventories. The simple solution is to always throw away inventory\n hashes when doing repair.\n] \n\n[fix the generic instance Eq2 for FL/RL\nBen Franksen **20220617090636\n Ignore-this: 2f7a595b5649920c993d2abe018b962c4d233fd8335e366d863fc2dcca67eea6cc3dd7dd4b55ddd1\n \n This changes the semantics of =\\/= and =/\\= to compare patches one-by-one\n without reordering. New operators =\\~/= and =/~\\= are introduced for the\n coarser equivalence that ignores differences in patch ordering. These are\n only needed internally in the implementation of RepoPatchV2 and for testing.\n The functions eqFL and eqFLUnsafe are no longer needed, their uses (in the\n test suite) are replaced with =\\/= and unsafeCompare, respectively.\n \n Rationale: Treating sequences that differ only in the ordering of patches as\n equal is wrong, because the order of patches in Darcs *is* observable;\n indeed it must be observable, else 'commute' could be replaced with 'id' and\n all patch properties become vacuously true.\n] \n\n[fix Eq2 instances for Named and PatchInfoAnd\nBen Franksen **20220616142644\n Ignore-this: 82f978b49702855b5dcf0a2cc6a685f069e7ca350a98ab2729382c31a156def133cb457a6d3ebd02\n \n It is tempting to define the Eq2 instances for Named and PatchInfoAnd by\n reducing them to nominal equality (for efficiency and simplicity) because\n the types of =\\/= and =/\\= suggest that we can assume coinciding start or\n end states, which in turn allows us to conclude that equality must hold.\n (Never mind that the code didn't even define =\\/= but rather unsafeCompare;\n it makes no difference in practice.)\n \n This is problematic for two reasons. First, the default implementation of\n unsafeCoerce in terms of =/\\= indicates that implementations should /not/\n rely on assumptions about context. Indeed, doing so for named patches\n reduces unsafeCompare to general nominal equality regardless of context,\n which is a much weaker concept than intended. Second, even if we disregard\n unsafeCompare as not meaningful in general, defining Eq2 in this way makes\n the laws governing the relation between semantic and nominal equality\n trivial i.e. true by definition, which in turn makes it pointless to test\n them.\n \n For PatchInfoAnd, this change means that testing for equality becomes\n partial: it is defined only if both sides have hashes, or else if both sides\n have Available patch content; otherwise it is undefined and we call error.\n] \n\n[reformat code for instances Eq2 FL/RL\nBen Franksen **20210827081317\n Ignore-this: 159ec4a03f08d4159fad05db953ed419a58b58aa3ba9e5c250459ca5e523eeea94434e2ce6e59f48\n] \n\n[re-format export list of Darcs.Patch.Permutations\nBen Franksen **20220619100205\n Ignore-this: 5cf51d49358499b4240ae3b3d02935536e8f57de2f68ddba44b8f12951add312fcb0a1aa86e7b1b2\n] \n\n[get rid of class IdEq2 by defining PatchId for sequences as Sets\nBen Franksen **20220619094531\n Ignore-this: 75b27906fcfee80cfb6f77b8503729cb35846744f327227a7527379651468cd8c685cf9cf06dd826\n \n The former class methods are now regular overloaded operators. This patch\n also simplifies and clarifies the laws associated with Ident and related\n classes. The main point is that nominal equality is supposed to coincide\n with the equivalence relation that identifies patch sequences up to\n commutation. For sequences (:>, FL, RL, PatchSet) this is precisely captured\n by using the set of patch names as the identity.\n] \n\n[darcs repair: preserve inventory structure\nBen Franksen **20220618213603\n Ignore-this: dc286b7f50fd5f02758f40c3e4b195e84c25dcf02fbaaf991ec0e818a945fac8cced0677da4ccc70\n \n Previously we stored the repaired PatchSet as a single large inventory. This\n would completely destroy the breaking up of a repository into inventories.\n We now repair each Tagged section separately and rebuild it afterwards. The\n WPatchInfo and its supporting functions from PatchInfoAnd are no longer used\n and therefore deleted.\n] \n\n[Darcs.Patch.PatchInfoAnd: cleanup imports\nBen Franksen **20210718141459\n Ignore-this: 709da933370b5a13b0aaefe6e23dff19a0440bb9c8049319340717f7361e35de859f7eb5b362ecb5\n] \n\n[return the pristine differences from replayRepository', too\nBen Franksen **20211005102102\n Ignore-this: 53b73670bd51d5635c782b5935eeaeaa341e426358e10bf47d529e0aad2144ec718090d3be98fe67\n \n This means we can eliminate the extra procedure brokenPristine from the\n command implementation. This removes the catchall when we read pristine\n inside replayRepository', which is a semantic change, but I haven't observed\n any problems so far, and we have a test that checks we can remove pristine\n files that still works.\n] \n\n[clarify internal structure of replayRepository', inline checkUniqueness\nBen Franksen **20210924080815\n Ignore-this: bc8830b687d838b10b99c4aee9186036d5109df5d2c16ffa46c7a6def766413c7d015d06adb1c933\n] \n\n[fix wrong use of unlines in instance Repair (FL p)\nBen Franksen **20210924084055\n Ignore-this: 7ad7845a39bb8c079f9b510194736b02a32c3016f2090c752754aa7bb67c809925205359b41c9b70\n \n This avoids extraneous empty lines in the check/repair output.\n] \n\n[check/repair: also handle broken pending patch\nBen Franksen **20210924075401\n Ignore-this: 84148650728fe44e3f4554e9543026a6be01ad98e0cab4e3239a2db0bd95f6fe0fbc588fc96d8405\n \n This required a redesign of the interface between D.R.Repair and\n D.UI.Commands.Repair i.e. the data type RepositoryConsistency. Indeed, all\n three types of problems we detect (broken patches, broken pristine, broken\n pending) can occur independently of each other, so a record type seems more\n appropriate.\n \n With the ability to properly fix the pending patch we no longer have to use\n the crude method of \"fixing\" a broken pending (by removing it) during\n command execution. Instead, commands that try to read a broken pending now\n fail with a hint to the user to run `darcs repair`.\n] \n\n[cleanup code layout in Darcs.Patch.Repair\nBen Franksen **20210924073934\n Ignore-this: d824831fa207a333b11687253b092c65845d2c371d25481b2d2d626de13efbf43c1b3fc3efcda91e\n] \n\n[D.U.Cache: inline 'write' into writeFileUsingCache\nBen Franksen **20210530180058\n Ignore-this: d4293f5916c643818b1bd82326e1532b1d82e3eca7b61fbf42adc767ecde128f73a2f9cabda28933\n] \n\n[D.U.Cache: factor out cacheFile into a where clause\nBen Franksen **20210530083840\n Ignore-this: b51c03418765ee810efa4c534e9e879b9035fa2b84e30d154ff64fd61f94dcb8b1ae44b57ada2501\n] \n\n[Darcs.Util.Cache: replace catchNonSignal with catchall\nBen Franksen **20210623084052\n Ignore-this: 6ca33a3035fd9733d94a564c7de7e50be3744d8fd80e292d1f9c97c442ad2a52b294b24d75e8a5e3\n \n This is equivalent now that the exception is no longer used by\n checkCacheReachability.\n] \n\n[D.U.Cache: break some overlong code lines\nBen Franksen **20210530174641\n Ignore-this: 8e376bfa92254f13ec103fe4d8b1cc6504018a4d4b7e15acfc9f7797e1c144c6b2c14cc14c103046\n] \n\n[D.U.Cache: improve docs for copyFileUsingCache\nBen Franksen **20210530083923\n Ignore-this: 34f94013864d23ecacbe848fb23864b6a7dbb66242bfe55c325eff647ec14ec1645cee1fdb184bb5\n] \n\n[D.U.Cache: break an overlong comment line\nBen Franksen **20210530082750\n Ignore-this: d67397d305b96eb47622d0ac37fc262d86f462019d528ee57bbe57bfb017d3c952c77684d4d25635\n] \n\n[D.U.Cache: if -> case\nBen Franksen **20210530082718\n Ignore-this: 1186063d9c7ca5ceba5b70944ccbe795855ed7dd534560c9a750aa9d6ff7704daa0fa3832968206e\n] \n\n[fix bug in getUncovered\nBen Franksen **20220618183007\n Ignore-this: d31c744181d8bb24057fa27c949d0d3bf999320640e45d3f9f6eaa7a35667daeeeb40549a0428dfe\n \n Using hopefullyM to return an empty list of explicit dependencies for an\n unavailable tag is obviously wrong in general, that is, unless we already\n know the tag is clean and it is the last patch under consideration. The way\n we use getUncovered, this was (thankfully) not a fatal problem: at worst it\n made getUncovered return too many patch names, which can only lead to\n inefficiencies: a tag may depend on more patches than necessary,\n taggedIntersection may do more work than necessary.\n] \n\n[add/extend haddocks in D.P.Depends (includes a few minor layout changes)\nBen Franksen **20210917075809\n Ignore-this: 262f9e192b6e5782e53addb08544e62336a4f922c056e2e2612e86ce2a6b4c08da13eec552912f11\n] \n\n[refactor patchSetUnion and patchSetIntersection as folds\nBen Franksen **20210916104646\n Ignore-this: 429da1097a041689600e57e03b137370c5339aedae5d7540ad9d62a126d3d57df687d299b22f3706\n \n This includes a few simplifications: for the intersection of two PatchSets\n we take the common part of findCommon, and for the union we use appendPSFL.\n Note that the simple definition of patchSetUnion as a left fold requires\n that we optimize patchSetMerge for the case where one of the arguments is\n empty, otherwise we loose a lot of efficiency.\n] \n\n[replace mergeThem with patchSetMerge\nBen Franksen **20210916101906\n Ignore-this: 258b44043f728890aa91c880c4b5107b9cd71312652fd50ca4295d7123ba3b8500839161db4ecd82\n \n Again, since we always immediately pattern match on the result, we can as\n well match on the result of patchSetMerge directly.\n] \n\n[eliminate Darcs.Patch.Ident.merge2FL\nBen Franksen **20210916084740\n Ignore-this: 39773a714db0b9402613232af7e13bc12093a07a0d19164ccc5a49c63bbe1670142fb8e6f980d88d\n \n In Darcs.Repository.Merge we already have the precondition that the input\n sequences contain no common patches, so we can as well use 'merge' directly.\n In the implementation of Darcs.Patch.Depends.mergeThem we now use findCommon\n before applying merge to the uncommon parts. This gets us rid of yet another\n function with a confusing name.\n] \n\n[refactor findCommonAndUncommon in terms of a generalized findCommonRL\nBen Franksen **20210703071042\n Ignore-this: a947e698b6a54d7582ee81028c10e24cd5e63e462f518074a92542a1eca321ef4437b3e62c0e9bce\n] \n\n[refactor removeFromPatchSet using unwrapOneTagged\nBen Franksen **20210703054521\n Ignore-this: e6acc444a1f01746ca8006c99ce40381d4320105a67672a7e1cb5bf6c2037eed5840f8b8ce8e7899\n] \n\n[tests/network/lazy-clone.sh: weaken requirements in last test\nBen Franksen **20210916064738\n Ignore-this: e4bfe9f1362245ac443143b4dd021078ef2869e859d7702caee00d42ed307e5861b9af1e6730b46f\n \n In this test we make a lazy clone of the first tag, drop the connection to\n the upstream repo, and then expected `darcs log -v` to succeed. This used to\n work, but only in this very special case, and only because of a loss of\n laziness in the definition of Darcs.Patch.Depends.findUncommon. In general,\n a lazy clone may be missing inventories, which makes `darcs log -v` fail if\n the upstream repo is gone and we can't find the inventories in the global\n cache. We now do a `darcs log` before disconnecting upstream in order to\n guarantee that the repo has all inventories. In addition, we test that\n `darcs log -v` works with the full lazy clone, too.\n] \n\n[tests/network/lazy-clone.sh: run with or without cache\nBen Franksen **20210718151855\n Ignore-this: ef2c033e3978ea436db1c8370a8ed70e91506cf34ebaaa3705ff50224ed19d905ecd0c14ee23495e\n \n Note that with cache we have one more patch available in the last test.\n] \n\n[findCommonAndUncommon -> findCommon, inline findCommonWithThem, findUncommon\nBen Franksen **20210916082026\n Ignore-this: dd73e7164ec9528b188cbc1feab04551b5c1b83abceccd51e8b73d1763ef3be6f01e418f20e1b434\n \n Instead of specialising findCommon trvially, provide generic conversion\n functions for Forks: dropLeft, dropRight, and dropCommon. However, in most\n cases we immediately pattern match on the result anyway, so it makes more\n sense to just do that with the resulting Fork, using wildcard matches for\n the parts we are not interested in.\n] \n\n[refactor findCommonWithThem and findUncommon\nBen Franksen **20210722190829\n Ignore-this: 577f0103b71b8781b0073ca92b66a90cda8561ddb2a1378bdc63e9b58868c5285dfd76653d6019f6\n \n They are both special versions of findCommonAndUncommon.\n] \n\n[better explain how splitOnTag works\nBen Franksen **20220613221328\n Ignore-this: d8b678ecbf87721610b5fe2a79bdf3f0f2eb691c633dfb249f16a10cbe713e3c0618e39f94c98e58\n] \n\n[D.P.Depends.areUnrelatedRepos: document and inline local function checkit\nBen Franksen **20210917140637\n Ignore-this: 8908b6ac2b6b9fbd68f27773f6ad650b4462d0bc0045dba13b3e109333a0e6b8225c2503c3bbc16e\n] \n\n[D.P.Depends: optimize concatenation order in dropDepsIn\nBen Franksen **20210628071420\n Ignore-this: 35a32f549f61579ff506fafc04660157852e2489de0ab9feeaa7c868456fae80dc1fa694dc050bd\n \n The most common case will be tags that are \"almost clean\", that is, the\n previous tag we encountered will have few remaining dependencies when we\n encounter the next tag. This means it is more efficient to append the new\n dependencies, rather than prepending them.\n] \n\n[D.P.Depends: clarify the meaning of functions local to getUncovered\nBen Franksen **20210628070108\n Ignore-this: 3a14c26dbb9c2c4ec9c07f29f54d89bf8db24b0783e2ab911a54379038b54b61589bae5b02bb80d2\n \n We make it clear that they are really graph algorithms, generalizing\n PatchInfo to any type supporting decidable equality; see the comments for\n details. This also removes the Maybe layer for the list of outpoing edges\n (dependencies) associated with a vertex (patch): a non-tag vertex or a tag\n vertex for which we don't have the patch content gets an empty list of\n dependencies.\n] \n\n[simplify taggedIntersection\nBen Franksen **20210626142821\n Ignore-this: 69d20aa8a8460325fd9dbd8ebc596d15b5c3b988c36e9ed8ae8cb1464d298a9c5cb5b10c33bfde36\n \n This is not a pure refactor: it eliminates one of the branches of the\n original code, namely the one where we used hopefullyM to decide whether the\n content of the tag on the RHS is available. If it was, we did not try to\n reorder patches locally to create a Tagged section for that tag but rather\n gave up on that tag and recursively tried the next Tagged section of the\n RHS. This simply makes no sense and I therefore eliminated that distinction.\n This allowed a few more refactors that make the code more readable.\n] \n\n[remove commuteToPostfix, commuteWhatWeCanToPostfix\nBen Franksen **20220621085714\n Ignore-this: de87ead4f05b15d83e54862550834dd1857f7b45f244e0774918637f0c4c27dce8a76df6ca40cacc\n \n The first function wasn't used anywhere. The second one was badly named and\n only used in one place in the test suite. We replace it with partitionRL'.\n This patch also fixes outdated haddocks for commuteToPrefix.\n] \n\n[add partitionRL', mirroring partitionFL'\nBen Franksen **20220621091303\n Ignore-this: a98bbb43ff3710e7cb4e0969b352ba49c3e70c91c095edc43bdd22fd1f59740593d2ead6742b2c75\n \n Not used yet, but will be needed further on.\n] \n\n[whatsnew -u: print output with pager if non-interactive\nBen Franksen **20211116101543\n Ignore-this: 7b33f03a46fef5334916b3354bc1576fbd94eb77c8c6a1dd3ecc06f82dd44e9f2e34ecd0816eb6ba\n] \n\n[push: replace parseFlags with ?-operator\nBen Franksen **20210913094029\n Ignore-this: f7af4c329f1b1700d458c8776fda77c2afda6c669dd94e023abc40f926353fe8d72fac0cf4dc7755\n] \n\n[replace: allow only printable ASCII characters in the token spec\nBen Franksen **20210918090705\n Ignore-this: a5b4c116bb10a295f71ef30436d4f39d11bf6899ad5674f6974cae18a5a52cd0d4cad6fcbd71634a\n \n This enforces a limitation that was previously not checked and could lead to\n corrupt patches.\n] \n\n[inline some trivial functions in D.UI.Cs.Unrecord\nBen Franksen **20210722184836\n Ignore-this: a0244520f7578c822cd5e111d239f3162085a77eb83f4b42c15885f11649c05f1ae759d30b3fcbf0\n] \n\n[re-format Darcs.UI.Commands.Send.sendBundle\nBen Franksen **20210622124351\n Ignore-this: 79c6f632f24e800db99da9941a05ac7395c1134fa12832eeab0b11bfbc3c5b81ea7033e6d771fe1\n] \n\n[rename PatchTree to PatchSeq\nBen Franksen **20210619072740\n Ignore-this: d85d8ed86763a82296fd2d1e8bda8a10eadc9cc8244627179f62b1af7474a571caf5c52cb2f7b8c2\n \n This is about the PatchTree defined by the implementation of the test\n command. The renaming was done because semantically it is a sequence with\n guaranteed O(1) concatenation.\n] \n\n[remove command: fix code layout of makeRemovePatch\nBen Franksen **20210306081307\n Ignore-this: 3c304915cb90f06dadd0b983c8b6e2c1ffddb86159b396a7e542cbd32cf46e5eab3e32d76e84fade\n] \n\n[push command: simplify some type signatures\nBen Franksen **20210306155755\n Ignore-this: d33ae7076991232fb40a0f3bb39582d95bb6ef49c609bdaec14107d1e23b45571414ce90004b0a50\n] \n\n[fix TODO item in remove command\nBen Franksen **20210306083156\n Ignore-this: be3afd76238a64f34c901ad96dc98509d44042c6a90e698317d3cb9b8d4dfdc62f9ddbac796f910f\n] \n\n[remove out-commented code in D.UI.C.Repair\nBen Franksen **20210324060633\n Ignore-this: 9011bab75c4606569b79622691514c6dbee913d0b9bcd6aed72f4ccde433971a5f49ad7f9a95fdb6\n] \n\n[harness: remove the HashedStorage tests from --full\nBen Franksen **20220420175455\n Ignore-this: 513447d2d27f0e6d43f33a2a332e7b371cf3e97afcff39e8918061dddf85b0ed8b346e6fc630d5e\n \n These unit tests aren't re-entrant and thus tend to fail with -j. I venture\n that nobody runs the tests with --full without using all available cores\n because that would take ages to complete.\n] \n\n[allow rebase unsuspend when there are unrecorded changes\nBen Franksen **20210302205215\n Ignore-this: 175b38f92b2e0927b807a56cff680debb3d1856d2caba624ab8dd4b1eaced3d84772d26a3328e8b8\n \n We still fail if the effect of the unsuspended patches (including the\n resolution for any residual fixups) conflicts with unrecorded.\n] \n\n[rebase unsuspend: code layout and a few renamings\nBen Franksen **20210302185613\n Ignore-this: 7301a87235935506314c35baedd42387e7cd1abc298a1c61631b3fdc72dfadd2b3367c44a16bd7cc\n] \n\n[refactor rebase unsuspend\nBen Franksen **20210302184810\n Ignore-this: f0d1722fd9abbf0da5cf527271a71d52189c329cf127b666dd5fc0079113fb6ac9fabd02a336c49c\n \n The local function hijack that replaces the previous doAdd is more modular.\n It gets the selected suspended patches and those we want to keep as input\n and outputs a changed pair where the the patches to be unsuspended have been\n renamed. We then add these patches to the repo without updating the pending\n patch, so we can afterwards directly set pending to the resolution.\n \n For reasons that are mysterious to me, coercing just the added renames after\n commuting them no longer works; the mere act of matching the type of the\n rename patch introduces a fresh type variable for the underlying patch type.\n] \n\n[fix: add missing dry-run guards when calling applyToWorking\nBen Franksen **20210302141145\n Ignore-this: 7a1765bc2e8f8295f6d289c4489a3d3bcd399183e1c8f1ddb7e9754f1a33512af641c9332f5a8915\n \n applyToWorking is done after we finalize the transaction, indeed it isn't\n guarded by the transaction at all, since we cannot enforce mutual exclusion\n in the working tree.\n] \n\n[ci: set DARCS_CONNECTION_TIMEOUT to avoid timeouts with darcs.net\nBen Franksen **20220613094347\n Ignore-this: de89e83c3d0e6e4258ed0c7955113eb18299ef2059ff803440f34812ac3098569fd36562d65f5a85\n] \n\n[unrevert: simplify by swapping mergeThem -> findCommonAndUncommon\nBen Franksen **20210723113431\n Ignore-this: 873f5487ff4990855c1e9e1e7416e1f06a0097062aa1f7b6f80224e116782985700675c9a16b4320\n] \n\n[remove tree parameter from writeUnrevert\nBen Franksen **20210723084319\n Ignore-this: 7b78dcc3d61fa8349094fad0a55f82668a996872154e80102168b4a39517022060d6aaab63c23508\n] \n\n[trivial refactor in D.R.Unrevert for better readability\nBen Franksen **20210306060231\n Ignore-this: 33b6dab0bdf4c7833846f97e9ba629d94924df46e9456e6a714fe70323b2caf09b9bd5f38b1a374b\n] \n\n[rename unrevertPatchBundle to readUnrevert\nBen Franksen **20210325082039\n Ignore-this: 90e0bfd9e1cb4711e33a8a351fcec1f58d9b0136740ff7a1468e1057204c35c2372316d7c53074cf\n] \n\n[harness: more cleanups for the shell test implementation and setup\nBen Franksen **20220522105130\n Ignore-this: 2ee08904c306a3e136c3c4119794d80b7d839b6fc00a1f51d395d19a94a47abd8d1bbba6d7adf45a\n] \n\n[harness: split off Darcs.Test.Shell and clean up what remains\nBen Franksen **20220522074138\n Ignore-this: acdd0e4060172f7719c4b4ad78793f93c59ddd56b2ab10b555a92b54e5c460d468e8e5d2b1b334b3\n] \n\n[ci: fix order of tasks to allow caching of dist-newstyle\nBen Franksen **20220612224449\n Ignore-this: 524a9a5fd463bd781d2904f2d61f7153a49572f0a9514fff3f296f203b6be1204bd2c6a5580f789d\n] \n\n[option not to fill _darcs/prefs/* files with templates\nMaksim Golubev **20211225165428\n Ignore-this: 3f1f66995bff8ed88760c8a5b7da3ef8a3a48c262848c348a7011a6a3cdc3ee133e95ac30ac68d62\n \n With new `--no-prefs-templates` command line argument you can\n leave `_darcs/prefs/[boring|binaries]` files not filled with\n default templates when creating new repository with `initialize`,\n `clone`, `convert darcs-2`, or `convert import` commands.\n \n It is useful when you prefer to maintain corresponding settings\n globaly and use repository specific settings only for cases\n related to that particular repository.\n] \n\n[always apply `_darcs/prefs/[boring|binaries]`\nMaksim Golubev **20211220004844\n Ignore-this: 1702e7beb882e7411ad07098fb9a5c9184d672cd76201692ceaaebe6857adfb900827c4050245011\n \n Always aplly `boring` and `binaries` files from `_darcs/prefs` direcory\n even if there are explicit settings for the corresponding prefs.\n There is no reason not to use these files. If there are explicit settings\n using `darcs setpref [boring|binaries]`, these files remain the only possible\n way to set the appropriate settings personally at the repository level,\n and not globally.\n] \n\n[fix haddocks of D.R.Util.Path.makeRelativeTo\nBen Franksen **20220612221847\n Ignore-this: 23b2a181fb323cc53349dd8d657d014e3b1b914d0a673170f315317e0c187e25d914b83bee198c1c\n] \n\n[remove no longer used isMaliciousSubPath\nBen Franksen **20220612220958\n Ignore-this: 54b1e88dd27e95d48b7fe20a89f9eceaa19297e5c828d6146c25b8119efc721a4d49a97eaf4e478f\n] \n\n[tests/lib: disable use of hspwd.hs\nBen Franksen **20220513071917\n Ignore-this: aea9d0d0b9df387c88c2fde5013316ccf1e07c74e7b60ec019b72385e5b473b09c666136de2237b2\n \n With the recent changes in file path handling this is no longer needed.\n] \n\n[enable running all symlink tests on Windows\nBen Franksen **20220513072218\n Ignore-this: 746991310507bf4ccf6fa1d252149c45af682e6cb9c512a54f2551bbb020b91acd42cbb9f5d6de4e\n \n The only exception is when we use mkfifo in\n tests/issue1645-ignore-symlinks.sh which is very much specific to Posix.\n] \n\n[harness: set environment so we can test symlinks on Windows\nBen Franksen **20220513071746\n Ignore-this: 35ad96c8c20c3904124a04a874a6987073a1b4a8d1df3b005903d1262db1825b4dc5c525da9d7b1e\n \n See the URL in the comment for why this is needed.\n] \n\n[extend, generalize, and rename tests/issue1057.sh\nBen Franksen **20220509235618\n Ignore-this: 890cacc6bc914abea294577aa6e95ae44ea332d2294e4002ba0d794c5d157186f5e594da772a5903\n] \n\n[extend and generalize test for issue1078\nBen Franksen **20220505131910\n Ignore-this: 7a7b92fcb395e761a39533814bd5e029cdfc1053e799209ca92aebca4c6e04fc02f5bc8b6cbbac0c\n] \n\n[simplify tests/issue2275_follows-symlinks.sh\nBen Franksen **20220507073919\n Ignore-this: 5a6f6bb414afcbbcb1e41722a8c71fd94d00373a2ee5642823230b948a1a02533beeea137c9e0fb6\n \n The test harness nowadays can be run with index enabled and/or disabled so\n we don't need to provide for that in the test script itself.\n] \n\n[remove obsolete Darcs.Util.Path.internalMakeName\nBen Franksen **20220513104902\n Ignore-this: a71478539dc235c75d4a294c5112e212d7d1a5280d71c8112e1d94d3111c9a78b79746adaf3de8b2\n] \n\n[fix validation of paths from command line\nBen Franksen **20220513083454\n Ignore-this: ef336847facef2dfaf35212d5f78a6d2b15f02e81305125062780da03f01b5a19d905f7e8b2f2fd8\n \n The new procedure makeRelativeTo no longer reduces all occurrences of \"..\"\n if they occur in a non-existing trailing part of the input path. This means\n we could run into error calls when calling floatSubPath on SubPaths\n resulting from that. So we need to propagate these errors and catch them at\n the call sites.\n] \n\n[make errors in Darcs.Util.Path.decodeWhite explicit\nBen Franksen **20220513104155\n Ignore-this: 8a95a999317b6cf328090235b9600ef8a9ddaa25b8593f40a284dafdaf9fce7b8ccf7c571a0e665d\n \n This means we no longer trust that path names in patches have valid\n white-space encoding. Instead this is now a proper parse error.\n] \n\n[Darcs.Util.Path: add missing HasCallStack constraints\nBen Franksen **20220513104710\n Ignore-this: 4515c914e343ababdc8d5320aa7e05ffd3824a0f6c75fccd1115fc2f6098551e6b5725c48d3075b8\n] \n\n[fix all symlink problems, including Windows\nBen Franksen **20220512101051\n Ignore-this: 24a0d192cfb8018b7766f2bd430d4e01115d3beb4e8be9f997421b6d7bf3e9eb2f817e125a75925e\n] \n\n[require unix-compat >= 0.6 for improved symlink support\nBen Franksen **20220522162140\n Ignore-this: cdbc5626bc3492de57e7fcd20edfa9ff867304ee55f8ec2e4251a28df19f446851ccd8268cc240f1\n] \n\n[add two clarifying comments\nBen Franksen **20220509235442\n Ignore-this: 498c1be6329e3afb3375c18d98d5fd826359158c08b1dfd908d1e1f30892512caf3d8991b38b277d\n] \n\n[remove Darcs.Util.Compat.canonFilename\nBen Franksen **20220430082509\n Ignore-this: ddc62418584efba013ef23626128578d7c8b75cd2a798d4560c6df8953c818972645689446e056e8\n \n It's (few) uses were replaced with either makeAbsolute or canonicalizePath\n from System.Directory.\n] \n\n[Darcs.Util.ByteString: use the portable System.Directory.getFileSize\nBen Franksen **20220507162917\n Ignore-this: 5941d4646fd9ca57e59b7547d312325f392db7c4ea1047718a393e3e585a6d98aeb8e7207b6363f9\n \n Used to get file size in the error handlers for readSegment and mmapFilePS.\n I guess this is also a bug fix, since in case the file is a symbolic link we\n really want the size of the link target here, not that of the link itself.\n] \n\n[harness: use runghc for hspwd instead of compilation\nBen Franksen **20220505182645\n Ignore-this: 92c2ce174c2e860af2547624acf81c44ba4547c4d9c0ac4795c98a9d17845288fabbfea121f3ccfb\n \n This fixes occasional CI test failures that say\n \n ghc --make -o hspwd /home/runner/work/darcs-ci/darcs-ci/tests/bin/hspwd.hs\n /home/runner/work/darcs-ci/darcs-ci/tests/bin/hspwd.o.tmp:\n renameFile:renamePath:rename: does not exist (No such file or directory)\n ./hspwd\n lib: line 32: ./hspwd: No such file or directory\n] \n\n[tests/lib: make 'not' fail if command returns 4\nBen Franksen **20220513203406\n Ignore-this: 992795ab972e845f25f9c68cee09fab9b25eddb8ed83a3dbe29c86b79514febb27e61a2161028c7c\n \n This exit code is returned by darcs when the top-level handler receives an\n ErrorCall exception. This signifies a bug in darcs, so should be treated as\n failure of the test even if the script uses 'not' to indicate that darcs is\n expected to fail.\n] \n\n[derive instance Show PatchInfo\nBen Franksen **20220514174741\n Ignore-this: 5c2d644dbc4d88292782a550b04593be6e26a2c350d4545341a157deeee7ecdd7c2e4149d6928418\n \n The manually written instance turned out to be useless for debugging the\n property test failure caused by an error in arbitraryUTF8PatchInfo. Also\n note that we already export the data constructor for testing.\n] \n\n[harness: fix arbitraryUTF8PatchInfo\nBen Franksen **20220514174622\n Ignore-this: c24b28fec73dc58c20d7eedeb8ac7baf880f4fb7464b1dc4bd14b88f0b33e4b20f7c6ec0588e84c4\n \n Otherwise propMetadataEncoding may (and does) fail.\n] \n\n[refactor askAboutDepends and updatePatchHeader\nBen Franksen **20201103184646\n Ignore-this: 2b0a19d8493f0a6195954633337e4169f02ed61ac6304e690f808de5947d6aa6780ac51517a8d94f\n \n My immediate goal with this was to avoid making repository requests inside\n updatePatchHeader. Thus AskAboutDeps now contains a PatchSet instead of a\n Repository. But for the amend command the patchset we pass in is not the\n recorded patches but rather the recorded patches minus the selected patch.\n So we have to reconstruct this patchset. This is best done by not throwing\n away patches in the first place, but instead return unselected patches from\n filterNotInRemote as well as withSelectedPatchFromList. Incidentally this\n fixes a problem when we de-select the latest clean tag: before this patch\n amend would print all patches in the repo. This is now avoided by calling\n contextPatches when --not-in-remote is /not/ in effect.\n] \n\n[fix and reactivate test for issue1599\nBen Franksen **20220522114117\n Ignore-this: 8645d57a6e0a3f3943fa0477264b53b7f63e04c70816d055547c04d08b9a6ca72e2231bcd12ba1e2\n \n The test had a missing 'darcs tag' command to set up the repo, since w/o a\n tag the clone is not really lazy. Then it tested the wrong thing by relying\n on debug output which no longer gets issued. The underlying issue has indeed\n been resolved by the patch that claims so.\n] \n\n[restore functionality of DARCS_CONNECTION_TIMEOUT env var\nBen Franksen **20220522105447\n Ignore-this: b2b4bfa2f485f22fc6d6c6f238a1f28af512b691ce408cd73aae90bb1ff94b0c1730688f8054d6ed\n \n This was lost when we threw out downloading via curl. It is actually a\n response timeout now but I kept the name for compatibility.\n] \n\n[update outdated dependencies\nBen Franksen **20220531193246\n Ignore-this: 32d63f227ee432cc76a54fce8f0629bd841b86a5fccfcf8e05b7f5e64c4bb28caf25a968c29d9cbd\n] \n\n[fix or suppress warnings new in ghc-9.2\nBen Franksen **20220425141013\n Ignore-this: c5f398bde16c8032ef9c8e267a4d0cd2ca2a3d2609b0e5507c7d8a9bb2fddc96f33ba6850b58c1fe\n \n This is about -Wincomplete-record-updates and -Wincomplete-uni-patterns. I\n bothered to actually fix the code only where this wasn't too much hassle and\n suppressed the warnings elsewhere.\n] \n\n[support ghc-9.2\nBen Franksen **20220425140808\n Ignore-this: 3d1002c6d2c874adb011e6a46f2d7560ec4020397236fc1cdd721b3fc584166b27875074cbe62dd6\n] \n\n[fix: hard-linking between repo and cache should be entirely optional\nBen Franksen **20220525215234\n Ignore-this: 38a7d6c899ed53f6f4e6f33eb9ee1345381a5cb57ce4e81694cec4df45a38bdc3d3035e93ea1cd88\n \n This fixes a bug introduced in\n \n patch 018c5978374ec2cb3ae4f918d733da948bda73da\n Author: Ben Franksen \n Date: Mon Nov 9 15:47:50 CET 2020\n * improve cache utilization\n \n tryLinking catches only \"does not exist\" errors, so when hard-linking is\n optional, such as after we wrote the file to the repo, we should catch all\n exceptions. Note that tryLinking is *supposed* to throw exceptions, the\n logic in writeFileUsingCache depends on it.\n \n This came up in a situation where the repo and cache happened to be on\n different file systems, which caused most darcs commands to fail. I added a \n line to tests/lib to run the tests in such a scenario, but it depends on a\n particular system setup and is therefore commented out.\n] \n\n[document and cleanup Darcs.Util.File\nBen Franksen **20220521104856\n Ignore-this: 7f56e7ba180d1f34b063e52aaadd58857087e580017d6b443791c2beac2ec41aba751ca5d99b466a\n] \n\n[move osxCacheDir and xdgCacheDir to D.R.Prefs\nBen Franksen **20220521101952\n Ignore-this: e06aecfea9997c8371f5712efbb6f7c9d573761472ce00c98e0de4b930f545b99cdd80a351a9af0c\n] \n\n[hlint Darcs.Util.Cache\nBen Franksen **20220521192202\n Ignore-this: 210c5a7dae41c459a9880a5e3e58883da866e0a39ec9cf0a958c9da460580462e9131420ab24e412\n] \n\n[move all of Darcs.Util.External to Darcs.Util.File\nBen Franksen **20220521095228\n Ignore-this: d7362ce863ada7367a0a8a67e8b29263f4d88de75187a2bae89a47a8db842bfd628952dbff8f850e\n \n To break an import cycle this also moves withTemp and withOpenTemp\n from darcs.Util.Lock to Darcs.Util.File.\n] \n\n[remove obsolete src/hscurl.*\nBen Franksen **20220522105315\n Ignore-this: 44d5de00ad7ef34e0b9fdbeca052290b7e731c9836b171ca861beb6568c9bab6571de5a944c1f049\n] \n\n[hlint Darcs.Util.Lock\nBen Franksen **20220521192223\n Ignore-this: 7f7981bc933b26245acdd6a64f8546f67a7901c2e36517f1474c3838d81606f619063871e8cf05b3\n] \n\n[rename cloneXxx to copyXxx, remove cloneFile\nBen Franksen **20220521084938\n Ignore-this: 64e3f5e8b0f4357620a722ce96c247f8460458b67f172f6f8548ec93fd8446a5d26d45de5da5e00\n] \n\n[darcs.cabal: remove duplicate build-depends entry\nBen Franksen **20220521084359\n Ignore-this: dae9a4871ca6d2738f0fbabf0e2170e7c6b879b68335695829184fe816bf7d93a84ed86a0be5556c\n] \n\n[Darcs.Util.Path.pathToPosix: avoid mapping id on Posix\nBen Franksen **20220513104747\n Ignore-this: d9c581ba9151e39d247bb7ece6087f335da5bbacbf7329d975b6437e311548e0bbaa3719e6cb82d2\n] \n\n[remove unused Darcs.Utile.Path.breakOnDir\nBen Franksen **20220513101558\n Ignore-this: 9c126068812a15f8a2137f18c8d529e727afabcca614e26e7615abf11a1599ae460b5c22a791a427\n] \n\n[tests: some trivial cleanups\nBen Franksen **20220513071541\n Ignore-this: 98af812d10e8f72abd8f93bbb880865b24b42dbf2f168f7dd9ae3153a2b45af09770829849082517\n] \n\n[ci: use haskell/actions/setup@v2\nBen Franksen **20220513053948\n Ignore-this: 2689b247a9d69c42dcf3b465f2d2caf2514a9f4957e9ed501a5ff7c3d2c098dd6b3a95f9d25aa0b6\n] \n\n[ci: run tests with i=yn and --hide\nBen Franksen **20220513053928\n Ignore-this: 49c0a33e1d5aded4974866df9be66100a94093fd0eaac0c19ac9f607b7f20698422824efc36d175f\n] \n\n[remove obsolete use of Windows #ifdefs in Darcs.Util.File\nBen Franksen **20220509170048\n Ignore-this: b1225f38ec25c2ebe5f35a3d44198c93dbde99e2b72d70265fcb4d9938e739801ae23536808142aa\n] \n\n[enable tests/utf8-display on Windows\nBen Franksen **20220505182502\n Ignore-this: 532754ce83e354d8989518d23b9766c07c14cfa3b7a7deb820a02db1232cfe54970e343971973847\n \n The test succeeds on Windows in the CI.\n] \n\n[rollback of \"work-around to allow build with ghc >= 9.0 on Windows\"\nBen Franksen **20220505182316\n Ignore-this: aaf76aaf4a4fc8df8a6fdf9380eb2d25bff76626905d8ff2ec57b5aedf1804935ffe5970a1df765b\n \n The cabal problem was fixed upstream (in ansi-terminal-0.11.2).\n] \n\n[rollback 856baf0c aka \"Fix darcs-test on Win32 + GHC 6.12+.\"\nBen Franksen **20220501124047\n Ignore-this: 8cc3659e7fa28dbe294ba7247ea827ce56efddfda94353789abdecbc76a67b4c70a7c5c40d5cec0f\n \n This is no longer needed and improves display of paths if they contain\n non-ASCII characters.\n] \n\n[tests/latin9-input.sh: remove obsolete code\nBen Franksen **20220501131342\n Ignore-this: 8674f9fe2a703781e032f040ac1b893661f31ec1fb402637d48ed28604f5e14fa13bae04045cd5d\n] \n\n[tests/lib: fix definition of 'which'\nBen Franksen **20220501131022\n Ignore-this: f666f22e31235ccce3751998838c83380959520e7937b8088da98d719c2d7d973da201b92353547c\n \n In bash, 'type -P x' returns the full path where executable 'x' was found\n and nothing else.\n] \n\n[harness: fix output of darcs executable under test\nBen Franksen **20220501130633\n Ignore-this: b37fa071f7b9597cf5199f223dd5ecb34a1dc2bef9a28cd3c57ea69f359f6a5b3e77cbaa6af0c865\n \n Since it says \"Using darcs executable in\" I expect to see the directory in\n which the darcs executable was found.\n] \n\n[harness: fix quoting env stuff for shell evaluation\nBen Franksen **20220501124245\n Ignore-this: f317da9fa9e9d46ff7656161bb2e6159a14a0fc92542e8ec1a3cc854bc0a66f6c67c3c6abf1ae8b6\n \n Using 'show' here is just wrong (it fails with spaces or non-ASCII\n characters).\n] \n\n[Darcs.Util.Index: fix outdated haddocks\nBen Franksen **20220430092938\n Ignore-this: 5d47c0385dd977a28118f9a38e80ad6c589d7dfd9e2c1b9d0dcbd1e66c3f85a4f4b73ce39f00300f\n] \n\n[.stylish-haskell.yaml: don't break single-constructor records\nBen Franksen **20220429120907\n Ignore-this: 8125c7f3bebfe58acc589f50ba2551ec0d452dc6fe332d1ea182c41caf47cff32594da54f076895d\n] \n\n[catch all IOErrors when removing temporary directories\nBen Franksen **20211122085340\n Ignore-this: 63004ebf109bdb034ea6a8cb94086cca9174fa5d754704905b0e957f6595c1a53eadc3f80a6ed85c\n \n I have occasionally observed tests failing in the CI that say\n \n darcs: /tmp/darcs.log-75c76c279e1ab188_done/_darcs/patches:\n removePathForcibly:removePathForcibly:removePathForcibly:removeDirectory:\n unsatisfied constraints (Directory not empty)\n \n Catching these exception is justified because this is mere cleanup. Note\n that we already do the same thing in the cleanup part of withNewDirectory.\n] \n\n[remove a duplicate import\nBen Franksen **20211122085313\n Ignore-this: c07c83bb54d94eb9cf0fee1daee585dbfcf018184367fbd0da6a92c1e768c1537ffa51b4cbba1949\n] \n\n[work-around to allow build with ghc >= 9.0 on Windows\nBen Franksen **20220428120533\n Ignore-this: fa4d0d9c76dbc968f633f18433f1241e0140590b1f2b0178fe4b7cf655cb3fc4669fea8a05260d2a\n \n We indirectly depend on ansi-terminal, with ghc-9.0 cabal picks 0.11.1 which\n is missing a lower bound on its Win32 dependency (has been reported upstream\n and will be fixed soon). This makes it hard to write correct cabal file for\n all supported ghc versions. The work-around is to reject version 0.11.1 of\n ansi-terminal.\n] \n\n[use fixUrl in clone command instead of ioAbsoluteOrRemote and toPath\nBen Franksen **20220427091826\n Ignore-this: 72d0545d6cbd17e66c5e1c5b3b286846a206151b44b79e572a34358ff2d0de10058572495a17e842\n \n This is how it is done for most other commands that take repository\n locations as argument.\n] \n\n[canonicalize result of getCurrentDirectory on Windows\nBen Franksen **20220427084954\n Ignore-this: e64eab8c7e8b34994365acbb8b637f00c4b473f0429c0cd6c2f057c39068c97d7dea746a7dd18d52\n \n This fixes problems detected by the CI. Before this patch we sometimes got\n DOS-style 8.3 directory names, which failed to compare equal to other\n repository paths with modern long names.\n] \n\n[fix problems with tests/issue189-external-merge-move.sh detected by the CI\nBen Franksen **20220424172154\n Ignore-this: 3ede71e278cf3e925f9c3a88c0a81223d9c03e8204bd7f5ebc7fc4ba6ef46b5f1e5104b4d25d4c94\n \n It seems creating a shell script and using that as external merge tool is\n not portable enough to work on Windows (even if we add the missing shebang\n line). So we create a small Haskell program and compile it.\n] \n\n[tests/push.sh: simplify test for push to self\nBen Franksen **20220426092504\n Ignore-this: 10316cd282fe76595074a6aaeee5642714ddb835ec59be7969f36ecacdfab70d41a22f85a4ea42c5\n] \n\n[re-apply our changes to .stylish-haskell.yaml\nBen Franksen **20220429112542\n Ignore-this: b407b51bdeff6faa01c48ac9afa4ae1da7e1653c4f62baaf488c3258768abce4f50083bfb2cd02d1\n] \n\n[re-create .stylish-haskell.yaml with version 0.13\nBen Franksen **20220429112418\n Ignore-this: 91edbe86eed9b38cba2291243948c39c56d4b8f4a7a81c97f509e7b75f9ae98691bf69fdf0627f8e\n] \n\n[simplify addRepoSource by using getDefaultRepo\nBen Franksen **20220427091736\n Ignore-this: a8090eb56256840be9cc7a667277b27dd6acac6ad924e16efcef9e9a3eca529bd9854cf79bdc5f00\n] \n\n[simplify getDefaultRepo\nBen Franksen **20220427091659\n Ignore-this: 389f4c1dfdef3e4c84c04c7af5554666c97290eea1c67bc4c6afb5858a8b5ba1724a094b2f9b3540\n] \n\n[Darcs.UI.External: inline execAndGetOutput and simplify\nBen Franksen **20220424123938\n Ignore-this: 89f68c829ded85c0d55122bc79e8adbcd60b37533ebe43bc95f6dfb7672879735549052b8205c0ef\n] \n\n[Darcs.UI.External: cleanup execPSPipe vs. execDocPipe\nBen Franksen **20220424122226\n Ignore-this: 195014c295ad60814b7cd254ec06b7740333bd21c80189588352e1f0d6d5859b5a1f599cc572ef78\n \n The Doc variant should be defined in terms of the ByteString variant,\n instead of the other way around.\n] \n\n[resolve issue2691: QC test failure for betweenLinesPS\nBen Franksen **20220424081018\n Ignore-this: ad12c0a5fd72281e5f759a41b08bd9590580c4f2714b9226b95e0963716c3f155183a32db2d3600\n \n This first fixes the test by introducing two newtype wrappers for ByteString\n to tweak probabilities such that betweenLinesPS actually finds the start and\n end lines (in order) in the input in about 6% of cases, which uncovered a\n few more bugs in the implementation of betweenLinesPS. The new\n implementation fixes them and also improves efficiency by strictly avoiding\n ByteString copying and allocations. Getting this right was more difficult\n than I expected, and would have been almost impossible w/o a specification\n to test against.\n] \n\n[improve some haddocks in Darcs.Util.ByteString\nBen Franksen **20220422125939\n Ignore-this: 86e642be85e2f0bc445663d018a4cc5ec12fb8a5abdfbbd07ba1d6ff995cd17ff5fa4013297a4d59\n] \n\n[add property test prop_linesPS_unlinesPS_right_inverse\nBen Franksen **20220424080611\n Ignore-this: 3abdd252a495d8a8903eda1dc8413e8a67ebd694c737661a320f010a2a4d453ef93edee0a7ebbd14\n] \n\n[fix a corner case of spec_betweenLinesPS\nBen Franksen **20220424074906\n Ignore-this: 16d2c5820470b621f593abac3dc5d6219495c6c14245d330d70d91ee1eca26dda6656ce0ca9c27bb\n \n This makes it behave in the same way as betweenLinesPS behaved when the\n start and end line are immediately adjacent.\n] \n\n[add test for (now resolved) issue2072\nBen Franksen **20220412151745\n Ignore-this: f28cb0e14807dc344008deccb084a2208a0c1192ee84f2751580b36e807da730fcc8873a82e4dd2c\n] \n\n[remove RepoPatchV1 speedyCommute\nBen Franksen **20220420185859\n Ignore-this: 5090bcd754fade21b96e01466763063e8c11feaad54450d3e2bc76a2b773b2ed939fd28872c21b0a\n \n Note that this was merely used as an optimization for the case where both\n patches touch a single file or directory, neither of which is a prefix of\n the other. It was previously limited to just files, using is_filepatch.\n Extending the optimization to include directories and relying on\n listTouchedFiles was regarded as too risky, which is why here we remove the\n optimization altogether.\n] \n\n[remove out-commented functions from D.P.Prim.V1.Coalesce\nBen Franksen **20190805080721\n Ignore-this: ea0fde294814422913bbd3d0f19668201ed8cea3322dd9a44527ebb3d1e2e0db071f182158444051\n \n This is recorded as a separate patch for easier review.\n] \n\n[separate canonizing from coalescing\nBen Franksen **20211117083628\n Ignore-this: 7ad0c99b727e6e7cf5179b8a280f4732d4c3cfca1d6783b1bb04dfd7d11e7100747e593d8b5b4e56\n \n This moves the implementation of 'canonize' and 'canonizeFL' to a separate\n module, eliminates the export of canonize, and renames class PrimCanonize to\n PrimCoalesce.\n \n The rationale for this refactor is that 'canonize' for single prims was the\n only remaining method from class PrimCanonize that actually had anything to\n do with canonizing. Its implementation does not depend on coalescing and is\n almost independent from PrimV1, with the exception that it removed patches\n with no effect, using isIdentity. This is, however, also done by\n sortCoalesceFL. Investigating the call sites of the canonize method revealed\n that some of them actually re-implement canonizeFL. The remaining two call\n sites (in Prim.Patch.Split and Darcs.Repository.Diff) now call canonizeFL\n with a singleton FL.\n] \n\n[extend docs for class PrimSift\nBen Franksen **20211117083628\n Ignore-this: 23afc7c34d0989dfcb1c1febe7eb973fd320b6f8198b53439663f167a5551eb86c07ee87651a4da0\n] \n\n[refactor and extend tryToShrink and sortCoalesceFL\nBen Franksen **20190802233801\n Ignore-this: 874da48ff3385f15a01d7ad1c5f9ca742eb0fb94950ef4a7e1ad4be3c2cf53f5ad1ab067a38de0a6\n \n This is a complicated patch that slightly changes the semantics of both\n functions. If one looks very carefully at the previous implementation of\n tryToShrink, it becomes clear that it is very similar to sortCoalesceFL. The\n difference is that tryToShrink doesn't bother to preserve the order\n established by its call to sortCoalesceFL. Whereas sortCoalesceFL takes care\n not to destroy the order it has already established. Both functions\n internally track whether shrinking has made progress, but hide that from the\n API.\n \n The new methods now both share the same core: sortCoalesceFL2. Similar to\n the old tryHarderToShrink, this function now tries harder to shrink the\n sequence than sortCoalesceFL2 did before. However, if this destroys the\n order, it takes care that it gets restored. It is thus able to find as many\n opportunities to shrink the sequence, while still maintaining the ordering.\n \n Internally, keeping track of whether shrinking has made progress is now\n structured as an effect of type (Any,), where Any is the Bool wrapper from\n the base library. This is a Monad due to the Monoid a => Monad (a,) instance\n defined in base, see the doc comments for details. mapPrimFL now takes and\n returns a function with a monadic effect, which allows us to map\n sortCoalesceFL2 directly. Which in turn allows us to change the return type\n of tryToShrink to Maybe, exposing to calling code whether we could shrink\n the sequence. This is used to avoid lengthFL calls when sifting.\n \n This patch comments out some code instead of deleting it. This was done in\n order to produce better diffs. They will be removed in a separate patch.\n] \n\n[define canonize outside of instance PrimCanonize\nBen Franksen **20190805084756\n Ignore-this: 4d21fbe18e2ce16159961299c0818be46b1f1f9f188bd6301a98c16858821c3646080347748314a7\n] \n\n[move canonizeFL out of class PrimCanonize\nBen Franksen **20190805082330\n Ignore-this: 684c754d3d6d582719874c0998018a81db90fd7866f9911e045053c484bd7c98bca9538fd6da06e7\n \n The definition of this function is independent of Prim.V1, it only uses\n methods from PrimCanonize.\n] \n\n[layout fixes in Darcs.Patch.Prim.V1.Core\nBen Franksen **20210216202120\n Ignore-this: ade4c8f46e4a2e3b02cae9b9966410f44281aba16786f85618b865717f9c88ef47a81bdf5aa37a7b\n] \n\n[remove evalargs in Darcs.Patch.Prim.V1.Core\nBen Franksen **20210216194755\n Ignore-this: 1627c10c6f98d2492c9409baf7bffd9f48ae0ea82c80ed3fc070985101e1091f841810388466c374\n \n All the interesting fields are already declared as strict in the data type.\n] \n\n[derive the Show instances for Prim.V1\nBen Franksen **20210216193751\n Ignore-this: e40605c60063e160d357c8b92682169db18f68ebd5bf193eef35071529f2801968db415c63b08248\n] \n\n[drastically simplify implementation of siftForPending for Prim.V1\nBen Franksen **20190801171930\n Ignore-this: 2363ff65cb958bb14154c2f3230cbe8cb274c22f227067d9b6f8628fb9cc0d613256798fe69e4f3e\n \n All the low-level optimisations have been eliminated. What remains is quite\n simple and easy to understand. Theoretically this change may cause\n performance regressions; but the optimizations only covered some simple\n cases like \"pending consists only of hunks, binaries, and setpref\" or\n \"pending consists only of addfile and adddir patches\". These special cases\n are handled just fine and without much overhead by the standard algorithm.\n Besides, the bottleneck in handling the pending patch is not sifting, but\n the complicated algorithm for eliminating recorded changes from pending.\n] \n\n[move instance PrimSift for Prim.V1 to its own module\nBen Franksen **20190801154508\n Ignore-this: 9ffeb5a9f23f3bb9e14a9b8734060ddd2e03f3387ef569c3f0b2e79f7e0e719431d3ec366a610ba7\n] \n\n[eliminate class PrimClassify\nBen Franksen **20190801154508\n Ignore-this: f7f39a64c32bb32a9dc249508a619470080d8e133d59563bfa6685e69f01e59ddbedd8ed61c09e34\n \n There were only three use cases left:\n \n (1) The whatsnew command used primIsHunk, which can be easily replaced with\n isJust . isHunk.\n (2) The implementation of RepoPatchV1 used is_filepatch for speedyCommute.\n This is now replaced with calls to listTouchedFiles. To account for\n directory changes, we now check that neither file path is a prefix of\n the other.\n (3) In the instance PrimSift for Prim.V1. Since this is specific to Prim.V1,\n we implement the necessary functions directly.\n] \n\n[fix haddocks for pushCoalescePatch\nBen Franksen **20210207152619\n Ignore-this: df46b4e90c7da050e708aebca8bd4b737a0332f579092adcdf33cd69c5bb00b51f4643d18e4f0062\n \n Itemized lists require the points to be numeric.\n] \n\n[cleanup and simplify Darcs.Patch.Prim.V1.Coalesce.mapPrimFL\nBen Franksen **20190802203643\n Ignore-this: 6fe467bf631245fafe049c9d96e04f833508ba377688a71ac467f9d3ea41241fab404f4e77bd7c1a\n \n This eliminates the data type Simple. It is easier and more efficient (wrt\n memory as well as cpu) to put the original patches into the Map, rather than\n take them apart and afterwards put them together again.\n] \n\n[use (Bool,a) instead of Either a a in pushCoalescePatch\nBen Franksen **20190802233623\n Ignore-this: 538ae2f1bff7a53eaa89d43975177ccd356402f03ce125322ff740881bd8d17df11f70632e4899b8\n \n This is less verbose and more directly captures our intent.\n] \n\n[normalize code layout for pushCoalescePatch\nBen Franksen **20210207150213\n Ignore-this: 7c460795d70f7815ea0af5d3d73d510a111a7f33789c4f9caa9db7fd159693f1960223ec2be83c2\n] \n\n[resolve issue1981\nBen Franksen **20220412164924\n Ignore-this: 3ce6b926b313a3d30045c5e47d3282e17c66354611861ea37a29a218e6736b5fd963a7b4e0826a78\n] \n\n[accept issue1981: suggest repair when pristine files are missing\nBen Franksen **20220412162926\n Ignore-this: 21e494a15d85ff2a26e6c4533fdcee092043c597b606b314e68e8809b8dec28b3b377188913b4f29\n] \n\n[resolve issue1819: external-merge and no-allow-conflicts\nBen Franksen **20220412143240\n Ignore-this: b8c0e5e6756e5e2368477fc1da2b8eba6de24f7e39aa25b7ecd63771902bd7d0f80a4ac1071452f4\n \n The fix is simply to remove the code that deliberately tests for the\n external-merge option before failing in announceConflicts.\n] \n\n[resolve issue2646\nBen Franksen **20220412135010\n Ignore-this: 8d9f8f9029ecd6d15f884aadb006a78e1f1cc70b40d9a407a16eb9de1c123d3d813c81f1f141f36a\n] \n\n[replace undefined with error calls for missing methods\nBen Franksen **20211203054657\n Ignore-this: 20661aa6ba3a359da46ba2734d7596991ca3bd471f7b8634b64030bf8ef5870552f7fdb7d4d6dfac\n] \n\n[patch index: disentangle Darcs.Patch.Index.* modules, rename PatchMod to FileMod\nBen Franksen **20211004080939\n Ignore-this: ac59088cf63cb273f80986055b3efe7ea89545bcef4e011dc6aee72cb038b9621264dab537edc48b\n] \n\n[patch index: cleanup doc comments\nBen Franksen **20210610120909\n Ignore-this: 8338b392d1a22f71122e0c2f6bd7fcfc4524fed5ed473967aaf586ebab535b0ccc0c77783007778a\n] \n\n[patch index: optimize Set Word32 -> IntSet\nBen Franksen **20210610121541\n Ignore-this: 3f64ba8278cc2a83401775d65ffb0220990977242083054901d791021b0e2d98eafd3a664c2ed61\n \n This trades a bit of memory (at least on 64 bit archs) for the ability to\n use an optimized data structure. The version number gets increased to 5.\n] \n\n[patch index: massive performance improvement\nBen Franksen **20181004160731\n Ignore-this: d02cd79fc9d674d6432479c574f9d971a6b7fa3c5c46049cff63db8b6117ae09c3ce21d32409e9a6\n \n By definition, a directory is regarded as touched whenever a file or\n directory beneath it is. This information was laboriously re-constructed at\n query time (in maybeFilterPatches), which could be very slow when a\n directory had many children. It is much more efficient to add this\n information immediately when we build or update the patch index. This\n requires no change to the data structures, just additional inserts.\n Nonetheless, this is a format change, so we have to increase the version\n number to 4.\n] \n\n[patch index: reformat a doc comment\nBen Franksen **20210610120501\n Ignore-this: 665a824caca2b970d25fabf22eb85d688bec52632d00d77ee9ebeb292d32d473856329b9aebb4d9c\n] \n\n[patch index: import from Darcs.Patch.Index.Types explicitly\nBen Franksen **20210610120619\n Ignore-this: 55342c521619ad0b3d0a206affc765a6b6214b62f22166e71057b4349e4d482a5663e5081f55bfa4\n] \n\n[patch index: debug messages when loading\nBen Franksen **20210610120949\n Ignore-this: 66b640cde02f352c7905afe48b4cfa6067b041f3ebc1af5e6389ea565e428b05ddbb607a9d0cb0f4\n] \n\n[patch index: remove another kludge for broken move patches\nBen Franksen **20210610190038\n Ignore-this: d5fa46e3cfd90d65313facc204d8cbdada8048b223468f79272f9c3830474807c224364ab25677ac\n] \n\n[require MonadThrow from the base apply monads\nBen Franksen **20210919120041\n Ignore-this: 8b6138c45749e96828be7a9e9b71458228b0c71475e98dce0762648d7aa56f122d34a82f64ab1a82\n \n This avoids having to throw from pure code when applying patches in a monad\n that is not based on IO. In Prim.FileUUID we now correctly handle all patch\n application errors as exceptions. In D.P.ApplyMonad, the FilePathMonad is\n now a StateT over a Pure monad with an instance MonadThrow that calls error;\n in the harness, the Fail monad is now a synonym for Either SomeException.\n] \n\n[catch all takeLock exceptions in withLockCanFail\nBen Franksen **20211108160839\n Ignore-this: c574accb8be23d198e0bbee14e1cccb2b146c8100aa4ee9bb6a99ebfe557106e2e9fee921fb2d4dd\n \n Note that withLockCanFail is used in commands that are otherwise read-only,\n such as annotate and log (with a filename), in order to create a patch\n index. These commands should not fail if taking the lock fails for whatever\n reason (e.g. no write permission). This is important for instance when using\n darcsweb.\n] \n\n[tag command: prompt for the tag name if argument list is empty\nBen Franksen **20210627080534\n Ignore-this: 3c70f157ed9f3b3e0301c68769557cd5ed1cc59d7324dc7baf70006c0dfbdb6ac8d6365045612bf\n] \n\n[tag command: clean up imports\nBen Franksen **20210627075730\n Ignore-this: 2b6a9706d3531d900959c54cbef7cb4b2e7ba1e33ba2c676224e181bd74c8507fbd9bf7c4f710ef\n] \n\n[Darcs.UI.PatchHeader.getLog: take summary of changes as argument\nBen Franksen **20210627075202\n Ignore-this: 38265b7ed5ece5316161c40cca0ae7db6a1eb1e59a3a49d133dc0f49515cf65b83abc583ad676d52\n \n Instead of passing the changes, we now pass their summary. This avoids\n verbose and ugly type annotations to avoid ambiguities when passing NilFL in\n the tag command.\n] \n\n[tag command: in get_name_log, use 'args' from the outer scope\nBen Franksen **20210627073934\n Ignore-this: e74a2a28bf027070de64a2a8be45aeac93b289b82b99cd4dfa312ca630656adfdf34e621fb1a239b\n] \n\n[tag command: reformat the where clause of tagCmd\nBen Franksen **20210627073809\n Ignore-this: 673a97d985ca66ee53f7f5bbcd34ab5e53ef12631273619f094e69635c3f4a1b99f11c9dc89b7dd8\n] \n\n[tag command: refactor hasPipe\nBen Franksen **20210627072002\n Ignore-this: d3861107d475474372ee623ced02f64598def725eea85cd060c16846cc163fe73b70db12e4d0a75e\n] \n\n[tag command: improve help text\nBen Franksen **20210627071800\n Ignore-this: a56cdcdbed1e238754f57db719d71019ccd58e64b6b258d4cd6b0346897577339a2fbd5fd75e7376\n] \n\n[auto-format help text for tag command\nBen Franksen **20210627062550\n Ignore-this: 59f715042939c55d5b80ab6513aa1567c278789339bf62a0d1475df678cb68e635b2a746c865e644\n] \n\n[remove type ConnectionError, remove Darcs.Util.Download\nBen Franksen **20210623082607\n Ignore-this: ee6db6842ba76617d506bec3f0373d42dc33964480785d7611e55fb646de98f3cd581fd4314b098f\n \n The data type was only used in checkCacheReachability and in a way that no\n longer worked anyway. The remaining item in Darcs.Util.Download was the\n Cachable data type wich is now defined in Darcs.Util.HTTP.\n] \n\n[import ConnectionError unqualified\nBen Franksen **20210622163331\n Ignore-this: 4d7463e525b1c023aad7eb492db2a6f4adda992351978975b2532a1ed58482cfea372192711955a3\n] \n\n[remove support for downloading via curl\nBen Franksen **20210622161934\n Ignore-this: 61e4875b4d8e424c9227cb4706f7ad0ab4ba9e5f77e2fd5317a4729dee315ec64d6111d5c2781fff\n \n This includes the cabal flags 'curl' and pkgconfig'. It also removes the\n --debug-http and --no-http-pipelining options, and replaces the combined\n network option with remoteDarcs. The module Darcs.Util.Download.Request is\n also removed, the only items that are still used are two data type\n definitions which are now defined directly in Darcs.Util.Download.\n] \n\n[remove the unsafe tentativelyAddToPending, replace with addToPending\nBen Franksen **20210302150625\n Ignore-this: cce3b2d0ecab7060153fa6a357efa83f22c2b0f1e60d57b631ccef7f1b9a6660a30d3b48f353dd7d\n \n The fact that this type checks witnesses the fact that indeed using\n tentativelyAddToPending was wrong: the patches we pass all start at the\n unrecorded state and thus should be commuted past the difference between\n pending and working before appending them to pending. This is what\n addToPending does which is why it is the safer choice here.\n] \n\n[rename addPendingDiffToPending to unsafeAddToPending\nBen Franksen **20210302132611\n Ignore-this: c64370f6ea0a98e2db90a644b6ac511751f998fdb4182c42de9f18ff1c2c8f3dd8a9849800da8236\n] \n\n[ci: run tests concurrently (6 jobs)\nBen Franksen **20211105202439\n Ignore-this: 5f69156e53f5b52b7137077883d72d70652d4a973cbd5c5718be4dff9b742f825a4f77a8e4748508\n \n I have observed that this makes the tests run faster, especially on macOS.\n] \n\n[ci: allow empty commits\nBen Franksen **20211105202358\n Ignore-this: 7e737cf04f5a08d659156e476a09e8623d4cd83c0ef0593a8aef3ad401655f1d170b2c1e8cb29a\n] \n\n[ci: fetch before commit\nBen Franksen **20211105143643\n Ignore-this: 1127b44c6b77869cc0ca6b8ffeda50c737fa6e62e4d62194be758e90a4524f038f29a2492ec7d4f3\n \n This works better with the recent change that makes us share a single\n branch: rather than force-pushing our local branch, we now first fetch and\n then set our HEAD to master. To completely re-initialize the git repo, pass\n the argument \"init\" to the script.\n] \n\n[ci: use only the default (latest) version of each OS\nBen Franksen **20211105141833\n Ignore-this: 77f372e4b03493b65ee149a5ed1dd301afad1f3a47f70033b19e38fbfc6d404f86afc94c0407779c\n \n This makes the CI runs faster because we don't have to wait for runners to\n become available.\n] \n\n[generalize readPatchesHashed and use in readTentativePatches\nBen Franksen **20210327055207\n Ignore-this: 5c1771aacdbc2ee22e02e37e46b5b72621c02fa5bfa5b703ea803da6a7854c13c3529170d1fbc57b\n] \n\n[replace readTentativePatches with readPatches\nBen Franksen **20210301201958\n Ignore-this: 98d4665d77887ce616540cc11ade28616e4c1458303a8341e01a479bebde69c383dfb905bc6b0bd\n] \n\n[import tentativelyRemoveFromPW via Darcs.Repository\nBen Franksen **20210301152620\n Ignore-this: bb37ef9fe31d2be6d830cf23faff248870b333e4040f91b84fa6b0c0f966d90526f22f12dea71788\n] \n\n[use withRepoDir in createPacks\nBen Franksen **20210315162432\n Ignore-this: b7141bfd23d7c787f27eb919010c08aec95162bffbfe4775fdff3a1e5868c5a85a46e331290f86d9\n \n This simplifies its use in darcsden.\n] \n\n[fetchAndUnpackPatches: fetch inventories, too, pass valid hashes, not String\nBen Franksen **20210717084010\n Ignore-this: bb7311cbce7399d3e5903d68601431d3b7fa6096b0f92e1a2a0af4ed24674f5f707facac9395bdfd\n \n When we unpack patches and inventories from the pack, we previously fetched\n the necessary patches in parallel, for guaranteed completeness. We now do\n the same for inventories, so that when the remote repo has been tagged after\n the last time packs were updated, we still get the repo in its most\n efficient form. This requires passing the inventory hashes as well as the\n patch hashes. To improve type safety and efficiency we now pass lists of\n InventoryHash and PatchHash instead of String, which avoids encoding and\n then decoding and the extra failure mode due to these conversions.\n] \n\n[convert import/darcs-2: recognize the compress and diffAlgorithm options\nBen Franksen **20210303145001\n Ignore-this: 85558b53cb6d96f71f8f685002d80e3a8f41fa88b023194b59df8fa17f2436eab6aeb1f95ea6ebc3\n \n This avoids hard-coding some arbitrarily chosen value.\n] \n\n[convert darcs-2: remove intermediate commits\nBen Franksen **20210617101048\n Ignore-this: fc35c5ca37a0014148a274c6e953b147759f898249e72249ee0aca4118e1f0f341e06f45ce258a33\n \n There are two reasons for this change. One is that intermediate commits open\n a brief window in which the repo is not locked. Since this happens in a\n newly created repo, this is not of much practical concern and more a matter\n of principle. Second, intermediate commits serve no purpose. If conversion\n runs into an exception you will end up with a partially converted repo (the\n state of the last commit). This is quite useless, since there is no way to\n restart the conversion at this point.\n] \n\n[convert darcs-2: honor the compress option\nBen Franksen **20210303143641\n Ignore-this: 4178cc4194d62d3fa7593c1eef428eed7ce98933308d1614584e683cc3b3030021553fb0acb605bf\n] \n\n[convert darcs-2: add a final call to finalizeRepositoryChanges\nBen Franksen **20210303142815\n Ignore-this: 17c6f2ca4af83cde9b7f0cf3a3d7963133eb8a87ae9229cd95131b9ad50dedc7661d1b883db9d5\n \n This is more a matter of principle than necessity, since the code does work\n without the call.\n] \n\n[ci: more descriptive name for the git commit\nBen Franksen **20211105091710\n Ignore-this: 14c677925a8645ff4207252355426fcbb05de7673a816b463898af25a671e02843c97ba4eeec91c\n] \n\n[ci: remove branching from release/trigger-ci\nBen Franksen **20211105084919\n Ignore-this: 444f6f6b7ee6f29d18f2ea47249d9a95c16185fb74c3b5978f17441042b2ce7dc1320c5c62109618\n \n I found out that this interferes with caching: when you trigger CI on a\n different branch, the caches from a previous run in different directory\n aren't used. We now do everything on a single branch named 'master' to allow\n sharing of caches.\n] \n\n[fix in Darcs.Patch.PatchInfoAnd.fmapH: must invalidate hash\nBen Franksen **20210718141537\n Ignore-this: 8a9610a2e0f504501f94adf929e4bf9850364340da08a38dbe19588ef5c874d0824f30b268b2a28a\n \n The function we map over the contained patch may modify it, so any hash\n we may have had is now invalid.\n] \n\n[cache: eliminate hashedFilePathReadOnly\nBen Franksen **20210530083542\n Ignore-this: 6b7b737d8242d0fce556e0ca1fdefa51ab3f7a156088bd7dbc4e9e642c0df129ac94eb6f401f933a\n \n Since we pass the CacheLoc, we can make the distinction between bucketed\n (writable) and non-bucketed (not writable) cache inside hashedFilePath.\n] \n\n[refactor updateHashes in TreeMonad\nBen Franksen **20210421083122\n Ignore-this: a4dd8fda4fb083a73f1d55f029dcdc3e363b0762a7aa9832ec568dbe07fabf3e7f789bfea5073c49\n \n The central change here is in the type of updateHash from\n \n TreeItem m -> m (Maybe Hash)\n \n to\n \n Maybe (TreeItem m -> m Hash).\n \n Indeed, for a concrete instantiation we either have a total hash function or\n else no hash function at all. In the latter case this change avoids calling\n a procedure that always returns Nothing, potentially recursively over a\n large tree. It also gives us more precise typing.\n \n Everything else follows from that, with the exception of 'flushItem' which\n was rewritten to make it clearer what happens: we first update the hash,\n then update the item on disk and then replace the item in the tree we are\n tracking.\n] \n\n[move reading and writing of inventories from D.R.Hashed to D.R.Inventory\nBen Franksen **20210327061805\n Ignore-this: 300dc2023972e7d9d709d21de95153a63e0cdb279d6debacd1c54c1017eb22d6a9b00d87073e0d96\n \n This is a pure code move, except that I also cleaned up the layout of the\n import lists in D.R.Hashed.\n] \n\n[fix a FIXME: HashedDir mismatch in the handling of packs\nBen Franksen **20210716150629\n Ignore-this: b63b49a3deda117bca42618fded8b7db7833d065cf5503010a068f139501284045bb95b12b21c209\n \n It turned out that the HashedDir parameter wasn't used anywhere, so this\n patch removes it. This makes sense since filepaths in the pack files already\n contain the subdirectory of all files.\n] \n\n[major refactor: internally store valid hashes in parsed form\nBen Franksen **20210416112403\n Ignore-this: 6b4382f578cac191e53a094f1649dad6ca6e42aa041ec58493e3b8931aaa8d076c2077a689317a3b\n \n The main theme here is the \"parse, don't validate\" mantra. Storing hashes\n (optionally including the content size) in parsed form is memory efficient\n and gives us much better typing. The code for this has been moved into its\n own module Darcs.Util.ValidHash with a safe API. PatchInfoAnd now stores its\n hash as a PatchHash and the Tagged sections of a PatchSet store their hash\n as an InventoryHash. The HashedDir is now inferred from the type of the\n hash, which means we no longer have to pass it to the function exported by\n Darcs.Util.Cache, which simplifies the API and makes it more type safe (yet\n note that not a single 'forall' had to be added to type signatures).\n \n This refactor exposed a strange HashedDir mismatch in the handling of packs\n that I temporarily marked as FIXME. I suspect that some files are not placed\n in the right directories, resulting in a loss of efficiency when cloning\n packed repos. This needs further investigation.\n] \n\n[move D.R.Inventory to D.R.Inventory.Format\nBen Franksen **20210327054814\n Ignore-this: 32dd92b2be5f2ab200d7f349372086cb6ac4e2def2b09ac8b1e3f3a1c80cab63801b3b00ead079c1\n \n This is so that we can move the code conerned with reading and writing\n inventories to D.R.Inventory w/o mixing the inventory format with its\n interpretation.\n] \n\n[cache: inline copyFilesUsingCache\nBen Franksen **20210307101327\n Ignore-this: 1039cb3158ce64caec81b74958e68546a7c5c1f6ff62a7cc5b1adfe3ade34b49bbc3bcf03d100b5d\n] \n\n[cleanup parsing and unparsing of hashed directories\nBen Franksen **20210417101623\n Ignore-this: c1a6450fba98053feee3e470f78a99dcb98f7ed42b4ce4029e5d133f9081b27ac7932f7acfbbba35\n \n The parser now uses Darcs.Util.Parser. The function decodeWhiteName which is\n used by the parser is now explicit about decoding errors. In contrast, the\n unparsing is actually *not* supposed to fail: it has existing hashes for the\n subitems as a precondition; indeed we call hash update functions in various\n places before calling darcsFormatDir. As it stands this is quite brittle and\n should be improved but this has to wait for another patch.\n] \n\n[fix generator for hashes in D.T.R.Inventory\nBen Franksen **20210324023216\n Ignore-this: 942b9deff9c67365da5f57e55670502bd5892dd64771edc5e69cca26e5ab426c8f5d215c3d5b9682\n] \n\n[use decoding to validate hashes\nBen Franksen **20210416095352\n Ignore-this: d6c7a2a1a7d27ab95187de10d35f9c597f09fe71745ac967ec37436a770aa5d2a6aa16133ee5fde8\n \n This also delegates the implementation of okayHash to okayHashB.\n] \n\n[make possible non-existence of hashes explicit\nBen Franksen **20210412055417\n Ignore-this: 842dc617ace1f53ed410d5f04615523513181b3937607f1a99057dba6d25d2516e962772f7057653\n \n This removes the NoHash constructor and (more or less mechanically) replaces\n Hash with Maybe Hash. This exposes lots of situations where we missed out on\n more precise typing i.e. where we know we have a hash but still work with a\n Maybe Hash. This patch doesn't clean these up, it just allows and encourages\n us to do so.\n] \n\n[move hash validation from D.R.Inventory to D.Util.Cache\nBen Franksen **20210327075324\n Ignore-this: d020f2ac5800819b5eba063a53901aa2f64ccb1222354bad6ed556d89a67945d273e225fb3c39ad9\n] \n\n[validate hashes in inventories on the ByteString side\nBen Franksen **20210314083456\n Ignore-this: 87fc6ffe037ab46a792e4466db85b028f92e593edb2219529dbd6f7c814e9c1610e7a8e76e4ab835\n \n For reasons I haven't been able to figure out this drastically reduces\n memory consumption.\n] \n\n[avoid re-validation of already validated patch hashes\nBen Franksen **20210308093608\n Ignore-this: 9c03b65a47f366271b0beee735a3e8d6b5e72fe0031d405d4d701caee84c89fc646e8d3408493b18\n] \n\n[cache: refactor cacheHash and remove export\nBen Franksen **20210307101410\n Ignore-this: bb33fb17c07c2e8300ceb4731969faf823dc175a37e6fc2881ff4a00160a0a97b7b26a4e7ba79e05\n] \n\n[use ShortByteString for Hash content\nBen Franksen **20210307162525\n Ignore-this: 343006f7acead5b3f3d044b3454fc7e6370d7d9ec177b13f45bf9c365c88b0e4a8e414a128c1cb37\n \n This should bring down memory use and decrease fragmentation.\n] \n\n[ci: fix primary key for caching dist-newstyle\nBen Franksen **20211104105043\n Ignore-this: 1e79356ff7ddbb9bb30843652341020ff486aae44f4469cb1fd0dbd496ec28eb850e1fcf1c7dbe7a\n \n Cabal will re-compile everything if the build plan has changed so we also\n need add this file to the hash.\n] \n\n[remove the useless optimize pristine subcommand\nBen Franksen **20210510113544\n Ignore-this: 1c75fd4ccfbe80df50059810df5d91dcf60cc4fd7c5b6715a01ec5761df701a451a636763f654133\n \n Upgrading the pristine from the size-prefixed format is done automatically.\n] \n\n[fix the order of parameters to Tagged\nBen Franksen **20210327050259\n Ignore-this: c8c6812ba8b25fa932a134d5a4839b300ab98442484799fbab71704be4fcf6716391e8fe44a2c322\n \n The order is now 'Tagged patches tag hash', i.e. patches come before the tag\n that covers them. I should have done this years ago when I established the\n convention that patches always appear in left to right application order.\n] \n\n[return hash from writePristine\nBen Franksen **20210324172607\n Ignore-this: 92cfee04b27714e70f51b42bb3c107c231f17ba497071e89dd04b6054911259a782a66260c03c562\n] \n\n[simplify writeInventory and writeTentativeInventory\nBen Franksen **20210324053723\n Ignore-this: cc354cfc9ccdfe121d8356195aad6f4a7b00bbbb08286282a03376b12b6bd7039f09af604b908f14\n \n The simplification consists of no longer treating empty inventories\n specially. It involves is a minor change in behavior in that an empty\n inventory is now written to disk as a hashed file; which is the reason we\n have to adapt tests/issue1987.sh. Indeed, my original motivation for the\n refactor was so to make writeInventory return a hash unconditionally.\n] \n\n[lift writeInventoryPrivate to the top level and rename to writeInventory\nBen Franksen **20201103063416\n Ignore-this: ec7d61553da2ce9972616ec2ef2d3e63f4158d3b054f34ad41ea26ec3ef9d5a0d66b08e9e1f153a5\n] \n\n[ci: add macOS-11 and windows-2022 to matrix\nBen Franksen **20211103163757\n Ignore-this: d336271ef6a2692df63214648ae59ae4bc96f4065c62161767db9bbf96e8dec0ae62259ef7ba91fe\n] \n\n[ci: install lighttpd before running tests on linux\nBen Franksen **20211103163505\n Ignore-this: aa8ef8ff04bac161a2f23a2610e02ccd4f81bcc3ec66ebc3d25b6a8062d101f2340f21a09f3d3d38\n \n Otherwise most of the network tests are skipped.\n] \n\n[ci: add ghc-9.0 to the matrix\nBen Franksen **20211102115521\n Ignore-this: 59fe796c2aef30e6e5ad81364eca47d4e53ec6f9c27e34285a8c1ab0bce6784aa24b7b38f5d1027c\n] \n\n[ci: always use the \"latest\" version of cabal\nBen Franksen **20211103113421\n Ignore-this: de44ad0f54458cfd19542eed22d590b2bcc1b544099524942e61deb66534e2db627d2123c46c4863\n \n Including several cabal versions in the build matrix is problematic for\n caching and blows up resource usage unreasonably. Besides, cabal-3.2 cannot\n be used with ghc > 8.10, which would then require more exceptions.\n] \n\n[ci: actions/setup-haskell -> haskell/actions/setup\nBen Franksen **20211102112845\n Ignore-this: 10bba56fd4f20a8b9ca2e0c89bd90ed8517bcff7c86eb0d3d3d36492461adddae917281feffc9ede\n \n The former is no longer maintained. Also let haskell/actions/setup choose\n the precise versions and specify only the first two version components. This\n is more robust and allows us to remove the macOS-10.15/ghc-8.10.4 exception.\n] \n\n[fix for tests/network/external.sh failure on ubuntu with ghc-8.10\nBen Franksen **20211102161252\n Ignore-this: 631c34c194838119d7eb847403e6d5033739ac1f1833350f5d063953fe982a7973444dcce3c5e70\n \n This also slightly re-organizes the script to make it easier to understand\n what's going on.\n] \n\n[ci: redesign caching of cabal store and dist-newstyle\nBen Franksen **20211103113842\n Ignore-this: e96d0c04ade05e53ef511786f33892e8186bcef0cc96c0e5ed95b1c522ba9006c93ebf77044586f3\n] \n\n[tests/broken_move.sh: adapt to better apply error messages\nBen Franksen **20210317074545\n Ignore-this: 999e8c6a0f46b5b2084dca38822af25cf68c9e324f3a5a3e5329397d774d95993cac3c3b9667eb6a\n] \n\n[TreeMonad: add two comments and some code re-formatting\nBen Franksen **20210620072923\n Ignore-this: 18cf64425f9a03312e6c14b831b68fef1f249bd4ab6ec408a6a3661919283917c985f2f9eb832988\n] \n\n[TreeMonad: more fine grained error checks\nBen Franksen **20210323144929\n Ignore-this: d49beba317aca1d06c5e94226644e7d5d277cae2915db05eb500782aa589cdb014f79f74f08cfa71\n \n In particular, 'readFile' and 'writeFile' now distinguish between\n non-existence and inappropriate type (directory), and 'copy' throws an\n exception when the source item does not exist instead of doing nothing.\n Since System.IO.Error does not export a function to construct an\n InappropriateType IOError, we no longer use the constructor functions, but\n instead import the IOErrorType from GHC.IO.Exception.\n] \n\n[TreeMonad: explicit import of D.U.Path, some simplifications\nBen Franksen **20210316072251\n Ignore-this: bd080c44431b62746a21a1f508eb3a1b03f41993494e26290d09b16eb92f2f9af9849eb781ca92e6\n] \n\n[TreeMonad: factor out findItem\nBen Franksen **20210620070138\n Ignore-this: 956660de8d73e6595a8d895a3b3810a49d4e21e41f8b20701f1dbd7c7925d2126090cfc0344509b6\n \n This will later allow us to throw more precise exceptions.\n] \n\n[better error handling when applying patches\nBen Franksen **20210314220059\n Ignore-this: 7435723695779f02418fae12f5326c3b029a23ba9dd1aa67cbce525f41c74dca35f7cea67476426d\n \n In the TreeMonad we now throw the IO errors that fit the situation instead\n of userError. This allows us to give getter warning messages when using\n runTolerantly. In addition, if we cannot run tolerantly, i.e. when we apply\n patches to pristine, we now notify the user which patch caused the problem\n and suggest to run 'darcs repair' on the repo that contains the broken\n patch. This is important because we no longer silently ignore broken move\n patches.\n] \n\n[re-write of release/gen-version-info.hs\nBen Franksen **20210710073431\n Ignore-this: 974d34cc9a9940dde3ea8a93b076edfb1e4a16ccd7cc2cd62a52be42e585c3b2204c4a6e3277cde2\n \n This simplifies the logic but also replaces the test for existence of _darcs\n with catching all IOExceptions. This makes it more robust in case executing\n darcs fails for some other reason.\n] \n\n[release/gen-version-info.hs: fix missing check for existence of _darcs\nBen Franksen **20210707115839\n Ignore-this: 9ef1aae66c2e75f6232bedb06ece11aee9f213691f5e3d422e1c6bb38d5957b8aab411b14eaa610b\n] \n\n[HasCallStack: withCurrentDirectory, withRepoDir\nBen Franksen **20210708183714\n Ignore-this: d43f561a9683aefc36d78b7664c5c4bdc09e883f23ae60d53101b18eea330cbb6731889c66a21ca5\n] \n\n[fix in checkSuspendedStatus and maybeDisplaySuspendedStatus\nBen Franksen **20210228104448\n Ignore-this: 6c90b32f275a99e6d66cdd05bac997aaa1dae3a1694db9326e4c1fa979a57798cee6f34e83c308cd\n \n We must not try to access either of the rebase patch files if the repo\n location is a remote URL.\n] \n\n[setCurrentDirectory: call error if argument is a remote URL\nBen Franksen **20210708083314\n Ignore-this: 6435e3d0c3b580f680958acb56b67f0f6e5c71ae536770628c3a8f134476ffad9cc519e5315e01a\n] \n\n[resolve issue2682: conflict not marked if tag pulled at the same time\nBen Franksen **20210705075417\n Ignore-this: 3527f75992b5d674be9d5f3e7347b5bdb2a27d326c8cf53676523be0f7860fd0abd6825dcc08569d\n \n The fix is to consider a conflict as resolved only if all conflicting\n patches are (transitively) explicitly depended on by a single patch.\n] \n\n[avoid use of the instance Named (Conflict p) for rebase unsuspend\nBen Franksen **20210705112751\n Ignore-this: 99246554ea7f171c551fc57cbdfc8d882e8a7cd68460abbf3c44ff96dfdca1f730ea23ac44779b8c\n \n This is so that the fix for issue2682 does not break rebase unsuspend, but\n it also makes sense independently: when unsuspending patches we definitely\n don't want explicit dependencies to count as conflict resolutions.\n] \n\n[add findConflicting to Darcs.Patch.Conflict\nBen Franksen **20210704212926\n Ignore-this: c8d14eed7ca3a261a4c6000b448135e016b2a6f5613d4d16d40b908dee40994a47c1b0ec1064b4c8\n] \n\n[re-add isConflicted method to class Conflict\nBen Franksen **20210704210248\n Ignore-this: e6fda415ff4ed6ea7a079f717f20d7d615edcbbdb3c85076a66c526c4fb1ba075fff8a630c2715b3\n] \n\n[improve test for issue2682\nBen Franksen **20210706160306\n Ignore-this: 68ebd0188216cd1a9005f4967e81791db5d38c92a195b15e89490117093e4698db9f06b3ddddc4f3\n] \n\n[accept issue2682\nBen Franksen **20210705074510\n Ignore-this: 92f39b09069c18d1ff3189cb4140fbe9add83d400b09b1056f41d4ac7b42a63b11fc4c948662d0ec\n] \n\n[decouple IsPrimV1 from ApplyState p ~ Tree, simplify runJob\nBen Franksen **20210323143203\n Ignore-this: 7831d21dc0347f2a8edfcd5d27363f04bf3213d5117acdb23f4778b545ca54ae3847fdcd2acb0509\n \n The extra 'ApplyState p ~ Tree' constraint was only for convenience, the\n same effect is achieved with a separate call to checkTree. The rest of the\n changes is replacing case matches with 'Dict <- return checkXxx' which I\n find leads to more readable code because it avoids extra indentation. And\n since all cases of runJob require the 'ApplyState p ~ Tree' constraint\n anyway, we can now float the checkTree out of the large case expression.\n] \n\n[get rid of \"nasty hack\" in applyPatchesForRebaseCmd\nBen Franksen **20210302104856\n Ignore-this: 4a83d729e21985c54f7431099874563338df07e206c87e680d80c8b5a032b5a3c2c5b5465fac63f3\n] \n\n[make pending and unrevert follow transaction protocol\nBen Franksen **20210302092935\n Ignore-this: b5d9d59fc0d03a6dfc1a67507a035a59e5a1350f784ced55780cd19b70faca606ae9f7a623e8c72d\n \n This means that all modifications are made to the tentative versions and\n that we define and systematically use revert/finalize.\n \n Note that the implementations of revertTentativeUnrevert and\n finalizeTentativeUnrevert are tricky: the case where we have no unrevert\n bundle present must be handled carefully.\n] \n\n[make D.R.Traverse procedures RW so they work on the tentative state\nBen Franksen **20210303141232\n Ignore-this: bc5346f4bf3470f5189972bac38a7cbd615b2af86293448910dd4c27dcb3004667b6ceb5056bfeee\n \n This required fixing convert import where cleanRepository was called after\n finalizing the transaction.\n] \n\n[remove the tentative state witness parameter for Repository\nBen Franksen **20210301151635\n Ignore-this: d2baeed808cbb74b9a12361abe84f090d8e7e5db6d787c0ba1943c14a17a8f71ecc6e1c26d4fc8cc\n \n Since we now distinguish at the type level and at runtime whether we are in\n a transaction or not, it no longer makes sense to keep the distinction\n between the recorded and the tentative state: inside a transaction the\n recorded state is irrelevant and should be ignored, while outside a\n transaction the tentative state should be ignored and only the recorded\n state is relevant. When we start a transaction both states coincide by\n definition (we throw away any existing tentative state). When we end a\n transaction, we throw away the recorded state and overwrite it with the\n tentative one.\n \n Note that not all of Darcs.Repository has been changed yet to follow the\n transaction protocol yet, in particular the pending and unrevert states.\n This will be done in a later patch because the distinction between recorded\n and tentative state gets in the way of making the decision at runtime when\n reading the state. Also note that while this patch touches many lines of\n code, the changes are very systematic and mostly mechanical.\n] \n\n[fix rt ~ 'RO in AskAboutDeps\nBen Franksen **20210301152702\n Ignore-this: a7407c6f80e3eb5875536ce8fc7a670f138961589efc005811c178f402d9526417089761c838ca6c\n] \n\n[replace readTentativePristine with the generalized readPristine\nBen Franksen **20210227101454\n Ignore-this: d9d1cf61973e9ab95dc708b373f7aadd3e272ff4165eec573ab5e1f44c12581c87c093abd3dd3407\n \n The latter now now does the right thing for both RO and RW repos.\n] \n\n[convert D.R.Pristine to assign the correct access type parameters\nBen Franksen **20210227102318\n Ignore-this: 63c809826e1067304cb7ce41218b14618e17244bc9a3d96c321659b8a1426735f9ef9d791203d821\n \n The same schema as in D.R.Hashed applies: functions that modify the\n tentative pristine are only available for 'RW typed repos, those that only\n read pristine decide at runtime which files to read and stay polymorphic.\n \n A special (and ugly) case is replacePristine which has a case for 'RO typed\n repos, which should only be used when creating a fresh repo. The 'RW case\n now modifies the tentative pristine, so we need to add missing finalization\n in the repair and optimize pristine commands.\n] \n\n[convert size-prefixed pristine when we start a transaction\nBen Franksen **20210227084925\n Ignore-this: c65c10432771c40ca52a6ff0d8598d6495129c95c08e01725187bc3191670461c92244bf73c3a5c5\n \n We must not modify _darcs/hashed_inventory except when finalizing a\n transaction.\n] \n\n[writeTentativeInventory now takes a Repository argument\nBen Franksen **20210225212710\n Ignore-this: c90aad2cd771f5819bf7f488282a5562d1bc7ed41884f575d757670746c6f87b398db2ce30692e8\n] \n\n[lock/unlock inside revert/finalizeRepositoryChanges\nBen Franksen **20210225115451\n Ignore-this: a79c711ff6321244cce72b943864c639f49d362a296fbb5a34b7c805c6b88eb6e7469460e9354cf1\n \n This has the disadvantage that intermediate commits also unlock the\n repository for a short time. However, intermediate commits are mostly\n unnecessary, the only remaining instance is in convert darcs-2, which will\n soon become obsolete anyway.\n] \n\n[convert D.R.Hashed functions to take access typed Repository\nBen Franksen **20210225154559\n Ignore-this: ab05083221ceaa72f2558fbc88b0ca8e4027c5aaf985cfa085f6233ff9c9f6215a77eb1fd34490dc\n \n All procedures in D.R.Hashed that access the tentative state now take a\n Repository 'RW, while 'readPatches' stays polymorphic, but reads the\n tentative or the recorded state, depending on the Repository access type\n parameter. This required to export SAccessType from D.R.InternalTypes and\n return that type from repoAccessType, so that pattern matching on the result\n forces unification of the Repository's access type.\n] \n\n[re-type the rt type parameter to AccessType=RO|RW\nBen Franksen **20210224230403\n Ignore-this: 58799b29145cd3924411fd902ab7e49772d5950a77a159bfd6d31d6ef6370c8d92184cbf9a875455\n \n This patch does not yet go the full way of changing all Repository access\n procedures, only some of the central pieces: revertRepositoryChanges and\n finalizeRepositoryChanges, withRepoLock, repo creation and identification.\n Commands that call withRepoLock now take the lock even when --dry-run is in\n effect. This fixes a potential race condition because in dry-run mode these\n commands still modified the tentative state on disk. Instead, the dry-run\n option is now evaluated in the finalizing procedures (which includes,\n currently, addPendingDiffToPending and addToPending).\n] \n\n[remove rt::RepoType type parameter from PatchSet and PatchInfoAnd\nBen Franksen **20210224225716\n Ignore-this: 21347143ab31dc16399b2b1d7145f88d715d713d92a0f05c74cb6a32948c392a9aa7fe2ea2790a3a\n] \n\n[remove most of Darcs.Patch.RepoType\nBen Franksen **20210119150023\n Ignore-this: eee8e2332d551296501be870481b04f1d24ef7356ca9c7c91fe3a37c0d000b953b0d9064cefe2aad\n \n This removes the type distinction between repos with and without a rebase in\n progress. The 'rt :: RepoType' type parameter (and its kind RepoType) are\n kept for now, in case we ever want to re-introduce such a type distinction\n for some other purpose.\n] \n\n[TAG 2.17.2\nBen Franksen **20220513093526\n Ignore-this: bda65bc3dc68d0ee3af31fa6bf420ee54967539a84e0ac324bc7b680cb38da7ec5cdf9b1c8efe68e\n] \n" \ No newline at end of file diff --git a/release/distributed-version b/release/distributed-version index 78dc9d3a..e76d7970 100644 --- a/release/distributed-version +++ b/release/distributed-version @@ -1 +1 @@ -Just 17 \ No newline at end of file +Just 447 \ No newline at end of file diff --git a/release/release.sh b/release/release.sh old mode 100755 new mode 100644 index 5eb83e1a..1c38f9c0 --- a/release/release.sh +++ b/release/release.sh @@ -13,7 +13,7 @@ set -x darcs log -t $VERSION darcs log -t $VERSION | grep -q $VERSION -runghc release/gen-version-info.hs $VERSION +cabal run release/gen-version-info.hs $VERSION tarballpath=$(cabal sdist | tail -1) test -f $tarballpath diff --git a/release/trigger-ci b/release/trigger-ci old mode 100755 new mode 100644 diff --git a/shelly/test/examples/drain.sh b/shelly/test/examples/drain.sh old mode 100755 new mode 100644 diff --git a/shelly/test/examples/printer.sh b/shelly/test/examples/printer.sh old mode 100755 new mode 100644 diff --git a/shelly/test/examples/test.sh b/shelly/test/examples/test.sh old mode 100755 new mode 100644 diff --git a/shelly/test/testall b/shelly/test/testall old mode 100755 new mode 100644 diff --git a/stack.yaml b/stack.yaml index efba5280..67e95c64 100644 --- a/stack.yaml +++ b/stack.yaml @@ -4,9 +4,5 @@ packages: - . extra-deps: -- Cabal-syntax-3.10.3.0 -- crypton-connection-0.4.0 -- directory-1.3.8.5 -- haskeline-0.8.2.1 -- process-1.6.20.0 - strict-identity-0.1.0.0 +- safe-0.3.21 diff --git a/tests/EXAMPLE.sh b/tests/EXAMPLE.sh old mode 100755 new mode 100644 diff --git a/tests/add.sh b/tests/add.sh old mode 100755 new mode 100644 diff --git a/tests/add_permissions.sh b/tests/add_permissions.sh old mode 100755 new mode 100644 diff --git a/tests/amend.sh b/tests/amend.sh old mode 100755 new mode 100644 diff --git a/tests/annotate.sh b/tests/annotate.sh old mode 100755 new mode 100644 diff --git a/tests/apply-reorder.sh b/tests/apply-reorder.sh old mode 100755 new mode 100644 diff --git a/tests/apply-unclean-tag.sh b/tests/apply-unclean-tag.sh old mode 100755 new mode 100644 diff --git a/tests/apply.sh b/tests/apply.sh old mode 100755 new mode 100644 diff --git a/tests/argument_parsing.sh b/tests/argument_parsing.sh old mode 100755 new mode 100644 diff --git a/tests/ask_deps.sh b/tests/ask_deps.sh old mode 100755 new mode 100644 diff --git a/tests/bad-format.sh b/tests/bad-format.sh old mode 100755 new mode 100644 diff --git a/tests/bin/convert-writer.sh b/tests/bin/convert-writer.sh old mode 100755 new mode 100644 diff --git a/tests/binary.sh b/tests/binary.sh old mode 100755 new mode 100644 diff --git a/tests/boring-files.sh b/tests/boring-files.sh old mode 100755 new mode 100644 diff --git a/tests/broken_move.sh b/tests/broken_move.sh old mode 100755 new mode 100644 diff --git a/tests/broken_pending.sh b/tests/broken_pending.sh old mode 100755 new mode 100644 diff --git a/tests/clean-command.sh b/tests/clean-command.sh old mode 100755 new mode 100644 diff --git a/tests/clone.sh b/tests/clone.sh old mode 100755 new mode 100644 diff --git a/tests/conflict-chain-resolution.sh b/tests/conflict-chain-resolution.sh old mode 100755 new mode 100644 diff --git a/tests/conflict-depends-resolution.sh b/tests/conflict-depends-resolution.sh old mode 100755 new mode 100644 diff --git a/tests/conflict-doppleganger.sh b/tests/conflict-doppleganger.sh old mode 100755 new mode 100644 diff --git a/tests/conflict-fight-failure.sh b/tests/conflict-fight-failure.sh old mode 100755 new mode 100644 diff --git a/tests/conflict-fight.sh b/tests/conflict-fight.sh old mode 100755 new mode 100644 diff --git a/tests/conflict-reporting.sh b/tests/conflict-reporting.sh old mode 100755 new mode 100644 diff --git a/tests/convert-darcs2.sh b/tests/convert-darcs2.sh old mode 100755 new mode 100644 diff --git a/tests/convert-import-export-non-ascii.sh b/tests/convert-import-export-non-ascii.sh old mode 100755 new mode 100644 diff --git a/tests/convert_export.sh b/tests/convert_export.sh old mode 100755 new mode 100644 diff --git a/tests/decoalesce-add-remove.sh b/tests/decoalesce-add-remove.sh old mode 100755 new mode 100644 diff --git a/tests/decoalesce-move.sh b/tests/decoalesce-move.sh old mode 100755 new mode 100644 diff --git a/tests/decoalesce-replace.sh b/tests/decoalesce-replace.sh old mode 100755 new mode 100644 diff --git a/tests/decoalesce-rmdir.sh b/tests/decoalesce-rmdir.sh old mode 100755 new mode 100644 diff --git a/tests/decoalesce-split.sh b/tests/decoalesce-split.sh old mode 100755 new mode 100644 diff --git a/tests/devnull.sh b/tests/devnull.sh old mode 100755 new mode 100644 diff --git a/tests/diff.sh b/tests/diff.sh old mode 100755 new mode 100644 diff --git a/tests/disable.sh b/tests/disable.sh old mode 100755 new mode 100644 diff --git a/tests/dist.sh b/tests/dist.sh old mode 100755 new mode 100644 diff --git a/tests/emailformat.sh b/tests/emailformat.sh old mode 100755 new mode 100644 diff --git a/tests/empty_inventory.sh b/tests/empty_inventory.sh old mode 100755 new mode 100644 diff --git a/tests/external-resolution.sh b/tests/external-resolution.sh old mode 100755 new mode 100644 diff --git a/tests/failed-amend-should-not-break-repo.sh b/tests/failed-amend-should-not-break-repo.sh old mode 100755 new mode 100644 diff --git a/tests/failing-index-argument.sh b/tests/failing-index-argument.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue1190_unmarked_hunk_replace_conflict.sh b/tests/failing-issue1190_unmarked_hunk_replace_conflict.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue1317_list-options_subdir.sh b/tests/failing-issue1317_list-options_subdir.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue1396_changepref-conflict.sh b/tests/failing-issue1396_changepref-conflict.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue1406.sh b/tests/failing-issue1406.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue1461_case_folding.sh b/tests/failing-issue1461_case_folding.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue1577-revert-deletes-new-files.sh b/tests/failing-issue1577-revert-deletes-new-files.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue1610_get_extra.sh b/tests/failing-issue1610_get_extra.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue1702-optimize-relink-vs-cache.sh b/tests/failing-issue1702-optimize-relink-vs-cache.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue1790_darcs-send.sh b/tests/failing-issue1790_darcs-send.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue1829-inconsistent-conflictor.sh b/tests/failing-issue1829-inconsistent-conflictor.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue1926_amend-record_ignores_--index.sh b/tests/failing-issue1926_amend-record_ignores_--index.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue2100-add-failures.sh b/tests/failing-issue2100-add-failures.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue2138-whatsnew-s.sh b/tests/failing-issue2138-whatsnew-s.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue2186-apply--reply-conflict.sh b/tests/failing-issue2186-apply--reply-conflict.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue2186-apply--reply-ok.sh b/tests/failing-issue2186-apply--reply-ok.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue2187-apply--test-non-interactive.sh b/tests/failing-issue2187-apply--test-non-interactive.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue2203-only-list-toplevel-deleted-dirs.sh b/tests/failing-issue2203-only-list-toplevel-deleted-dirs.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue2213-lastregrets-dependencies.sh b/tests/failing-issue2213-lastregrets-dependencies.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue2219-no-working.sh b/tests/failing-issue2219-no-working.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue2234-rollback-under-tag-with-filename.sh b/tests/failing-issue2234-rollback-under-tag-with-filename.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue2256-diff-empty-argument.sh b/tests/failing-issue2256-diff-empty-argument.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue2272-rebase-unsuspend-copes-with-unrecorded-changes.sh b/tests/failing-issue2272-rebase-unsuspend-copes-with-unrecorded-changes.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue2303-diagnostic-for-bad-patch-index-permissions.sh b/tests/failing-issue2303-diagnostic-for-bad-patch-index-permissions.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue2383-hunk-edit-fails.sh b/tests/failing-issue2383-hunk-edit-fails.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue2386-no-trailing-EOL.sh b/tests/failing-issue2386-no-trailing-EOL.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue2443-timestamp_index_keeps_unrecorded_addfile.sh b/tests/failing-issue2443-timestamp_index_keeps_unrecorded_addfile.sh old mode 100755 new mode 100644 diff --git a/tests/failing-issue390_whatsnew.sh b/tests/failing-issue390_whatsnew.sh old mode 100755 new mode 100644 diff --git a/tests/failing-merging_newlines.sh b/tests/failing-merging_newlines.sh old mode 100755 new mode 100644 diff --git a/tests/failing-newlines.sh b/tests/failing-newlines.sh old mode 100755 new mode 100644 diff --git a/tests/failing-nice-resolutions.sh b/tests/failing-nice-resolutions.sh old mode 100755 new mode 100644 diff --git a/tests/failing-pristine-problems.sh b/tests/failing-pristine-problems.sh old mode 100755 new mode 100644 diff --git a/tests/failing-rebase-conflicting.sh b/tests/failing-rebase-conflicting.sh old mode 100755 new mode 100644 diff --git a/tests/failing-record-scaling.sh b/tests/failing-record-scaling.sh old mode 100755 new mode 100644 diff --git a/tests/filepath.sh b/tests/filepath.sh old mode 100755 new mode 100644 diff --git a/tests/git_import_delete_empty_directories.sh b/tests/git_import_delete_empty_directories.sh old mode 100755 new mode 100644 diff --git a/tests/git_quoted_filenames.sh b/tests/git_quoted_filenames.sh old mode 100755 new mode 100644 diff --git a/tests/git_rename_and_copy_files.sh b/tests/git_rename_and_copy_files.sh old mode 100755 new mode 100644 diff --git a/tests/git_rename_dir.sh b/tests/git_rename_dir.sh old mode 100755 new mode 100644 diff --git a/tests/gzcrcs.sh b/tests/gzcrcs.sh old mode 100755 new mode 100644 diff --git a/tests/harness.sh b/tests/harness.sh old mode 100755 new mode 100644 diff --git a/tests/hashed_inventory.sh b/tests/hashed_inventory.sh old mode 100755 new mode 100644 diff --git a/tests/hidden_conflict.sh b/tests/hidden_conflict.sh old mode 100755 new mode 100644 diff --git a/tests/hidden_conflict2.sh b/tests/hidden_conflict2.sh old mode 100755 new mode 100644 diff --git a/tests/hijack.sh b/tests/hijack.sh old mode 100755 new mode 100644 diff --git a/tests/hunk-editor.sh b/tests/hunk-editor.sh old mode 100755 new mode 100644 diff --git a/tests/ignore-this.sh b/tests/ignore-this.sh old mode 100755 new mode 100644 diff --git a/tests/ignoretimes.sh b/tests/ignoretimes.sh old mode 100755 new mode 100644 diff --git a/tests/inherit-default.sh b/tests/inherit-default.sh old mode 100755 new mode 100644 diff --git a/tests/init.sh b/tests/init.sh old mode 100755 new mode 100644 diff --git a/tests/invalid_absolute_paths.sh b/tests/invalid_absolute_paths.sh old mode 100755 new mode 100644 diff --git a/tests/invalid_pending_after_mv_to_self.sh b/tests/invalid_pending_after_mv_to_self.sh old mode 100755 new mode 100644 diff --git a/tests/issue1014_identical_patches.sh b/tests/issue1014_identical_patches.sh old mode 100755 new mode 100644 diff --git a/tests/issue1017_whatsnew_stack.sh b/tests/issue1017_whatsnew_stack.sh old mode 100755 new mode 100644 diff --git a/tests/issue1039.sh b/tests/issue1039.sh old mode 100755 new mode 100644 diff --git a/tests/issue1043_geteff_a.sh b/tests/issue1043_geteff_a.sh old mode 100755 new mode 100644 diff --git a/tests/issue1043_geteff_b.sh b/tests/issue1043_geteff_b.sh old mode 100755 new mode 100644 diff --git a/tests/issue1057-pull-from-current-repo-via-symlink.sh b/tests/issue1057-pull-from-current-repo-via-symlink.sh old mode 100755 new mode 100644 diff --git a/tests/issue1078_symlink.sh b/tests/issue1078_symlink.sh old mode 100755 new mode 100644 diff --git a/tests/issue1101.sh b/tests/issue1101.sh old mode 100755 new mode 100644 diff --git a/tests/issue1105.sh b/tests/issue1105.sh old mode 100755 new mode 100644 diff --git a/tests/issue1196_whatsnew_falsely_lists_all_changes.sh b/tests/issue1196_whatsnew_falsely_lists_all_changes.sh old mode 100755 new mode 100644 diff --git a/tests/issue121-amend-ask-deps.sh b/tests/issue121-amend-ask-deps.sh old mode 100755 new mode 100644 diff --git a/tests/issue1210-no-global-cache-in-sources.sh b/tests/issue1210-no-global-cache-in-sources.sh old mode 100755 new mode 100644 diff --git a/tests/issue1224_convert-darcs2-repository.sh b/tests/issue1224_convert-darcs2-repository.sh old mode 100755 new mode 100644 diff --git a/tests/issue1269_setpref_predist.sh b/tests/issue1269_setpref_predist.sh old mode 100755 new mode 100644 diff --git a/tests/issue1277-repo-format.sh b/tests/issue1277-repo-format.sh old mode 100755 new mode 100644 diff --git a/tests/issue1300_record_delete-file.sh b/tests/issue1300_record_delete-file.sh old mode 100755 new mode 100644 diff --git a/tests/issue1316-2.sh b/tests/issue1316-2.sh old mode 100755 new mode 100644 diff --git a/tests/issue1316.sh b/tests/issue1316.sh old mode 100755 new mode 100644 diff --git a/tests/issue1325_pending_minimisation.sh b/tests/issue1325_pending_minimisation.sh old mode 100755 new mode 100644 diff --git a/tests/issue1327.sh b/tests/issue1327.sh old mode 100755 new mode 100644 diff --git a/tests/issue1332_add_r_boring.sh b/tests/issue1332_add_r_boring.sh old mode 100755 new mode 100644 diff --git a/tests/issue1344_abort_early_cant_send.sh b/tests/issue1344_abort_early_cant_send.sh old mode 100755 new mode 100644 diff --git a/tests/issue1373_replace_token_chars.sh b/tests/issue1373_replace_token_chars.sh old mode 100755 new mode 100644 diff --git a/tests/issue1392_authorspelling.sh b/tests/issue1392_authorspelling.sh old mode 100755 new mode 100644 diff --git a/tests/issue1401_bug_in_get_extra.sh b/tests/issue1401_bug_in_get_extra.sh old mode 100755 new mode 100644 diff --git a/tests/issue1442_encoding_round-trip.sh b/tests/issue1442_encoding_round-trip.sh old mode 100755 new mode 100644 diff --git a/tests/issue1446.sh b/tests/issue1446.sh old mode 100755 new mode 100644 diff --git a/tests/issue1465_ortryrunning.sh b/tests/issue1465_ortryrunning.sh old mode 100755 new mode 100644 diff --git a/tests/issue1488_whatsnew-l.sh b/tests/issue1488_whatsnew-l.sh old mode 100755 new mode 100644 diff --git a/tests/issue1514-send-minimize.sh b/tests/issue1514-send-minimize.sh old mode 100755 new mode 100644 diff --git a/tests/issue1522_trailing_slash_borkage.sh b/tests/issue1522_trailing_slash_borkage.sh old mode 100755 new mode 100644 diff --git a/tests/issue154_pull_dir_not_empty.sh b/tests/issue154_pull_dir_not_empty.sh old mode 100755 new mode 100644 diff --git a/tests/issue1558_xml_output_gz_extension.sh b/tests/issue1558_xml_output_gz_extension.sh old mode 100755 new mode 100644 diff --git a/tests/issue1579_diff_opts.sh b/tests/issue1579_diff_opts.sh old mode 100755 new mode 100644 diff --git a/tests/issue1609-conflict-markup-depends-on-patch-order.sh b/tests/issue1609-conflict-markup-depends-on-patch-order.sh old mode 100755 new mode 100644 diff --git a/tests/issue1611_amend-tag.sh b/tests/issue1611_amend-tag.sh old mode 100755 new mode 100644 diff --git a/tests/issue1618-amend-preserve-logfile.sh b/tests/issue1618-amend-preserve-logfile.sh old mode 100755 new mode 100644 diff --git a/tests/issue1620-record-lies-about-leaving-logfile.sh b/tests/issue1620-record-lies-about-leaving-logfile.sh old mode 100755 new mode 100644 diff --git a/tests/issue1636-match-hunk.sh b/tests/issue1636-match-hunk.sh old mode 100755 new mode 100644 diff --git a/tests/issue1640_apply_stdin.sh b/tests/issue1640_apply_stdin.sh old mode 100755 new mode 100644 diff --git a/tests/issue1645-ignore-symlinks-case-fold.sh b/tests/issue1645-ignore-symlinks-case-fold.sh old mode 100755 new mode 100644 diff --git a/tests/issue1645-ignore-symlinks.sh b/tests/issue1645-ignore-symlinks.sh old mode 100755 new mode 100644 diff --git a/tests/issue1726_darcs_always-boring.sh b/tests/issue1726_darcs_always-boring.sh old mode 100755 new mode 100644 diff --git a/tests/issue1727_move_current_directory.sh b/tests/issue1727_move_current_directory.sh old mode 100755 new mode 100644 diff --git a/tests/issue1737-move_args.sh b/tests/issue1737-move_args.sh old mode 100755 new mode 100644 diff --git a/tests/issue1739-escape-multibyte-chars-correctly.sh b/tests/issue1739-escape-multibyte-chars-correctly.sh old mode 100755 new mode 100644 diff --git a/tests/issue1740-mv-dir.sh b/tests/issue1740-mv-dir.sh old mode 100755 new mode 100644 diff --git a/tests/issue174_obliterate_before_a_tag.sh b/tests/issue174_obliterate_before_a_tag.sh old mode 100755 new mode 100644 diff --git a/tests/issue1756_moves_index.sh b/tests/issue1756_moves_index.sh old mode 100755 new mode 100644 diff --git a/tests/issue1763-pull-fails-on-non-ascii-filenames.sh b/tests/issue1763-pull-fails-on-non-ascii-filenames.sh old mode 100755 new mode 100644 diff --git a/tests/issue1819-pull-dont-allow-conflicts.sh b/tests/issue1819-pull-dont-allow-conflicts.sh old mode 100755 new mode 100644 diff --git a/tests/issue1825-remove-pending.sh b/tests/issue1825-remove-pending.sh old mode 100755 new mode 100644 diff --git a/tests/issue183_mv_order.sh b/tests/issue183_mv_order.sh old mode 100755 new mode 100644 diff --git a/tests/issue1845-paths-working-copy.sh b/tests/issue1845-paths-working-copy.sh old mode 100755 new mode 100644 diff --git a/tests/issue1857-pristine-conversion.sh b/tests/issue1857-pristine-conversion.sh old mode 100755 new mode 100644 diff --git a/tests/issue1860-incomplete-pristine.sh b/tests/issue1860-incomplete-pristine.sh old mode 100755 new mode 100644 diff --git a/tests/issue1875-honor-no-set-default.sh b/tests/issue1875-honor-no-set-default.sh old mode 100755 new mode 100644 diff --git a/tests/issue1877_noisy_xml_output.sh b/tests/issue1877_noisy_xml_output.sh old mode 100755 new mode 100644 diff --git a/tests/issue1879-same-patchinfo-uncommon.sh b/tests/issue1879-same-patchinfo-uncommon.sh old mode 100755 new mode 100644 diff --git a/tests/issue189-external-merge-move.sh b/tests/issue189-external-merge-move.sh old mode 100755 new mode 100644 diff --git a/tests/issue1898-set-default-notification.sh b/tests/issue1898-set-default-notification.sh old mode 100755 new mode 100644 diff --git a/tests/issue1909-unrecord-O-misses-tag.sh b/tests/issue1909-unrecord-O-misses-tag.sh old mode 100755 new mode 100644 diff --git a/tests/issue1913-diffing.sh b/tests/issue1913-diffing.sh old mode 100755 new mode 100644 diff --git a/tests/issue1922-obliterate-o-context.sh b/tests/issue1922-obliterate-o-context.sh old mode 100755 new mode 100644 diff --git a/tests/issue1928-file-dir-replace.sh b/tests/issue1928-file-dir-replace.sh old mode 100755 new mode 100644 diff --git a/tests/issue1932-colon-breaks-add.sh b/tests/issue1932-colon-breaks-add.sh old mode 100755 new mode 100644 diff --git a/tests/issue1951-add-outside-repo.sh b/tests/issue1951-add-outside-repo.sh old mode 100755 new mode 100644 diff --git a/tests/issue1959-unwritable-darcsdir.sh b/tests/issue1959-unwritable-darcsdir.sh old mode 100755 new mode 100644 diff --git a/tests/issue1978.sh b/tests/issue1978.sh old mode 100755 new mode 100644 diff --git a/tests/issue1987.sh b/tests/issue1987.sh old mode 100755 new mode 100644 diff --git a/tests/issue2012_send_output_no_address.sh b/tests/issue2012_send_output_no_address.sh old mode 100755 new mode 100644 diff --git a/tests/issue2013_send_to_context.sh b/tests/issue2013_send_to_context.sh old mode 100755 new mode 100644 diff --git a/tests/issue2035-malicious-subpath.sh b/tests/issue2035-malicious-subpath.sh old mode 100755 new mode 100644 diff --git a/tests/issue2041_dont_add_symlinks.sh b/tests/issue2041_dont_add_symlinks.sh old mode 100755 new mode 100644 diff --git a/tests/issue2047_duplicate_conflictor_recommute_fail.sh b/tests/issue2047_duplicate_conflictor_recommute_fail.sh old mode 100755 new mode 100644 diff --git a/tests/issue2049-dir-case-change.sh b/tests/issue2049-dir-case-change.sh old mode 100755 new mode 100644 diff --git a/tests/issue2049-file-in-boring-dir.sh b/tests/issue2049-file-in-boring-dir.sh old mode 100755 new mode 100644 diff --git a/tests/issue2066_add_and_remove.sh b/tests/issue2066_add_and_remove.sh old mode 100755 new mode 100644 diff --git a/tests/issue2074.sh b/tests/issue2074.sh old mode 100755 new mode 100644 diff --git a/tests/issue2076-move_into_dir.sh b/tests/issue2076-move_into_dir.sh old mode 100755 new mode 100644 diff --git a/tests/issue2086-index-permissions.sh b/tests/issue2086-index-permissions.sh old mode 100755 new mode 100644 diff --git a/tests/issue2125-always-warn-forced-replace.sh b/tests/issue2125-always-warn-forced-replace.sh old mode 100755 new mode 100644 diff --git a/tests/issue2136-log_created_as_for_multiple_files.sh b/tests/issue2136-log_created_as_for_multiple_files.sh old mode 100755 new mode 100644 diff --git a/tests/issue2153-allow-skipping-backwards-through-depended_upon-patches.sh b/tests/issue2153-allow-skipping-backwards-through-depended_upon-patches.sh old mode 100755 new mode 100644 diff --git a/tests/issue2200-darcs-replace-no-paths.sh b/tests/issue2200-darcs-replace-no-paths.sh old mode 100755 new mode 100644 diff --git a/tests/issue2204-send-mail.sh b/tests/issue2204-send-mail.sh old mode 100755 new mode 100644 diff --git a/tests/issue2208-replace-fails-with-resolving-unrecorded-change.sh b/tests/issue2208-replace-fails-with-resolving-unrecorded-change.sh old mode 100755 new mode 100644 diff --git a/tests/issue2209-look_for_replaces.sh b/tests/issue2209-look_for_replaces.sh old mode 100755 new mode 100644 diff --git a/tests/issue2212-add-changes-pending-for-other-files.sh b/tests/issue2212-add-changes-pending-for-other-files.sh old mode 100755 new mode 100644 diff --git a/tests/issue2225-obliterate-not-in.sh b/tests/issue2225-obliterate-not-in.sh old mode 100755 new mode 100644 diff --git a/tests/issue2227-rebase-amend-record.sh b/tests/issue2227-rebase-amend-record.sh old mode 100755 new mode 100644 diff --git a/tests/issue2243-unknown-patch-annotating-empty-first-line.sh b/tests/issue2243-unknown-patch-annotating-empty-first-line.sh old mode 100755 new mode 100644 diff --git a/tests/issue2248-rebase-zero-suspended.sh b/tests/issue2248-rebase-zero-suspended.sh old mode 100755 new mode 100644 diff --git a/tests/issue2257-impossible-obliterate-subset.sh b/tests/issue2257-impossible-obliterate-subset.sh old mode 100755 new mode 100644 diff --git a/tests/issue2262-display_of_meta_data.sh b/tests/issue2262-display_of_meta_data.sh old mode 100755 new mode 100644 diff --git a/tests/issue2270-log-interactive-only-to-files.sh b/tests/issue2270-log-interactive-only-to-files.sh old mode 100755 new mode 100644 diff --git a/tests/issue2271-disable-patch-index.sh b/tests/issue2271-disable-patch-index.sh old mode 100755 new mode 100644 diff --git a/tests/issue2275_follows-symlinks.sh b/tests/issue2275_follows-symlinks.sh old mode 100755 new mode 100644 diff --git a/tests/issue2286-metadata-encoding.sh b/tests/issue2286-metadata-encoding.sh old mode 100755 new mode 100644 diff --git a/tests/issue2287_obliterate_overwrite.sh b/tests/issue2287_obliterate_overwrite.sh old mode 100755 new mode 100644 diff --git a/tests/issue2293-laziness.sh b/tests/issue2293-laziness.sh old mode 100755 new mode 100644 diff --git a/tests/issue2311_posthook_for_get_should_run_in_created_repo.sh b/tests/issue2311_posthook_for_get_should_run_in_created_repo.sh old mode 100755 new mode 100644 diff --git a/tests/issue2312_posthooks_for_record_and_amend-record_should_receive_DARCS_PATCHES.sh b/tests/issue2312_posthooks_for_record_and_amend-record_should_receive_DARCS_PATCHES.sh old mode 100755 new mode 100644 diff --git a/tests/issue2313-trailing-newlines-stack-overflow.sh b/tests/issue2313-trailing-newlines-stack-overflow.sh old mode 100755 new mode 100644 diff --git a/tests/issue2333.sh b/tests/issue2333.sh old mode 100755 new mode 100644 diff --git a/tests/issue2343.sh b/tests/issue2343.sh old mode 100755 new mode 100644 diff --git a/tests/issue2365-whatsnew-fails-get-no-working-dir.sh b/tests/issue2365-whatsnew-fails-get-no-working-dir.sh old mode 100755 new mode 100644 diff --git a/tests/issue2380-rename-to-deleted-file.sh b/tests/issue2380-rename-to-deleted-file.sh old mode 100755 new mode 100644 diff --git a/tests/issue2382-mv-dir-to-file-confuses-darcs.sh b/tests/issue2382-mv-dir-to-file-confuses-darcs.sh old mode 100755 new mode 100644 diff --git a/tests/issue2432-pull-reorder-commute.sh b/tests/issue2432-pull-reorder-commute.sh old mode 100755 new mode 100644 diff --git a/tests/issue2479-mv-list-files.sh b/tests/issue2479-mv-list-files.sh old mode 100755 new mode 100644 diff --git a/tests/issue2480-display-unicode-in-patch-content.sh b/tests/issue2480-display-unicode-in-patch-content.sh old mode 100755 new mode 100644 diff --git a/tests/issue2494-output-of-record-with-file-arguments.sh b/tests/issue2494-output-of-record-with-file-arguments.sh old mode 100755 new mode 100644 diff --git a/tests/issue2496-output-of-whatsnew-with-file-arguments.sh b/tests/issue2496-output-of-whatsnew-with-file-arguments.sh old mode 100755 new mode 100644 diff --git a/tests/issue2512-multiple-authors-clobbered-in-global-conf.sh b/tests/issue2512-multiple-authors-clobbered-in-global-conf.sh old mode 100755 new mode 100644 diff --git a/tests/issue2526-whatsnew-boring.sh b/tests/issue2526-whatsnew-boring.sh old mode 100755 new mode 100644 diff --git a/tests/issue2548-inconsistent-pending.sh b/tests/issue2548-inconsistent-pending.sh old mode 100755 new mode 100644 diff --git a/tests/issue2567-darcs-whatsnew-unified.sh b/tests/issue2567-darcs-whatsnew-unified.sh old mode 100755 new mode 100644 diff --git a/tests/issue257.sh b/tests/issue257.sh old mode 100755 new mode 100644 diff --git a/tests/issue2592-pending-look-for.sh b/tests/issue2592-pending-look-for.sh old mode 100755 new mode 100644 diff --git a/tests/issue2594-darcs-show-index-breaks-replace.sh b/tests/issue2594-darcs-show-index-breaks-replace.sh old mode 100755 new mode 100644 diff --git a/tests/issue2603-clone-repo-with-unresolved-conflicts.sh b/tests/issue2603-clone-repo-with-unresolved-conflicts.sh old mode 100755 new mode 100644 diff --git a/tests/issue2605-duplicates.sh b/tests/issue2605-duplicates.sh old mode 100755 new mode 100644 diff --git a/tests/issue2618-ask-deps-too-many.sh b/tests/issue2618-ask-deps-too-many.sh old mode 100755 new mode 100644 diff --git a/tests/issue2634-rebase-conflicted-patches.sh b/tests/issue2634-rebase-conflicted-patches.sh old mode 100755 new mode 100644 diff --git a/tests/issue2648_darcs_convert_import_double_encodes_cyrillic.sh b/tests/issue2648_darcs_convert_import_double_encodes_cyrillic.sh old mode 100755 new mode 100644 diff --git a/tests/issue2659-show-dependencies.sh b/tests/issue2659-show-dependencies.sh old mode 100755 new mode 100644 diff --git a/tests/issue2668-create-directory-permission.sh b/tests/issue2668-create-directory-permission.sh old mode 100755 new mode 100644 diff --git a/tests/issue2682.sh b/tests/issue2682.sh old mode 100755 new mode 100644 diff --git a/tests/issue2697-amend-unrecord.sh b/tests/issue2697-amend-unrecord.sh old mode 100755 new mode 100644 diff --git a/tests/issue27.sh b/tests/issue27.sh old mode 100755 new mode 100644 diff --git a/tests/issue2702-invalid-regex.sh b/tests/issue2702-invalid-regex.sh old mode 100755 new mode 100644 diff --git a/tests/issue279_get_extra.sh b/tests/issue279_get_extra.sh old mode 100755 new mode 100644 diff --git a/tests/issue381.sh b/tests/issue381.sh old mode 100755 new mode 100644 diff --git a/tests/issue436.sh b/tests/issue436.sh old mode 100755 new mode 100644 diff --git a/tests/issue458.sh b/tests/issue458.sh old mode 100755 new mode 100644 diff --git a/tests/issue494-pending-sort.sh b/tests/issue494-pending-sort.sh old mode 100755 new mode 100644 diff --git a/tests/issue525_amend_duplicates.sh b/tests/issue525_amend_duplicates.sh old mode 100755 new mode 100644 diff --git a/tests/issue53.sh b/tests/issue53.sh old mode 100755 new mode 100644 diff --git a/tests/issue538.sh b/tests/issue538.sh old mode 100755 new mode 100644 diff --git a/tests/issue588.sh b/tests/issue588.sh old mode 100755 new mode 100644 diff --git a/tests/issue595_get_permissions.sh b/tests/issue595_get_permissions.sh old mode 100755 new mode 100644 diff --git a/tests/issue612_repo_not_writable.sh b/tests/issue612_repo_not_writable.sh old mode 100755 new mode 100644 diff --git a/tests/issue68_broken_pipe.sh b/tests/issue68_broken_pipe.sh old mode 100755 new mode 100644 diff --git a/tests/issue691.sh b/tests/issue691.sh old mode 100755 new mode 100644 diff --git a/tests/issue701.sh b/tests/issue701.sh old mode 100755 new mode 100644 diff --git a/tests/issue706.sh b/tests/issue706.sh old mode 100755 new mode 100644 diff --git a/tests/issue709_pending_look-for-adds.sh b/tests/issue709_pending_look-for-adds.sh old mode 100755 new mode 100644 diff --git a/tests/issue70_setpref.sh b/tests/issue70_setpref.sh old mode 100755 new mode 100644 diff --git a/tests/issue761-fail-early-bad-pull-match.sh b/tests/issue761-fail-early-bad-pull-match.sh old mode 100755 new mode 100644 diff --git a/tests/issue803.sh b/tests/issue803.sh old mode 100755 new mode 100644 diff --git a/tests/issue844_gzip_crc.sh b/tests/issue844_gzip_crc.sh old mode 100755 new mode 100644 diff --git a/tests/issue942_push_apply_prehook.sh b/tests/issue942_push_apply_prehook.sh old mode 100755 new mode 100644 diff --git a/tests/latin9-input.sh b/tests/latin9-input.sh old mode 100755 new mode 100644 diff --git a/tests/lazy-optimize-reorder.sh b/tests/lazy-optimize-reorder.sh old mode 100755 new mode 100644 diff --git a/tests/legacy-inverted.sh b/tests/legacy-inverted.sh old mode 100755 new mode 100644 diff --git a/tests/list-options.sh b/tests/list-options.sh old mode 100755 new mode 100644 diff --git a/tests/log-duplicate.sh b/tests/log-duplicate.sh old mode 100755 new mode 100644 diff --git a/tests/log.sh b/tests/log.sh old mode 100755 new mode 100644 diff --git a/tests/log_send_context.sh b/tests/log_send_context.sh old mode 100755 new mode 100644 diff --git a/tests/look_for_add.sh b/tests/look_for_add.sh old mode 100755 new mode 100644 diff --git a/tests/look_for_moves.sh b/tests/look_for_moves.sh old mode 100755 new mode 100644 diff --git a/tests/look_for_moves_and_replaces.sh b/tests/look_for_moves_and_replaces.sh old mode 100755 new mode 100644 diff --git a/tests/look_for_moves_with_args.sh b/tests/look_for_moves_with_args.sh old mode 100755 new mode 100644 diff --git a/tests/look_for_replaces1.sh b/tests/look_for_replaces1.sh old mode 100755 new mode 100644 diff --git a/tests/mark-conflicts.sh b/tests/mark-conflicts.sh old mode 100755 new mode 100644 diff --git a/tests/match-date.sh b/tests/match-date.sh old mode 100755 new mode 100644 diff --git a/tests/match.sh b/tests/match.sh old mode 100755 new mode 100644 diff --git a/tests/merge_three_patches.sh b/tests/merge_three_patches.sh old mode 100755 new mode 100644 diff --git a/tests/mergeresolved.sh b/tests/mergeresolved.sh old mode 100755 new mode 100644 diff --git a/tests/merging_newlines.sh b/tests/merging_newlines.sh old mode 100755 new mode 100644 diff --git a/tests/mutex-option-precedence.sh b/tests/mutex-option-precedence.sh old mode 100755 new mode 100644 diff --git a/tests/mv.sh b/tests/mv.sh old mode 100755 new mode 100644 diff --git a/tests/mv_and_remove_tests.sh b/tests/mv_and_remove_tests.sh old mode 100755 new mode 100644 diff --git a/tests/network/clone-http-packed-detect.sh b/tests/network/clone-http-packed-detect.sh old mode 100755 new mode 100644 diff --git a/tests/network/clone-http-packed.sh b/tests/network/clone-http-packed.sh old mode 100755 new mode 100644 diff --git a/tests/network/clone-http.sh b/tests/network/clone-http.sh old mode 100755 new mode 100644 diff --git a/tests/network/clone.sh b/tests/network/clone.sh old mode 100755 new mode 100644 diff --git a/tests/network/external.sh b/tests/network/external.sh old mode 100755 new mode 100644 diff --git a/tests/network/issue1503_prefer_local_caches_to_remote_one.sh b/tests/network/issue1503_prefer_local_caches_to_remote_one.sh old mode 100755 new mode 100644 diff --git a/tests/network/issue1599-automatically-expire-unused-caches.sh b/tests/network/issue1599-automatically-expire-unused-caches.sh old mode 100755 new mode 100644 diff --git a/tests/network/issue1923-cache-warning.sh b/tests/network/issue1923-cache-warning.sh old mode 100755 new mode 100644 diff --git a/tests/network/issue1932-remote.sh b/tests/network/issue1932-remote.sh old mode 100755 new mode 100644 diff --git a/tests/network/issue2090-transfer-mode.sh b/tests/network/issue2090-transfer-mode.sh old mode 100755 new mode 100644 diff --git a/tests/network/issue2545_command-execution-via-ssh-uri-local.sh b/tests/network/issue2545_command-execution-via-ssh-uri-local.sh old mode 100755 new mode 100644 diff --git a/tests/network/issue2545_command-execution-via-ssh-uri.sh b/tests/network/issue2545_command-execution-via-ssh-uri.sh old mode 100755 new mode 100644 diff --git a/tests/network/issue2608-clone-http-packed-outdated.sh b/tests/network/issue2608-clone-http-packed-outdated.sh old mode 100755 new mode 100644 diff --git a/tests/network/lazy-clone.sh b/tests/network/lazy-clone.sh old mode 100755 new mode 100644 diff --git a/tests/network/log.sh b/tests/network/log.sh old mode 100755 new mode 100644 diff --git a/tests/network/show_tags-remote.sh b/tests/network/show_tags-remote.sh old mode 100755 new mode 100644 diff --git a/tests/network/ssh.sh b/tests/network/ssh.sh old mode 100755 new mode 100644 diff --git a/tests/no-prefs-template.sh b/tests/no-prefs-template.sh old mode 100755 new mode 100644 diff --git a/tests/nodeps.sh b/tests/nodeps.sh old mode 100755 new mode 100644 diff --git a/tests/nonewline.sh b/tests/nonewline.sh old mode 100755 new mode 100644 diff --git a/tests/obliterate.sh b/tests/obliterate.sh old mode 100755 new mode 100644 diff --git a/tests/oldfashioned.sh b/tests/oldfashioned.sh old mode 100755 new mode 100644 diff --git a/tests/optimize.sh b/tests/optimize.sh old mode 100755 new mode 100644 diff --git a/tests/order_of_resolutions.sh b/tests/order_of_resolutions.sh old mode 100755 new mode 100644 diff --git a/tests/output.sh b/tests/output.sh old mode 100755 new mode 100644 diff --git a/tests/overriding-defaults.sh b/tests/overriding-defaults.sh old mode 100755 new mode 100644 diff --git a/tests/patch-index-creation.sh b/tests/patch-index-creation.sh old mode 100755 new mode 100644 diff --git a/tests/patch-index-enabled-and-disabled.sh b/tests/patch-index-enabled-and-disabled.sh old mode 100755 new mode 100644 diff --git a/tests/patch-index-released.sh b/tests/patch-index-released.sh old mode 100755 new mode 100644 diff --git a/tests/patch-index-rename.sh b/tests/patch-index-rename.sh old mode 100755 new mode 100644 diff --git a/tests/patch-index-spans.sh b/tests/patch-index-spans.sh old mode 100755 new mode 100644 diff --git a/tests/patch-index-sync.sh b/tests/patch-index-sync.sh old mode 100755 new mode 100644 diff --git a/tests/pending.sh b/tests/pending.sh old mode 100755 new mode 100644 diff --git a/tests/perms.sh b/tests/perms.sh old mode 100755 new mode 100644 diff --git a/tests/posthook.sh b/tests/posthook.sh old mode 100755 new mode 100644 diff --git a/tests/prefs.sh b/tests/prefs.sh old mode 100755 new mode 100644 diff --git a/tests/prefs_binary.sh b/tests/prefs_binary.sh old mode 100755 new mode 100644 diff --git a/tests/prehook.sh b/tests/prehook.sh old mode 100755 new mode 100644 diff --git a/tests/printer.sh b/tests/printer.sh old mode 100755 new mode 100644 diff --git a/tests/pull-dont-prompt-deps.sh b/tests/pull-dont-prompt-deps.sh old mode 100755 new mode 100644 diff --git a/tests/pull-reorder.sh b/tests/pull-reorder.sh old mode 100755 new mode 100644 diff --git a/tests/pull.sh b/tests/pull.sh old mode 100755 new mode 100644 diff --git a/tests/pull_complement.sh b/tests/pull_complement.sh old mode 100755 new mode 100644 diff --git a/tests/push-dry-run.sh b/tests/push-dry-run.sh old mode 100755 new mode 100644 diff --git a/tests/push.sh b/tests/push.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-0.0-compat.sh b/tests/rebase-0.0-compat.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-0.2-compat.sh b/tests/rebase-0.2-compat.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-amend.sh b/tests/rebase-amend.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-apply.sh b/tests/rebase-apply.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-basic.sh b/tests/rebase-basic.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-changes-partial-conflict.sh b/tests/rebase-changes-partial-conflict.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-changes.sh b/tests/rebase-changes.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-conflict-resolution.sh b/tests/rebase-conflict-resolution.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-conflict-upgrade.sh b/tests/rebase-conflict-upgrade.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-conflicting-threeeway.sh b/tests/rebase-conflicting-threeeway.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-count.sh b/tests/rebase-count.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-keeps-deps-on-amend.sh b/tests/rebase-keeps-deps-on-amend.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-keeps-deps.sh b/tests/rebase-keeps-deps.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-move-2.sh b/tests/rebase-move-2.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-move.sh b/tests/rebase-move.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-new-style.sh b/tests/rebase-new-style.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-nochanges.sh b/tests/rebase-nochanges.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-obliterate.sh b/tests/rebase-obliterate.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-old-style-not-head.sh b/tests/rebase-old-style-not-head.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-pull-reorder.sh b/tests/rebase-pull-reorder.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-pull-tag.sh b/tests/rebase-pull-tag.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-pull.sh b/tests/rebase-pull.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-remote.sh b/tests/rebase-remote.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-repull.sh b/tests/rebase-repull.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-simple-conflict.sh b/tests/rebase-simple-conflict.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-skip-conflicts.sh b/tests/rebase-skip-conflicts.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-successive-amends.sh b/tests/rebase-successive-amends.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-suspend-from-patch.sh b/tests/rebase-suspend-from-patch.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-tag.sh b/tests/rebase-tag.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-unsuspend-quit.sh b/tests/rebase-unsuspend-quit.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-unsuspend-to-patch.sh b/tests/rebase-unsuspend-to-patch.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-warns-lost-deps.sh b/tests/rebase-warns-lost-deps.sh old mode 100755 new mode 100644 diff --git a/tests/rebase-with-conflicting-unrecorded.sh b/tests/rebase-with-conflicting-unrecorded.sh old mode 100755 new mode 100644 diff --git a/tests/record.sh b/tests/record.sh old mode 100755 new mode 100644 diff --git a/tests/remove.sh b/tests/remove.sh old mode 100755 new mode 100644 diff --git a/tests/rename_shouldnt_affect_prefixes.sh b/tests/rename_shouldnt_affect_prefixes.sh old mode 100755 new mode 100644 diff --git a/tests/renames.sh b/tests/renames.sh old mode 100755 new mode 100644 diff --git a/tests/repair.sh b/tests/repair.sh old mode 100755 new mode 100644 diff --git a/tests/replace.sh b/tests/replace.sh old mode 100755 new mode 100644 diff --git a/tests/repodir.sh b/tests/repodir.sh old mode 100755 new mode 100644 diff --git a/tests/repoformat.sh b/tests/repoformat.sh old mode 100755 new mode 100644 diff --git a/tests/resolve-conflicts-explicitly.sh b/tests/resolve-conflicts-explicitly.sh old mode 100755 new mode 100644 diff --git a/tests/revert.sh b/tests/revert.sh old mode 100755 new mode 100644 diff --git a/tests/rmconflict.sh b/tests/rmconflict.sh old mode 100755 new mode 100644 diff --git a/tests/rmdir.sh b/tests/rmdir.sh old mode 100755 new mode 100644 diff --git a/tests/rollback.sh b/tests/rollback.sh old mode 100755 new mode 100644 diff --git a/tests/sametwice.sh b/tests/sametwice.sh old mode 100755 new mode 100644 diff --git a/tests/send-dont-prompt-deps.sh b/tests/send-dont-prompt-deps.sh old mode 100755 new mode 100644 diff --git a/tests/send-encoding.sh b/tests/send-encoding.sh old mode 100755 new mode 100644 diff --git a/tests/send-external.sh b/tests/send-external.sh old mode 100755 new mode 100644 diff --git a/tests/send-output-v1.sh b/tests/send-output-v1.sh old mode 100755 new mode 100644 diff --git a/tests/send-output-v2.sh b/tests/send-output-v2.sh old mode 100755 new mode 100644 diff --git a/tests/send.sh b/tests/send.sh old mode 100755 new mode 100644 diff --git a/tests/send_apply.sh b/tests/send_apply.sh old mode 100755 new mode 100644 diff --git a/tests/set-default-hint.sh b/tests/set-default-hint.sh old mode 100755 new mode 100644 diff --git a/tests/set_scripts_executable.sh b/tests/set_scripts_executable.sh old mode 100755 new mode 100644 diff --git a/tests/setpref.sh b/tests/setpref.sh old mode 100755 new mode 100644 diff --git a/tests/show-authors.sh b/tests/show-authors.sh old mode 100755 new mode 100644 diff --git a/tests/show-removed-file.sh b/tests/show-removed-file.sh old mode 100755 new mode 100644 diff --git a/tests/show_contents.sh b/tests/show_contents.sh old mode 100755 new mode 100644 diff --git a/tests/show_files.sh b/tests/show_files.sh old mode 100755 new mode 100644 diff --git a/tests/show_tags.sh b/tests/show_tags.sh old mode 100755 new mode 100644 diff --git a/tests/split-patches.sh b/tests/split-patches.sh old mode 100755 new mode 100644 diff --git a/tests/tag-ask-deps.sh b/tests/tag-ask-deps.sh old mode 100755 new mode 100644 diff --git a/tests/tag.sh b/tests/tag.sh old mode 100755 new mode 100644 diff --git a/tests/tentative_revert.sh b/tests/tentative_revert.sh old mode 100755 new mode 100644 diff --git a/tests/test-untestable.sh b/tests/test-untestable.sh old mode 100755 new mode 100644 diff --git a/tests/test.sh b/tests/test.sh old mode 100755 new mode 100644 diff --git a/tests/three_way_conflict.sh b/tests/three_way_conflict.sh old mode 100755 new mode 100644 diff --git a/tests/trackdown-bisect.sh b/tests/trackdown-bisect.sh old mode 100755 new mode 100644 diff --git a/tests/trailing-newlines.sh b/tests/trailing-newlines.sh old mode 100755 new mode 100644 diff --git a/tests/uniqueoptions.sh b/tests/uniqueoptions.sh old mode 100755 new mode 100644 diff --git a/tests/unrecord.sh b/tests/unrecord.sh old mode 100755 new mode 100644 diff --git a/tests/unrevert-may-conflict.sh b/tests/unrevert-may-conflict.sh old mode 100755 new mode 100644 diff --git a/tests/unrevert.sh b/tests/unrevert.sh old mode 100755 new mode 100644 diff --git a/tests/utf8-display.sh b/tests/utf8-display.sh old mode 100755 new mode 100644 diff --git a/tests/v1-braced.sh b/tests/v1-braced.sh old mode 100755 new mode 100644 diff --git a/tests/whatsnew-adds-no-summary.sh b/tests/whatsnew-adds-no-summary.sh old mode 100755 new mode 100644 diff --git a/tests/whatsnew.sh b/tests/whatsnew.sh old mode 100755 new mode 100644 diff --git a/tests/workingdir.sh b/tests/workingdir.sh old mode 100755 new mode 100644 diff --git a/tests/xmlschema.sh b/tests/xmlschema.sh old mode 100755 new mode 100644